user_output_mix.F90 36 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903
  1. !#################################################################
  2. !
  3. ! MODULE: user_output_mix *************** DUMMY TM5-MP VERSION *******************
  4. !
  5. ! PUBLIC MEMBER FUNCTIONS:
  6. ! user_output_mix_init
  7. ! user_output_mix_write
  8. ! user_output_mix_accum
  9. ! user_output_mix_done
  10. !
  11. ! DESCRIPTION:
  12. ! Write mixing ratio tracer fields. Called from user_output.F90.
  13. !
  14. ! REVISION HISTORY:
  15. ! Wouter Peters
  16. !
  17. ! Mike Trudeau, Oct 2011
  18. ! Modified to write NetCDF4 output in NOAA/ESRL CarbonTracker
  19. ! Release format.
  20. !
  21. ! Mike trudeau, Feb 2012
  22. ! Modified to output temperature, orography, gph at model level
  23. ! boundaries, and remove "halo" grid cells.
  24. !
  25. ! Andy Jacobson, 13 Jun 2012
  26. ! Add date dimension to temperature variable in output file
  27. ! Change nc variable names: temp to temperature, press to pressure.
  28. !
  29. ! Andy Jacobson, 17 Jun 2012
  30. ! Dymamic time step weighting in averages.
  31. !
  32. ! Andy Jacobson, 3 Jul 2013
  33. ! NetCDF file attributes read from rc file
  34. !
  35. !### macros #####################################################
  36. !
  37. #define TRACEBACK write (gol,'("in ",a," (",a,", line",i5,")")') rname, __FILE__, __LINE__; call goErr
  38. #define IF_NOTOK_RETURN(action) if (status/=0) then; TRACEBACK; action; return; end if
  39. #define IF_ERROR_RETURN(action) if (status> 0) then; TRACEBACK; action; return; end if
  40. !
  41. #include "tm5.inc"
  42. !
  43. !#################################################################
  44. module user_output_mix
  45. ! use dims, only : nregions
  46. ! use GO, only : gol, goErr, goPr
  47. implicit none
  48. ! --- in/out ------------------------
  49. private
  50. public :: user_output_mix_init, user_output_mix_done, user_output_mix_write, user_output_mix_accum
  51. public :: mix_netcdf_attributes
  52. ! --- const ----------------------------------
  53. character(len=*), parameter :: mname = 'user_output_mix'
  54. ! --- var ---------------------------
  55. ! type fields
  56. ! real, dimension(:,:,:,:), pointer :: field ! 4D fields to write
  57. ! real, dimension(:,:), pointer :: ps ! the surface pressure
  58. ! real, dimension(:,:), pointer :: orography ! ground height
  59. ! real, dimension(:,:,:), pointer :: temperature ! air temperature
  60. ! real, dimension(:,:,:), pointer :: gph ! geopotential height
  61. ! real, dimension(:,:), pointer :: wda ! number of averages
  62. ! character(len=20), dimension(:), pointer :: namefield
  63. ! character(len=1024) :: fname
  64. ! integer, dimension(6) :: idate_start
  65. ! integer, dimension(6) :: idate_end
  66. ! integer :: funit = 0
  67. ! real :: lon_first
  68. ! real :: lon_inc
  69. ! real :: lat_first
  70. ! real :: lat_inc
  71. ! integer :: lon_n
  72. ! integer :: lat_n
  73. ! end type fields
  74. ! type(fields), dimension(nregions), save :: ncfile
  75. type netcdf_attribute_t
  76. character(len=256) :: notes
  77. character(len=1024) :: disclaimer
  78. character(len=256) :: email
  79. character(len=256) :: url
  80. character(len=256) :: institution
  81. character(len=256) :: conventions
  82. character(len=256) :: source
  83. end type netcdf_attribute_t
  84. type(netcdf_attribute_t) :: mix_netcdf_attributes
  85. contains
  86. subroutine user_output_mix_init(status)
  87. ! use dims, only : nregions
  88. ! use dims, only : im, jm, lm
  89. ! use dims, only : xbeg, ybeg, dx, dy, xref, yref
  90. ! use dims, only : idatei
  91. ! use chem_param, only : names
  92. ! use partools, only : myid, ntracetloc, ntracet_ar
  93. ! implicit none
  94. ! ! --- in/out ------------------------
  95. integer, intent(out) :: status
  96. ! integer :: region, offsetn
  97. ! integer :: i, j, n
  98. ! ! --- const ----------------------------------
  99. ! character(len=*), parameter :: rname = mname//'user_output_mix_init'
  100. ! ! --- begin -------------------------------
  101. ! offsetn = sum(ntracet_ar(0:myid-1))
  102. ! ! initialize the mix output
  103. ! regionloop: do region = 1, nregions
  104. ! allocate(ncfile(region)%field(im(region),jm(region),lm(region),ntracetloc))
  105. ! allocate(ncfile(region)%ps(im(region),jm(region)))
  106. ! allocate(ncfile(region)%orography(im(region),jm(region)))
  107. ! allocate(ncfile(region)%temperature(im(region),jm(region),lm(region)))
  108. ! allocate(ncfile(region)%gph(im(region),jm(region),lm(region)+1))
  109. ! allocate(ncfile(region)%wda(im(region),jm(region)))
  110. ! allocate(ncfile(region)%namefield(ntracetloc))
  111. ! do i=1, ntracetloc
  112. ! ncfile(region)%namefield(i) = names(i+offsetn)
  113. ! enddo
  114. ! ncfile(region)%lon_first = xbeg(region) + 0.5*dx/xref(region)
  115. ! ncfile(region)%lat_first = ybeg(region) + 0.5*dy/yref(region)
  116. ! ncfile(region)%lat_inc = dy/yref(region)
  117. ! ncfile(region)%lon_inc = dx/xref(region)
  118. ! ncfile(region)%lon_n = im(region)
  119. ! ncfile(region)%lat_n = jm(region)
  120. ! ncfile(region)%ps = 0.0
  121. ! ncfile(region)%field = 0.0
  122. ! ncfile(region)%wda = 0.0
  123. ! ncfile(region)%orography = 0.0
  124. ! ncfile(region)%temperature = 0.0
  125. ! ncfile(region)%gph = 0.0
  126. ! ncfile(region)%idate_start = idatei
  127. ! end do regionloop
  128. ! ok
  129. status = 0
  130. end subroutine user_output_mix_init
  131. subroutine user_output_mix_done(status)
  132. ! use dims, only : nregions
  133. ! implicit none
  134. ! ! --- in/out ------------------------
  135. integer, intent(out) :: status
  136. ! integer :: region
  137. ! ! --- const ----------------------------------
  138. ! character(len=*), parameter :: rname = mname//'user_output_mix_done'
  139. ! ! --- begin -------------------------------
  140. ! ! do not yet deallocate because parent mix is needed for updates
  141. ! ! do region = 1, nregions
  142. ! do region = nregions, 1, -1 ! ARJ, 17 May 2012
  143. ! call user_output_mix_write( region, status )
  144. ! IF_NOTOK_RETURN(status=1)
  145. ! end do
  146. ! do region = 1, nregions
  147. ! deallocate(ncfile(region)%field)
  148. ! deallocate(ncfile(region)%ps)
  149. ! deallocate(ncfile(region)%wda)
  150. ! deallocate(ncfile(region)%namefield)
  151. ! deallocate(ncfile(region)%orography)
  152. ! deallocate(ncfile(region)%temperature)
  153. ! deallocate(ncfile(region)%gph)
  154. ! enddo
  155. ! ok
  156. status = 0
  157. end subroutine user_output_mix_done
  158. subroutine user_output_mix_accum(region, status)
  159. ! use global_data, only : mass_dat, region_dat
  160. ! use meteo, only : sp_dat, gph_dat, m_dat, oro_dat, temper_dat
  161. ! use dims, only : im, jm, lm
  162. ! use dims, only : isr, jsr, ier, jer
  163. ! use dims, only : tref, ndyn, ndyn_max
  164. ! use binas, only : xmair
  165. ! use ParTools, only : myid, ntracetloc, ntracet_ar
  166. ! use chem_param, only : ra,uscale
  167. ! implicit none
  168. ! ! --- in/out ------------------------
  169. integer, intent(in) :: region
  170. integer, intent(out) :: status
  171. ! integer :: i ,j, l, n
  172. ! integer :: imr, jmr, lmr
  173. ! integer :: dtime, offsetn, dtime_max
  174. ! real :: weight
  175. ! ! MPI arrays to gather fields
  176. ! real, dimension(:,:,:,:), pointer :: rm
  177. ! real, dimension(:,:,:), pointer :: p
  178. ! real, dimension(:,:,:), pointer :: gph
  179. ! real, dimension(:,:,:), pointer :: m
  180. ! real, dimension(:), pointer :: dxyp
  181. ! integer, dimension(:,:), pointer :: zoomed
  182. ! real, dimension(:,:), pointer :: orography
  183. ! real, dimension(:,:,:), pointer :: temperature
  184. ! ! --- begin -------------------------------
  185. ! zoomed => region_dat(region)%zoomed
  186. ! dtime = ndyn/tref(region) ! basic time step (seconds)
  187. ! dtime_max = ndyn_max/tref(region) ! basic time step (seconds)
  188. ! weight = float(ndyn)/float(ndyn_max)
  189. ! offsetn = sum(ntracet_ar(0:myid-1))
  190. ! ! collect output FOR LT
  191. ! imr = im(region) ; jmr = jm(region) ; lmr = lm(region)
  192. ! m => m_dat(region)%data
  193. ! rm => mass_dat(region)%rm_t
  194. ! p => sp_dat(region)%data
  195. ! gph => gph_dat(region)%data
  196. ! dxyp => region_dat(region)%dxyp
  197. ! orography => oro_dat(region)%data(:,:,1)
  198. ! temperature => temper_dat(region)%data
  199. ! ! fill fields for averaging
  200. ! do j = jsr(region), jer(region)
  201. ! do i = isr(region), ier(region)
  202. ! if(zoomed(i,j) /= region) cycle
  203. ! ! average output over day
  204. ! ncfile(region)%wda(i,j) = ncfile(region)%wda(i,j) + weight
  205. ! do l = 1, lm(region)
  206. ! do n = 1, ntracetloc
  207. ! ncfile(region)%field(i,j,l,n) = &
  208. ! ncfile(region)%field(i,j,l,n) + uscale(n)*weight*rm(i,j,l,n)/m(i,j,l)*(xmair/ra(offsetn+n))
  209. ! enddo
  210. ! ncfile(region)%temperature(i,j,l) = &
  211. ! ncfile(region)%temperature(i,j,l) + weight*temperature(i,j,l)
  212. ! enddo
  213. ! do l = 1, lm(region) + 1
  214. ! ncfile(region)%gph(i,j,l) = &
  215. ! ncfile(region)%gph(i,j,l) + weight*gph(i,j,l)
  216. ! enddo
  217. ! ncfile(region)%ps(i,j) = &
  218. ! ncfile(region)%ps(i,j) + weight*p(i,j,1)
  219. ! ncfile(region)%orography(i,j) = &
  220. ! ncfile(region)%orography(i,j) + weight*orography(i,j)
  221. ! enddo
  222. ! enddo
  223. ! nullify(rm)
  224. ! nullify(m)
  225. ! nullify(p)
  226. ! nullify(gph)
  227. ! nullify(dxyp)
  228. ! nullify(zoomed)
  229. ! nullify(orography)
  230. ! nullify(temperature)
  231. ! nullify(gph)
  232. ! ok
  233. status = 0
  234. end subroutine user_output_mix_accum
  235. ! subroutine output_update_parent(region)
  236. ! use dims
  237. ! use global_data, only: region_dat
  238. ! use toolbox, only: escape_tm
  239. ! implicit none
  240. ! ! --- in/out ------------------------
  241. ! integer, intent(in) :: region
  242. ! ! --- var ---------------------------
  243. ! real, dimension(:,:,:,:), pointer :: mean_mix ! column value m - mean
  244. ! real, dimension(:,:,:), pointer :: mean_gph ! column value gph - mean
  245. ! real, dimension(:,:), pointer :: mean_orography ! column value orography - mean
  246. ! real, dimension(:,:,:), pointer :: mean_temperature ! column value temperature - mean
  247. ! real, dimension(:,:), pointer :: mean_ps ! column value ps - mean
  248. ! real, dimension(:,:,:,:), pointer :: p_mean_mix ! column value m - mean
  249. ! real, dimension(:,:,:), pointer :: p_mean_gph ! column value gph - mean
  250. ! real, dimension(:,:), pointer :: p_mean_orography ! column value orography - mean
  251. ! real, dimension(:,:,:), pointer :: p_mean_temperature ! column value temperature - mean
  252. ! real, dimension(:,:), pointer :: p_mean_ps ! column value ps - mean
  253. ! real, dimension(:), pointer :: dxyp
  254. ! integer :: i, j
  255. ! integer :: ip, jp
  256. ! integer :: my_parent
  257. ! integer :: xref_, yref_
  258. ! integer :: imp, jmp
  259. ! integer :: imr, jmr
  260. ! integer :: ic, jc
  261. ! integer :: iox, ioy1, ioy2
  262. ! real :: w, wtot
  263. ! ! --- begin -------------------------------
  264. ! if (region==1) return
  265. ! imr = im(region)
  266. ! jmr = jm(region)
  267. ! ! determine parent
  268. ! my_parent = parent(region)
  269. ! xref_ = xref(region)/xref(my_parent)
  270. ! yref_ = yref(region)/yref(my_parent)
  271. ! imp = im(region)/xref_
  272. ! jmp = jm(region)/yref_
  273. ! ! check calculated imp, jmp, lmp
  274. ! if (ibeg(region) < iend(region) .and. imp /= iend(region)-ibeg(region)+1) then
  275. ! call escape_tm('stopped in update_parent_columns')
  276. ! endif
  277. ! if (jmp .ne. jend(region)-jbeg(region)+1) then
  278. ! call escape_tm('stopped in update_parent_columns')
  279. ! endif
  280. ! mean_mix => ncfile(region)%field(:,:,:,:)
  281. ! mean_gph => ncfile(region)%gph
  282. ! mean_orography => ncfile(region)%orography
  283. ! mean_temperature => ncfile(region)%temperature
  284. ! mean_ps => ncfile(region)%ps
  285. ! p_mean_mix => ncfile(my_parent)%field(:,:,:,:)
  286. ! p_mean_gph => ncfile(my_parent)%gph
  287. ! p_mean_orography => ncfile(my_parent)%orography
  288. ! p_mean_temperature => ncfile(my_parent)%temperature
  289. ! p_mean_ps => ncfile(my_parent)%ps
  290. ! dxyp => region_dat(region)%dxyp
  291. ! iox = isr(region)/xref_
  292. ! ioy1 = jsr(region)/yref_
  293. ! ioy2 = (jm(region)-jer(region)+1)/yref_
  294. ! do jp = jbeg(region)+ioy1, jend(region)-ioy2
  295. ! jc = (jp-jbeg(region))*yref_
  296. ! do ip = ibeg(region)+iox, iend(region)-iox
  297. ! ic = (ip-ibeg(region))*xref_
  298. ! p_mean_ps(ip,jp) = 0.0
  299. ! p_mean_mix(ip,jp,:,:) = 0.0
  300. ! p_mean_gph(ip,jp,:) = 0.0
  301. ! p_mean_orography(ip,jp) = 0.0
  302. ! p_mean_temperature(ip,jp,:) = 0.0
  303. ! wtot = 0.0
  304. ! do j = 1, yref_
  305. ! w = dxyp(jc+j)
  306. ! do i = 1, xref_
  307. ! p_mean_mix(ip,jp,:,:) = p_mean_mix(ip,jp,:,:) + mean_mix(ic+i,jc+j,:,:)*w
  308. ! p_mean_gph(ip,jp,:) = p_mean_gph(ip,jp,:) + mean_gph(ic+i,jc+j,:)*w
  309. ! p_mean_orography(ip,jp) = p_mean_orography(ip,jp) + mean_orography(ic+i,jc+j)*w
  310. ! p_mean_temperature(ip,jp,:) = p_mean_temperature(ip,jp,:) + mean_temperature(ic+i,jc+j,:)*w
  311. ! p_mean_ps(ip,jp) = p_mean_ps(ip,jp) + mean_ps(ic+i,jc+j)*w
  312. ! wtot = wtot+w
  313. ! enddo
  314. ! enddo
  315. ! p_mean_mix(ip,jp,:,:) = p_mean_mix(ip,jp,:,:)/wtot
  316. ! p_mean_gph(ip,jp,:) = p_mean_gph(ip,jp,:)/wtot
  317. ! p_mean_orography(ip,jp) = p_mean_orography(ip,jp)/wtot
  318. ! p_mean_temperature(ip,jp,:) = p_mean_temperature(ip,jp,:)/wtot
  319. ! p_mean_ps(ip,jp) = p_mean_ps(ip,jp)/wtot
  320. ! enddo
  321. ! enddo
  322. ! nullify(mean_mix)
  323. ! nullify(mean_gph)
  324. ! nullify(mean_orography)
  325. ! nullify(mean_temperature)
  326. ! nullify(mean_ps)
  327. ! nullify(p_mean_mix)
  328. ! nullify(p_mean_gph)
  329. ! nullify(p_mean_orography)
  330. ! nullify(p_mean_temperature)
  331. ! nullify(p_mean_ps)
  332. ! end subroutine output_update_parent
  333. subroutine user_output_mix_write(region, status)
  334. ! use global_data, only : region_dat
  335. ! use dims, only : im, jm, lm
  336. ! use dims, only : itaur, tref, at, bt, ndyn, ndyn_max
  337. ! use dims, only : isr, jsr, ier, jer
  338. ! use dims, only : dx, xref, xbeg, xend, ibeg, iend
  339. ! use dims, only : dy, yref, ybeg, yend, jbeg, jend
  340. ! use dims, only : dz, zref, zbeg, zend, lbeg, lend
  341. ! use dims, only : region_name
  342. ! use chem_param, only : ntracet, names
  343. ! use datetime, only : tau2date, date2tau, idate2ddate
  344. ! use ParTools, only : myid, root, ntracetloc
  345. ! use global_data, only : outdir
  346. ! use MDF, only : MDF_Create, MDF_Close, MDF_EndDef
  347. ! use MDF, only : MDF_NETCDF, MDF_REPLACE, MDF_GLOBAL, MDF_UNLIMITED
  348. ! use MDF, only : MDF_INT, MDF_FLOAT, MDF_DOUBLE, MDF_CHAR
  349. ! use MDF, only : MDF_Put_Att
  350. ! use MDF, only : MDF_Def_Dim
  351. ! use MDF, only : MDF_Def_Var, MDF_Put_Var
  352. ! implicit none
  353. ! ! --- in/out ------------------------
  354. integer, intent(out) :: status
  355. integer, intent(in) :: region
  356. ! ! --- var ---------------------------
  357. ! integer :: dimid_lon, dimid_lat, dimid_lvl, dimid_bnd, dimid_date, dimid_cal, dimid_ntracetloc, dimid_char8
  358. ! integer :: varid_lon, varid_lat, varid_lvl, varid_bnd
  359. ! integer :: varid_press
  360. ! integer :: varid_tracer,varid_tracernm
  361. ! integer :: varid_elapsed, varid_dec, varid_cal_int, varid_date_int
  362. ! integer :: varid_gph
  363. ! integer :: varid_orography, varid_temperature
  364. ! integer :: fid
  365. ! integer :: i, j, l
  366. ! integer :: imr, jmr, lmr
  367. ! integer :: n
  368. ! integer, dimension(6) :: idatee
  369. ! integer :: dtime, dtime_max
  370. ! integer :: itau_start
  371. ! integer :: itau_end
  372. ! integer :: itau_avg
  373. ! integer :: itau_ref
  374. ! integer :: itau_elapsed
  375. ! real*8 :: ddate_avg
  376. ! real*8 :: days_elapsed
  377. ! integer, dimension(6) :: idate_ref
  378. ! integer, dimension(6) :: idate_avg
  379. ! real*4 :: fillval_r4 = -1e34
  380. ! real*8 :: fillval_r8 = -1e34
  381. ! integer, dimension(8) :: isysdate
  382. ! integer, dimension(:,:), pointer :: zoomed
  383. ! integer :: iHalo, imHalo, jHalo, jmHalo
  384. ! type ncType
  385. ! real, dimension(:,:), allocatable :: orography
  386. ! real, dimension(:,:,:), allocatable :: temperature
  387. ! real, dimension(:,:,:), allocatable :: pressure
  388. ! real, dimension(:,:,:), allocatable :: gph
  389. ! real, dimension(:,:,:,:), allocatable :: field
  390. ! real, dimension(:), allocatable :: lonMean
  391. ! real, dimension(:), allocatable :: latMean
  392. ! real, dimension(:), allocatable :: lonEdge
  393. ! real, dimension(:), allocatable :: latEdge
  394. ! end type ncType
  395. ! type(ncType), dimension(nregions) :: ncout
  396. ! character(len=256) :: progstring
  397. ! character(len=256) :: sysdate
  398. ! character(len=256) :: history
  399. ! ! --- const ---------------------------
  400. ! character(len=*), parameter :: rname = mname//'user_output_mix_write'
  401. ! ! --- begin -------------------------------
  402. ! if (myid .ne. root ) return
  403. ! zoomed => region_dat(region)%zoomed
  404. ! dtime = ndyn/tref(region) ! basic time step (seconds)
  405. ! dtime_max = ndyn_max/tref(region) ! basic time step (seconds)
  406. ! ! go to middle of interval
  407. ! call tau2date(itaur(region), idatee)
  408. ! ncfile(region)%idate_end = idatee
  409. ! ! First divide each element by weight, then update_parents, and finally write the output
  410. ! do j = jsr(region), jer(region)
  411. ! do i = isr(region), ier(region)
  412. ! if (zoomed(i,j) /= region) cycle
  413. ! if (ncfile(region)%wda(i,j) > 0) then
  414. ! ! surface pressure and orography
  415. ! ncfile(region)%ps(i,j) = ncfile(region)%ps(i,j)/ncfile(region)%wda(i,j)
  416. ! ncfile(region)%orography(i,j) = ncfile(region)%orography(i,j)/ncfile(region)%wda(i,j)
  417. ! ! tracer fields and air temperature
  418. ! do l = 1, lm(region)
  419. ! do n = 1, ntracetloc
  420. ! ncfile(region)%field(i,j,l,n) = ncfile(region)%field(i,j,l,n) / ncfile(region)%wda(i,j)
  421. ! enddo
  422. ! ncfile(region)%temperature(i,j,l) = ncfile(region)%temperature(i,j,l) / ncfile(region)%wda(i,j)
  423. ! enddo
  424. ! ! geopotential height
  425. ! do l = 1, lm(region) + 1
  426. ! ncfile(region)%gph(i,j,l) = ncfile(region)%gph(i,j,l) / ncfile(region)%wda(i,j)
  427. ! enddo
  428. ! endif
  429. ! enddo
  430. ! enddo
  431. ! !WP! Added explicit call to update_parent to ensure that inner domain of
  432. ! !parents is filled with appropriate values. This was missing before. Note
  433. ! !that the order in which to write mix files *MUST* be from smallest zoom
  434. ! !to parents.
  435. ! call output_update_parent(region)
  436. ! call date_and_time(values = isysdate)
  437. ! write (sysdate, '(i4.4,"-",i2.2,"-",i2.2," ",i2.2,":",i2.2,":",i2.2," UTC")') &
  438. ! isysdate(1), isysdate(2), isysdate(3), isysdate(5), isysdate(6), isysdate(7)
  439. ! call getarg (0, progstring, status)
  440. ! write(history,'("Created ",a," by ",a,".")') trim(sysdate),trim(progstring)
  441. ! ! date/time conversions
  442. ! call date2tau(ncfile(region)%idate_start, itau_start)
  443. ! call date2tau(ncfile(region)%idate_end, itau_end)
  444. ! itau_avg = nint(5.0D-1 * dble(itau_start + itau_end))
  445. ! call tau2date(itau_avg, idate_avg)
  446. ! ddate_avg = idate2ddate(idate_avg)
  447. ! idate_ref = (/2000, 1, 1, 0, 0, 0/)
  448. ! call date2tau(idate_ref, itau_ref)
  449. ! itau_elapsed = itau_avg - itau_ref
  450. ! days_elapsed = dble(itau_elapsed) / 86400.0D+0
  451. ! ! define index offsets to elimate "halo" cells
  452. ! if ( region == 1 ) then
  453. ! iHalo = 0
  454. ! jHalo = 0
  455. ! else
  456. ! iHalo = 3
  457. ! jHalo = 2
  458. ! endif
  459. ! imHalo = im(region) - iHalo * 2
  460. ! jmHalo = jm(region) - jHalo * 2
  461. ! allocate(ncout(region)%orography(imHalo, jmHalo))
  462. ! allocate(ncout(region)%temperature(imHalo, jmHalo, lm(region)))
  463. ! allocate(ncout(region)%pressure(imHalo, jmHalo, lm(region)+1))
  464. ! allocate(ncout(region)%gph(imHalo, jmHalo, lm(region)+1))
  465. ! allocate(ncout(region)%field(imHalo, jmHalo, lm(region), ntracetloc))
  466. ! allocate(ncout(region)%lonMean(imHalo))
  467. ! allocate(ncout(region)%latMean(jmHalo))
  468. ! allocate(ncout(region)%lonEdge(imHalo+1))
  469. ! allocate(ncout(region)%latEdge(jmHalo+1))
  470. ! ! trim "halo" cells
  471. ! do i = 1, imHalo
  472. ! do j = 1, jmHalo
  473. ! do l = 1, lm(region)
  474. ! do n = 1, ntracetloc
  475. ! ncout(region)%field(i,j,l,n) = ncfile(region)%field(i+iHalo,j+jHalo,l,n)
  476. ! enddo
  477. ! ncout(region)%temperature(i,j,l) = ncfile(region)%temperature(i+iHalo,j+jHalo,l)
  478. ! enddo
  479. ! ncout(region)%orography(i,j) = ncfile(region)%orography(i+iHalo,j+jHalo)
  480. ! enddo
  481. ! enddo
  482. ! ! Subtract the background. This is a CarbonTracker-CO2-specific operation.
  483. ! ! do n = 2, ntracetloc
  484. ! ! ncout(region)%field(:,:,:,n) = ncout(region)%field(:,:,:,n) - ncout(region)%field(:,:,:,1)
  485. ! ! enddo
  486. ! ! compute 3D pressure field at model level boundaries & trim "halo" cells
  487. ! do i = 1, imHalo
  488. ! do j = 1, jmHalo
  489. ! do l = 1, lm(region) + 1
  490. ! ncout(region)%pressure(i,j,l) = at(l) + bt(l) * ncfile(region)%ps(i+iHalo,j+jHalo)
  491. ! ncout(region)%gph(i,j,l) = ncfile(region)%gph(i+iHalo,j+jHalo,l)
  492. ! enddo
  493. ! enddo
  494. ! enddo
  495. ! ! longitude arrays
  496. ! do i = 1, imHalo + 1
  497. ! ncout(region)%lonEdge(i) = xbeg(region) + (i + iHalo - 1) * dx / xref(region)
  498. ! enddo
  499. ! do i = 1, imHalo
  500. ! ncout(region)%lonMean(i) = (ncout(region)%lonEdge(i) + ncout(region)%lonEdge(i+1)) / 2.0
  501. ! enddo
  502. ! ! latitude arrays
  503. ! do j = 1, jmHalo + 1
  504. ! ncout(region)%latEdge(j) = ybeg(region) + (j + jHalo - 1) * dy / yref(region)
  505. ! enddo
  506. ! do j = 1, jmHalo
  507. ! ncout(region)%latMean(j) = (ncout(region)%latEdge(j) + ncout(region)%latEdge(j+1)) / 2.0
  508. ! enddo
  509. ! ! create new file
  510. ! write (ncfile(region)%fname, '(a,"/molefrac_",a,"_",i4.4,3i2.2,"_",i4.4,3i2.2,".nc")') &
  511. ! trim(outdir), trim(region_name(region)), ncfile(region)%idate_start(1:4), ncfile(region)%idate_end(1:4)
  512. ! call MDF_Create( trim(ncfile(region)%fname), MDF_NETCDF, MDF_REPLACE, fid, status )
  513. ! IF_NOTOK_RETURN(status=1)
  514. ! ! global attributes
  515. ! if(len_trim(mix_netcdf_attributes%notes) .gt. 0) then
  516. ! call MDF_Put_Att( fid, MDF_GLOBAL, "notes", values=trim(mix_netcdf_attributes%notes), status=status )
  517. ! IF_NOTOK_RETURN(status=1)
  518. ! end if
  519. ! if(len_trim(mix_netcdf_attributes%disclaimer) .gt. 0) then
  520. ! call MDF_Put_Att( fid, MDF_GLOBAL, "disclaimer", values=trim(mix_netcdf_attributes%disclaimer), status=status )
  521. ! IF_NOTOK_RETURN(status=1)
  522. ! end if
  523. ! if(len_trim(mix_netcdf_attributes%email) .gt. 0) then
  524. ! call MDF_Put_Att( fid, MDF_GLOBAL, "email", values=trim(mix_netcdf_attributes%email), status=status )
  525. ! IF_NOTOK_RETURN(status=1)
  526. ! end if
  527. ! if(len_trim(mix_netcdf_attributes%url) .gt. 0) then
  528. ! call MDF_Put_Att( fid, MDF_GLOBAL, "url", values=trim(mix_netcdf_attributes%url), status=status )
  529. ! IF_NOTOK_RETURN(status=1)
  530. ! end if
  531. ! if(len_trim(mix_netcdf_attributes%institution) .gt. 0) then
  532. ! call MDF_Put_Att( fid, MDF_GLOBAL, "institution", values=trim(mix_netcdf_attributes%institution), status=status )
  533. ! IF_NOTOK_RETURN(status=1)
  534. ! end if
  535. ! if(len_trim(mix_netcdf_attributes%conventions) .gt. 0) then
  536. ! call MDF_Put_Att( fid, MDF_GLOBAL, "conventions", values=trim(mix_netcdf_attributes%conventions), status=status )
  537. ! IF_NOTOK_RETURN(status=1)
  538. ! end if
  539. ! if(len_trim(history) .gt. 0) then
  540. ! call MDF_Put_Att( fid, MDF_GLOBAL, "history", values=trim(history), status=status )
  541. ! IF_NOTOK_RETURN(status=1)
  542. ! end if
  543. ! if(len_trim(mix_netcdf_attributes%source) .gt. 0) then
  544. ! call MDF_Put_Att( fid, MDF_GLOBAL, "source", values=trim(mix_netcdf_attributes%source), status=status )
  545. ! IF_NOTOK_RETURN(status=1)
  546. ! end if
  547. ! ! define dimensions
  548. ! call MDF_Def_Dim( fid, 'date', MDF_UNLIMITED, dimid_date, status )
  549. ! IF_NOTOK_RETURN(status=1)
  550. ! call MDF_Def_Dim( fid, 'char8', 8, dimid_char8, status )
  551. ! IF_NOTOK_RETURN(status=1)
  552. ! call MDF_Def_Dim( fid, 'ntracers', ntracetloc, dimid_ntracetloc, status )
  553. ! IF_NOTOK_RETURN(status=1)
  554. ! call MDF_Def_Dim( fid, 'calendar_components', 6, dimid_cal, status )
  555. ! IF_NOTOK_RETURN(status=1)
  556. ! call MDF_Def_Dim( fid, 'lon', imHalo, dimid_lon, status )
  557. ! IF_NOTOK_RETURN(status=1)
  558. ! call MDF_Def_Dim( fid, 'lat', jmHalo, dimid_lat, status )
  559. ! IF_NOTOK_RETURN(status=1)
  560. ! call MDF_Def_Dim( fid, 'level', lm(region) , dimid_lvl, status )
  561. ! IF_NOTOK_RETURN(status=1)
  562. ! call MDF_Def_Dim( fid, 'boundary', lm(region)+1, dimid_bnd, status )
  563. ! IF_NOTOK_RETURN(status=1)
  564. ! ! dimension variables
  565. ! call MDF_Def_Var( fid, 'date', MDF_DOUBLE, (/dimid_date/), varid_elapsed, status )
  566. ! IF_NOTOK_RETURN(status=1)
  567. ! call MDF_Put_Att( fid, varid_elapsed, "units", values="days since 2000-01-01 00:00:00 UTC", status=status )
  568. ! IF_NOTOK_RETURN(status=1)
  569. ! call MDF_Put_Att( fid, varid_elapsed, "long_name", values="date", status=status )
  570. ! IF_NOTOK_RETURN(status=1)
  571. ! call MDF_Def_Var( fid, 'decimal_date', MDF_DOUBLE, (/dimid_date/), varid_dec, status )
  572. ! IF_NOTOK_RETURN(status=1)
  573. ! call MDF_Put_Att( fid, varid_dec, "units", values="years", status=status )
  574. ! IF_NOTOK_RETURN(status=1)
  575. ! call MDF_Put_Att( fid, varid_dec, "_FillValue", values=fillval_r8, status=status )
  576. ! IF_NOTOK_RETURN(status=1)
  577. ! call MDF_Def_Var( fid, 'calendar_components', MDF_INT, (/dimid_cal/), varid_cal_int, status )
  578. ! IF_NOTOK_RETURN(status=1)
  579. ! call MDF_Put_Att( fid, varid_cal_int, "units", values="none", status=status )
  580. ! IF_NOTOK_RETURN(status=1)
  581. ! call MDF_Put_Att( fid, varid_cal_int, "long_name", values="calendar_components", status=status )
  582. ! IF_NOTOK_RETURN(status=1)
  583. ! call MDF_Def_Var( fid, 'date_components', MDF_INT, (/dimid_cal, dimid_date/), varid_date_int, status )
  584. ! IF_NOTOK_RETURN(status=1)
  585. ! call MDF_Put_Att( fid, varid_date_int, "units", values="none", status=status )
  586. ! IF_NOTOK_RETURN(status=1)
  587. ! call MDF_Put_Att( fid, varid_date_int, "long_name", values="Integer value calendar components of UTC date.", status=status )
  588. ! IF_NOTOK_RETURN(status=1)
  589. ! call MDF_Put_Att( fid, varid_date_int, "comment", values="year, month, day, hour, minute, second", status=status )
  590. ! IF_NOTOK_RETURN(status=1)
  591. ! call MDF_Def_Var( fid, 'lon', MDF_DOUBLE, (/dimid_lon/), varid_lon, status )
  592. ! IF_NOTOK_RETURN(status=1)
  593. ! call MDF_Put_Att( fid, varid_lon, "units", values="degrees_east", status=status )
  594. ! IF_NOTOK_RETURN(status=1)
  595. ! call MDF_Put_Att( fid, varid_lon, "long_name", values="lon", status=status )
  596. ! IF_NOTOK_RETURN(status=1)
  597. ! call MDF_Put_Att( fid, varid_lon, "actual_range", values=(/ncout(region)%lonEdge(1), ncout(region)%lonEdge(imHalo+1)/), status=status )
  598. ! IF_NOTOK_RETURN(status=1)
  599. ! call MDF_Def_Var( fid, 'lat', MDF_DOUBLE, (/dimid_lat/), varid_lat, status )
  600. ! IF_NOTOK_RETURN(status=1)
  601. ! call MDF_Put_Att( fid, varid_lat, "units", values="degrees_north", status=status )
  602. ! IF_NOTOK_RETURN(status=1)
  603. ! call MDF_Put_Att( fid, varid_lat, "long_name", values="lat", status=status )
  604. ! IF_NOTOK_RETURN(status=1)
  605. ! call MDF_Put_Att( fid, varid_lat, "actual_range", values=(/ncout(region)%latEdge(1), ncout(region)%latEdge(jmHalo+1)/), status=status )
  606. ! IF_NOTOK_RETURN(status=1)
  607. ! call MDF_Def_Var( fid, 'level', MDF_INT, (/dimid_lvl/), varid_lvl, status )
  608. ! IF_NOTOK_RETURN(status=1)
  609. ! call MDF_Put_Att( fid, varid_lvl, "units", values="none", status=status )
  610. ! IF_NOTOK_RETURN(status=1)
  611. ! call MDF_Put_Att( fid, varid_lvl, "long_name", values="level", status=status )
  612. ! IF_NOTOK_RETURN(status=1)
  613. ! call MDF_Put_Att( fid, varid_lvl, "positive", values="up", status=status )
  614. ! IF_NOTOK_RETURN(status=1)
  615. ! call MDF_Def_Var( fid, 'boundary', MDF_INT, (/dimid_bnd/), varid_bnd, status )
  616. ! IF_NOTOK_RETURN(status=1)
  617. ! call MDF_Put_Att( fid, varid_bnd, "units", values="none", status=status )
  618. ! IF_NOTOK_RETURN(status=1)
  619. ! call MDF_Put_Att( fid, varid_bnd, "long_name", values="boundary", status=status )
  620. ! IF_NOTOK_RETURN(status=1)
  621. ! call MDF_Put_Att( fid, varid_bnd, "positive", values="up", status=status )
  622. ! IF_NOTOK_RETURN(status=1)
  623. ! call MDF_Def_Var( fid, "tracer", MDF_FLOAT, (/dimid_lon, dimid_lat, dimid_lvl, dimid_ntracetloc,dimid_date/), varid_tracer, deflate_level=9, status=status )
  624. ! IF_NOTOK_RETURN(status=1)
  625. ! call MDF_Put_Att( fid, varid_bnd, "units", values="unspecified", status=status )
  626. ! IF_NOTOK_RETURN(status=1)
  627. ! call MDF_Put_Att( fid, varid_tracer, "_FillValue", values=fillval_r4, status=status )
  628. ! IF_NOTOK_RETURN(status=1)
  629. ! call MDF_Put_Att( fid, varid_tracer, "long_name", values="tracer_mixing_ratio", status=status )
  630. ! IF_NOTOK_RETURN(status=1)
  631. ! call MDF_Def_Var( fid, "tracer_names", MDF_CHAR, (/dimid_char8, dimid_ntracetloc/), varid_tracernm, status=status )
  632. ! IF_NOTOK_RETURN(status=1)
  633. ! call MDF_Def_Var( fid, 'pressure', MDF_FLOAT, (/dimid_lon, dimid_lat, dimid_bnd, dimid_date/), varid_press, deflate_level=9, status=status )
  634. ! IF_NOTOK_RETURN(status=1)
  635. ! call MDF_Put_Att( fid, varid_press, "units", values="Pa", status=status )
  636. ! IF_NOTOK_RETURN(status=1)
  637. ! call MDF_Put_Att( fid, varid_press, "_FillValue", values=fillval_r4, status=status )
  638. ! IF_NOTOK_RETURN(status=1)
  639. ! call MDF_Put_Att( fid, varid_press, "long_name", values="air_pressure", status=status )
  640. ! IF_NOTOK_RETURN(status=1)
  641. ! call MDF_Put_Att( fid, varid_press, "comment", values="air pressure at level boundaries", status=status )
  642. ! IF_NOTOK_RETURN(status=1)
  643. ! call MDF_Def_Var( fid, 'gph', MDF_FLOAT, (/dimid_lon, dimid_lat, dimid_bnd, dimid_date/), varid_gph, deflate_level=9, status=status )
  644. ! IF_NOTOK_RETURN(status=1)
  645. ! call MDF_Put_Att( fid, varid_gph, "units", values="m", status=status )
  646. ! IF_NOTOK_RETURN(status=1)
  647. ! call MDF_Put_Att( fid, varid_gph, "_FillValue", values=fillval_r4, status=status )
  648. ! IF_NOTOK_RETURN(status=1)
  649. ! call MDF_Put_Att( fid, varid_gph, "long_name", values="geopotential_height", status=status )
  650. ! IF_NOTOK_RETURN(status=1)
  651. ! call MDF_Put_Att( fid, varid_gph, "comment", values="geopotential height at level boundaries", status=status )
  652. ! IF_NOTOK_RETURN(status=1)
  653. ! ! note: Reported as geopotential for consistency with previous CT releases. Divide by 9.80665 for surface height in meters
  654. ! ! source: http://www.ecmwf.int/products/data/archive/data_faq.html#geopotential
  655. ! ! 21 Feb 2012, M. Trudeau
  656. ! call MDF_Def_Var( fid, 'oro', MDF_FLOAT, (/dimid_lon, dimid_lat/), varid_orography, deflate_level=9, status=status )
  657. ! IF_NOTOK_RETURN(status=1)
  658. ! call MDF_Put_Att( fid, varid_orography, "units", values="m^2/s^2", status=status )
  659. ! IF_NOTOK_RETURN(status=1)
  660. ! call MDF_Put_Att( fid, varid_orography, "long_name", values="orography", status=status )
  661. ! IF_NOTOK_RETURN(status=1)
  662. ! call MDF_Put_Att( fid, varid_orography, "standard_name", values="surface geopotential", status=status )
  663. ! IF_NOTOK_RETURN(status=1)
  664. ! call MDF_Def_Var( fid, 'temperature', MDF_FLOAT, (/dimid_lon, dimid_lat, dimid_lvl, dimid_date/), varid_temperature, deflate_level=9, status=status )
  665. ! IF_NOTOK_RETURN(status=1)
  666. ! call MDF_Put_Att( fid, varid_temperature, "units", values="Kelvin", status=status )
  667. ! IF_NOTOK_RETURN(status=1)
  668. ! call MDF_Put_Att( fid, varid_temperature, "long_name", values="air_temperature", status=status )
  669. ! IF_NOTOK_RETURN(status=1)
  670. ! call MDF_Put_Att( fid, varid_temperature, "standard_name", values="air temperature at level center", status=status )
  671. ! IF_NOTOK_RETURN(status=1)
  672. ! ! finished definition
  673. ! call MDF_EndDef( fid, status )
  674. ! IF_NOTOK_RETURN(status=1)
  675. ! ! write variables
  676. ! call MDF_Put_Var( fid, varid_elapsed, (/(days_elapsed)/), status)
  677. ! IF_NOTOK_RETURN(status=1)
  678. ! call MDF_Put_Var( fid, varid_dec, (/(ddate_avg)/), status)
  679. ! IF_NOTOK_RETURN(status=1)
  680. ! call MDF_Put_Var( fid, varid_cal_int, (/(i,i=1,size(idate_avg))/), status)
  681. ! IF_NOTOK_RETURN(status=1)
  682. ! call MDF_Put_Var( fid, varid_date_int, idate_avg, status)
  683. ! IF_NOTOK_RETURN(status=1)
  684. ! call MDF_Put_Var( fid, varid_lon, ncout(region)%lonMean, status)
  685. ! IF_NOTOK_RETURN(status=1)
  686. ! call MDF_Put_Var( fid, varid_lat, ncout(region)%latMean, status)
  687. ! IF_NOTOK_RETURN(status=1)
  688. ! call MDF_Put_Var( fid, varid_lvl, (/(i,i=1,lm(region))/), status)
  689. ! IF_NOTOK_RETURN(status=1)
  690. ! call MDF_Put_Var( fid, varid_bnd, (/(i,i=1,lm(region)+1)/), status)
  691. ! IF_NOTOK_RETURN(status=1)
  692. ! call MDF_Put_Var( fid, varid_tracer, reshape(ncout(region)%field, (/imHalo,jmHalo,lm(region),ntracetloc,1/)), status)
  693. ! IF_NOTOK_RETURN(status=1)
  694. ! call MDF_Put_Var( fid, varid_tracernm, names, status)
  695. ! IF_NOTOK_RETURN(status=1)
  696. ! call MDF_Put_Var( fid, varid_press, ncout(region)%pressure, status)
  697. ! IF_NOTOK_RETURN(status=1)
  698. ! call MDF_Put_Var( fid, varid_gph, ncout(region)%gph, status)
  699. ! IF_NOTOK_RETURN(status=1)
  700. ! call MDF_Put_Var( fid, varid_orography, ncout(region)%orography, status)
  701. ! IF_NOTOK_RETURN(status=1)
  702. ! call MDF_Put_Var( fid, varid_temperature, ncout(region)%temperature, status)
  703. ! IF_NOTOK_RETURN(status=1)
  704. ! ! close file
  705. ! call MDF_Close( fid, status )
  706. ! IF_NOTOK_RETURN(status=1)
  707. ! write (gol, '("[user_output_mix_write] Done writing arrays and closing output file.")'); call goPr
  708. ! ncfile(region)%orography = 0.0
  709. ! ncfile(region)%temperature = 0.0
  710. ! ncfile(region)%gph = 0.0
  711. ! ncfile(region)%ps = 0.0
  712. ! ncfile(region)%field = 0.0
  713. ! ncfile(region)%wda = 0.0
  714. ! ncfile(region)%idate_start = ncfile(region)%idate_end ! end of interval becomes start of next interval
  715. ! nullify(zoomed)
  716. ! deallocate(ncout(region)%orography)
  717. ! deallocate(ncout(region)%temperature)
  718. ! deallocate(ncout(region)%pressure)
  719. ! deallocate(ncout(region)%gph)
  720. ! deallocate(ncout(region)%field)
  721. ! deallocate(ncout(region)%lonMean)
  722. ! deallocate(ncout(region)%latMean)
  723. ! deallocate(ncout(region)%lonEdge)
  724. ! deallocate(ncout(region)%latEdge)
  725. ! ok
  726. status = 0
  727. end subroutine user_output_mix_write
  728. end module user_output_mix