tm5_restart.F90 83 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109
  1. !
  2. #define TRACEBACK write (gol,'("in ",a," (",a,", line",i5,")")') rname, __FILE__, __LINE__; call goErr
  3. #define IF_NOTOK_RETURN(action) if (status/=0) then; TRACEBACK; action; return; end if
  4. #define IF_NOTOK_MDF(action) if (status/=0) then; TRACEBACK; action; if (isRoot) call MDF_CLose(fid,status); status=1; return; end if
  5. #define IF_ERROR_RETURN(action) if (status> 0) then; TRACEBACK; action; return; end if
  6. !
  7. #include "tm5.inc"
  8. !
  9. !----------------------------------------------------------------------------
  10. ! TM5 !
  11. !----------------------------------------------------------------------------
  12. !BOP
  13. !
  14. ! !MODULE: RESTART
  15. !
  16. ! !DESCRIPTION: Write and read restart files. This version differs from the
  17. ! 'base' version by accounting for "with_online_nox",
  18. ! "with_online_bvoc", and "with_m7" cpp flags, which read/write
  19. ! additional datasets.
  20. !\\
  21. !\\
  22. ! !INTERFACE:
  23. !
  24. MODULE RESTART
  25. !
  26. ! !USES:
  27. !
  28. use GO , only : gol, goPr, goErr
  29. use dims , only : nregions
  30. implicit none
  31. private
  32. !
  33. ! !PUBLIC MEMBER FUNCTIONS:
  34. !
  35. public :: Restart_Init ! read restart keys in rc file
  36. public :: Restart_Done ! nothing yet
  37. public :: Restart_Save ! wrapper around Restart_Write
  38. public :: Restart_Write ! write a restart file
  39. public :: Restart_Read ! read a restart file
  40. public :: rs_write ! model must write restart
  41. !
  42. ! !PRIVATE DATA MEMBERS:
  43. !
  44. character(len=*), parameter :: mname = 'Restart'
  45. character(len=256) :: rs_write_dir
  46. logical :: rs_write
  47. logical :: rs_write_extra
  48. integer :: rs_write_extra_dhour, rs_write_extra_hour
  49. integer :: fid ! file id for IF_NOTOK_MDF macro
  50. !
  51. ! !REVISION HISTORY:
  52. ! 25 Aug 2010 - P. Le Sager - Merged with Base version for Pycasso
  53. ! 8 Apr 2011 - P. Le Sager - Close MDF file if error occurs. This is
  54. ! needed for mpi_abort not to hang. See TM5_MPI_Abort in
  55. ! partools, and remarks below. Made IF_NOTOK_MDF macro for
  56. ! that purpose.
  57. ! 28 Apr 2011 - P. Le Sager - Read method : handle restart file with extra
  58. ! tracers.
  59. ! 10 Oct 2011 - P. Le Sager - adapted for lon-lat MPI domain decomposition
  60. !
  61. ! !REMARKS:
  62. ! (1) when an error occurs when accessing MDF files, you should first close
  63. ! the file before returning. The IF_NOTOK_MDF macro takes care of that.
  64. ! The only thing you need is to call it like that :
  65. !
  66. ! IF_NOTOK_MDF(fid=xxxx)
  67. !
  68. ! where you replace xxxx with the integer id (file handler) of the file
  69. ! you are accessing. Note that this does not solve all problems (but
  70. ! probably most of them): it is still possible that MDF_Close hangs...
  71. !
  72. !EOP
  73. !------------------------------------------------------------------------
  74. CONTAINS
  75. !--------------------------------------------------------------------------
  76. ! TM5 !
  77. !--------------------------------------------------------------------------
  78. !BOP
  79. !
  80. ! !IROUTINE: RESTART_INIT
  81. !
  82. ! !DESCRIPTION: read settings from rcfile
  83. !\\
  84. !\\
  85. ! !INTERFACE:
  86. !
  87. SUBROUTINE RESTART_INIT( status )
  88. !
  89. ! !USES:
  90. !
  91. use GO , only : TrcFile, Init, Done, ReadRc
  92. use global_data, only : rcfile
  93. use global_data, only : outdir
  94. use meteodata , only : lli
  95. !
  96. ! !OUTPUT PARAMETERS:
  97. !
  98. integer, intent(out) :: status
  99. !
  100. ! !REVISION HISTORY:
  101. !
  102. !EOP
  103. !------------------------------------------------------------------------
  104. !BOC
  105. character(len=*), parameter :: rname = 'Restart_Init'
  106. type(TrcFile) :: rcF
  107. ! ---- begin
  108. call Init( rcF, rcfile, status )
  109. IF_NOTOK_RETURN(status=1)
  110. ! write restart files at all ?
  111. call ReadRc( rcF, 'restart.write', rs_write, status, default=.false. )
  112. IF_ERROR_RETURN(status=1)
  113. ! further settings ...
  114. if ( rs_write ) then
  115. ! output directory:
  116. call ReadRc( rcF, 'restart.write.dir', rs_write_dir, status, default=outdir )
  117. IF_ERROR_RETURN(status=1)
  118. ! extra restart files ?
  119. call ReadRc( rcF, 'restart.write.extra', rs_write_extra, status, default=.false. )
  120. IF_ERROR_RETURN(status=1)
  121. if ( rs_write_extra ) then
  122. call ReadRc( rcF, 'restart.write.extra.hour', rs_write_extra_hour, status, default=0 )
  123. IF_ERROR_RETURN(status=1)
  124. call ReadRc( rcF, 'restart.write.extra.dhour', rs_write_extra_dhour, status, default=24 )
  125. IF_ERROR_RETURN(status=1)
  126. end if
  127. end if ! write restart files
  128. call Done( rcF, status )
  129. IF_NOTOK_RETURN(status=1)
  130. status = 0
  131. END SUBROUTINE RESTART_INIT
  132. !EOC
  133. !--------------------------------------------------------------------------
  134. ! TM5 !
  135. !--------------------------------------------------------------------------
  136. !BOP
  137. !
  138. ! !IROUTINE: RESTART_DONE
  139. !
  140. ! !DESCRIPTION:
  141. !\\
  142. !\\
  143. ! !INTERFACE:
  144. !
  145. SUBROUTINE RESTART_DONE( status )
  146. !
  147. ! !OUTPUT PARAMETERS:
  148. !
  149. integer, intent(out) :: status
  150. !
  151. ! !REVISION HISTORY:
  152. !
  153. !EOP
  154. !------------------------------------------------------------------------
  155. !BOC
  156. character(len=*), parameter :: rname = 'Restart_Done'
  157. ! --- begin --------------------------------
  158. ! nothing to be done ...
  159. ! ok
  160. status = 0
  161. END SUBROUTINE RESTART_DONE
  162. !EOC
  163. !--------------------------------------------------------------------------
  164. ! TM5 !
  165. !--------------------------------------------------------------------------
  166. !BOP
  167. !
  168. ! !IROUTINE: RESTART_SAVE
  169. !
  170. ! !DESCRIPTION:
  171. !\\
  172. !\\
  173. ! !INTERFACE:
  174. !
  175. SUBROUTINE RESTART_SAVE( status, extra, isfirst )
  176. !
  177. ! !USES:
  178. !
  179. use dims, only : idate
  180. !
  181. ! !OUTPUT PARAMETERS:
  182. !
  183. integer, intent(out) :: status
  184. !
  185. ! !INPUT PARAMETERS:
  186. !
  187. logical, intent(in), optional :: extra
  188. logical, intent(in), optional :: isfirst
  189. !
  190. ! !REVISION HISTORY:
  191. !
  192. !EOP
  193. !------------------------------------------------------------------------
  194. !BOC
  195. character(len=*), parameter :: rname = 'Restart_Save'
  196. logical :: is_extra
  197. real :: t1, t2
  198. ! --- begin --------------------------------
  199. ! options ...
  200. is_extra = .false.
  201. if ( present(extra) ) is_extra = extra
  202. ! write restart files at all ?
  203. if ( rs_write ) then
  204. ! end or extra ?
  205. if ( is_extra ) then
  206. ! save extra restart files ?
  207. if ( rs_write_extra ) then
  208. ! every hour+n*dhour only :
  209. if ( modulo( idate(4) - rs_write_extra_hour, rs_write_extra_dhour ) == 0 .and. &
  210. all( idate(5:6) == 0 ) ) then
  211. ! write restart file for this time:
  212. call Restart_Write( status, isfirst=isfirst )
  213. IF_NOTOK_RETURN(status=1)
  214. end if ! for this hour
  215. end if ! extra restart files ?
  216. else
  217. ! write restart file :
  218. call cpu_time(t1)
  219. call Restart_Write( status, isfirst=isfirst )
  220. IF_NOTOK_RETURN(status=1)
  221. call cpu_time(t2)
  222. write (gol,*) " time to write restart [s]: ", t2-t1 ; call goPr
  223. end if ! not extra
  224. end if ! write at all
  225. ! ok
  226. status = 0
  227. END SUBROUTINE RESTART_SAVE
  228. !EOC
  229. !--------------------------------------------------------------------------
  230. ! TM5 !
  231. !--------------------------------------------------------------------------
  232. !BOP
  233. !
  234. ! !IROUTINE: RESTART_FILENAME
  235. !
  236. ! !DESCRIPTION: Build restart filename from inputs.
  237. !\\
  238. !\\
  239. ! !INTERFACE:
  240. !
  241. SUBROUTINE RESTART_FILENAME( region, fname, status, key, dir, isfirst )
  242. !
  243. ! !USES:
  244. !
  245. use dims , only : idate
  246. use global_data, only : outdir
  247. use meteodata , only : lli
  248. !
  249. ! !INPUT PARAMETERS:
  250. !
  251. integer, intent(in) :: region
  252. logical, intent(in), optional :: isfirst
  253. character(len=*), intent(in), optional :: dir
  254. character(len=*), intent(in), optional :: key
  255. !
  256. ! !OUTPUT PARAMETERS:
  257. !
  258. character(len=*), intent(out) :: fname
  259. integer, intent(out) :: status
  260. !
  261. ! !REVISION HISTORY:
  262. ! 24 Aug 2010 - P. Le Sager - merged w/ trunk for pycasso
  263. !
  264. !EOP
  265. !------------------------------------------------------------------------
  266. !BOC
  267. character(len=*), parameter :: rname = 'Restart_FileName'
  268. character(len=256) :: adir
  269. character(len=32) :: akey
  270. ! --- begin --------------------------------
  271. ! destination directory:
  272. adir = trim(outdir)
  273. if ( present(dir) ) adir = trim(dir)
  274. ! extra key, for example '_x' to denote that
  275. ! a restart file was dumped after process 'x':
  276. akey = ''
  277. if ( present(key) ) akey = trim(key)
  278. ! if this is the initial time, add an extra key to avoid
  279. ! that the restart file for this hour from the previous
  280. ! run is overwritten:
  281. if ( present(isfirst) ) then
  282. if ( isfirst ) akey = trim(akey)//'_initial'
  283. end if
  284. ! write filename:
  285. write (fname,'(a,"/TM5_restart_",i4.4,2i2.2,"_",2i2.2,"_",a,a,".nc")') &
  286. trim(adir), idate(1:5), trim(lli(region)%name), trim(akey)
  287. ! ok
  288. status = 0
  289. END SUBROUTINE RESTART_FILENAME
  290. !EOC
  291. !--------------------------------------------------------------------------
  292. ! TM5 !
  293. !--------------------------------------------------------------------------
  294. !BOP
  295. !
  296. ! !IROUTINE: RESTART_WRITE
  297. !
  298. ! !DESCRIPTION: write restart
  299. !\\
  300. !\\
  301. ! !INTERFACE:
  302. !
  303. SUBROUTINE RESTART_WRITE( status, key, region, isfirst )
  304. !
  305. ! !USES:
  306. !
  307. use GO , only : Get
  308. use dims , only : nregions, at, bt
  309. use dims , only : iglbsfc
  310. use chem_param , only : ntracet, ntrace_chem, ntrace, names
  311. use partools , only : isRoot
  312. use tm5_distgrid, only : dgrid, Get_DistGrid, gather
  313. use global_data , only : mass_dat, chem_dat
  314. #ifdef with_tendencies
  315. use tm5_tendency, only : plc_ntr, plc_trname
  316. use tm5_tendency, only : plc_npr, plc_prname
  317. use tracer_data , only : plc_dat
  318. #endif
  319. #ifdef with_online_bvoc
  320. use emission_bvoc_data, only : megan, pceea
  321. use emission_bvoc_data, only : ndays_history, nhours_history, n_layers
  322. use emission_bvoc_data, only : skt_daily, pdir_daily, pdif_daily, ssr_daily
  323. use emission_bvoc_data, only : skt_10d_history, pdir_10d_history, pdif_10d_history, ssr_10d_history
  324. use emission_bvoc_data, only : skt_hourly, pdir_hourly, pdif_hourly
  325. use emission_bvoc_data, only : skt_24h_history, pdir_24h_history, pdif_24h_history
  326. use chem_param, only : iisop
  327. #endif
  328. #ifdef with_online_nox
  329. use online_nox_data, only : pulsing_on, ndrydays
  330. use online_nox_data, only : cp_daily, lsp_daily
  331. use online_nox_data, only : cp_history, lsp_history
  332. use online_nox_data, only : pulsing_field, plsday_field, plsdurat_field
  333. #endif
  334. #ifdef with_m7
  335. use mo_aero_m7, only : nsol, nmod
  336. use m7_data, only : h2o_mode, rw_mode, rwd_mode
  337. #endif
  338. use meteodata , only : global_lli, levi
  339. use meteodata , only : sp_dat, phlb_dat, m_dat
  340. use MDF , only : MDF_Create, MDF_EndDef, MDF_Close
  341. use MDF , only : MDF_Def_Dim, MDF_Def_Var
  342. use MDF , only : MDF_Put_Att, MDF_Put_Var
  343. use MDF , only : MDF_REPLACE, MDF_NETCDF4
  344. use MDF , only : MDF_FLOAT, MDF_DOUBLE, MDF_CHAR
  345. !
  346. ! !OUTPUT PARAMETERS:
  347. !
  348. integer, intent(out) :: status
  349. !
  350. ! !INPUT PARAMETERS:
  351. !
  352. character(len=*), intent(in), optional :: key
  353. integer, intent(in), optional :: region
  354. logical, intent(in), optional :: isfirst
  355. !
  356. ! !REVISION HISTORY:
  357. ! 8 Apr 2011 - P. Le Sager - use IF_NOTOK_MDF macro
  358. ! 16 Mar 2012 - P. Le Sager - adapted for lon-lat MPI domain decomposition
  359. !
  360. ! !REMARKS:
  361. ! - Serial writing not tested for cases: with_online_nox and with_online_bvoc (February 19, 2018)
  362. !
  363. !EOP
  364. !------------------------------------------------------------------------
  365. !BOC
  366. character(len=*), parameter :: rname = 'Restart_Write'
  367. integer :: imr, jmr, lmr, n
  368. character(len=256) :: fname
  369. integer :: ftype
  370. integer :: ncid
  371. integer :: dimid_lon, dimid_lat, dimid_lev, dimid_hlev
  372. integer :: dimid_lon_sfc, dimid_lat_sfc
  373. integer :: dimid_trace, dimid_trace_transp, dimid_trace_chem
  374. integer :: dimid_name
  375. integer :: varid, varid_at, varid_bt
  376. integer :: varid_sp, varid_ph, varid_m
  377. integer :: varid_names, varid_rm
  378. #ifdef slopes
  379. integer :: varid_rxm, varid_rym, varid_rzm
  380. #endif
  381. integer :: varid_rmc
  382. #ifdef with_tendencies
  383. integer :: varid_plc(plc_ntr,plc_npr)
  384. integer :: itr, ipr
  385. integer :: time6(6)
  386. #endif
  387. #ifdef with_online_bvoc
  388. integer :: dimid_lon_bvoc, dimid_lat_bvoc
  389. integer :: dimid_days_history, dimid_hours_history, dimid_layers
  390. integer :: varid_skt_daily, varid_pdir_daily, varid_pdif_daily, varid_ssr_daily
  391. integer :: varid_skt_10d_history, varid_pdir_10d_history, varid_pdif_10d_history, varid_ssr_10d_history
  392. integer :: varid_skt_hourly, varid_pdir_hourly, varid_pdif_hourly
  393. integer :: varid_skt_24h_history, varid_pdir_24h_history, varid_pdif_24h_history
  394. #endif
  395. #ifdef with_online_nox
  396. integer :: dimid_lon_nox, dimid_lat_nox
  397. integer :: dimid_drydays
  398. integer :: varid_cp_daily, varid_lsp_daily
  399. integer :: varid_cp_history, varid_lsp_history
  400. integer :: varid_pulsing, varid_plsday, varid_plsdurat
  401. #endif
  402. #ifdef with_m7
  403. integer :: varid_h2o, varid_rw, varid_rwd
  404. integer :: dimid_nsol, dimid_nmod
  405. integer :: imode
  406. character(len=3), parameter :: h2o_name = 'h2o'
  407. character(len=3), parameter :: rwd_name = 'rwd'
  408. character(len=2), parameter :: rw_name = 'rw'
  409. #endif
  410. integer :: rtype, n360, n180
  411. real, allocatable :: arr4d(:,:,:,:), arr3d(:,:,:)
  412. #if defined(with_online_bvoc) || defined(with_online_nox)
  413. real, allocatable :: glb_sfc3D(:,:,:), glb_sfc4D(:,:,:,:)
  414. #endif
  415. ! --- begin --------------------------------
  416. write (gol,'("write restart file(s) ...")'); call goPr
  417. ! loop over regions:
  418. REG: do n = 1, nregions
  419. ! only selected region ?
  420. if ( present(region) ) then
  421. if ( n /= region ) cycle
  422. end if
  423. ! entire region grid size
  424. imr = global_lli(n)%nlon
  425. jmr = global_lli(n)%nlat
  426. lmr = levi%nlev
  427. ! allocate 3D and 4D global arrays for gathering data
  428. if (isRoot) then
  429. allocate( arr4d(imr,jmr,lmr,ntracet) )
  430. allocate( arr3d(imr,jmr,lmr+1) )
  431. else
  432. allocate( arr4d(1,1,1,1) )
  433. allocate( arr3d(1,1,1) )
  434. endif
  435. ! get extra bounds for 1x1 dataset
  436. #if defined(with_online_bvoc) || defined(with_online_nox)
  437. if(n==1) then
  438. n360 = dgrid(iglbsfc)%im_region
  439. n180 = dgrid(iglbsfc)%jm_region
  440. if (isRoot) then
  441. allocate( glb_sfc3d(n360, n180, max(ndays_history, n_layers, ndrydays, nhours_history ) )
  442. allocate( glb_sfc4d(n360, n180, n_layers, ndays_history) )
  443. else
  444. allocate( glb_sfc3d(1,1,1) )
  445. allocate( glb_sfc4d(1,1,1,1) )
  446. endif
  447. end if
  448. #endif
  449. ! name of restart file
  450. call Restart_FileName( n, fname, status, key=key, dir=rs_write_dir, isfirst=isfirst )
  451. IF_NOTOK_RETURN(status=1)
  452. write (gol,'(" destination : ",a)') trim(fname); call goPr
  453. if (isRoot) then
  454. !------------------
  455. ! OPEN NETCDF FILE
  456. !------------------
  457. ! overwrite existing files (clobber)
  458. call MDF_Create( trim(fname), MDF_NETCDF4, MDF_REPLACE, ncid, status )
  459. IF_NOTOK_RETURN(status=1)
  460. !------------------
  461. ! DEFINE DIMENSIONS
  462. !------------------
  463. call MDF_Def_Dim( ncid, 'lon', imr, dimid_lon, status )
  464. IF_NOTOK_MDF(fid=ncid)
  465. call MDF_Def_Dim( ncid, 'lat', jmr, dimid_lat, status )
  466. IF_NOTOK_MDF(fid=ncid)
  467. call MDF_Def_Dim( ncid, 'lon_sfc', global_lli(iglbsfc)%nlon, dimid_lon_sfc, status )
  468. IF_NOTOK_MDF(fid=ncid)
  469. call MDF_Def_Dim( ncid, 'lat_sfc', global_lli(iglbsfc)%nlat, dimid_lat_sfc, status )
  470. IF_NOTOK_MDF(fid=ncid)
  471. call MDF_Def_Dim( ncid, 'lev', lmr, dimid_lev, status )
  472. IF_NOTOK_MDF(fid=ncid)
  473. call MDF_Def_Dim( ncid, 'hlev', lmr+1, dimid_hlev, status )
  474. IF_NOTOK_MDF(fid=ncid)
  475. call MDF_Def_Dim( ncid, 'trace_transp', ntracet, dimid_trace_transp, status )
  476. IF_NOTOK_MDF(fid=ncid)
  477. if ( ntrace_chem > 0 ) then
  478. call MDF_Def_Dim( ncid, 'trace_chem', ntrace_chem, dimid_trace_chem, status )
  479. IF_NOTOK_MDF(fid=ncid)
  480. else
  481. dimid_trace_chem = -1
  482. end if
  483. call MDF_Def_Dim( ncid, 'trace', ntrace, dimid_trace, status )
  484. IF_NOTOK_MDF(fid=ncid)
  485. call MDF_Def_Dim( ncid, 'name', len(names(1)), dimid_name, status )
  486. IF_NOTOK_MDF(fid=ncid)
  487. #ifdef with_online_bvoc
  488. ! MEGAN/PCEEA history
  489. if ( (megan .or. pceea) .and. (n == 1) ) then
  490. call MDF_Def_Dim( ncid, 'lon_bvoc', n360, dimid_lon_bvoc ,status)
  491. IF_NOTOK_MDF(fid=ncid)
  492. call MDF_Def_Dim( ncid, 'lat_bvoc', n180, dimid_lat_bvoc ,status)
  493. IF_NOTOK_MDF(fid=ncid)
  494. call MDF_Def_Dim( ncid, 'day_bvoc', ndays_history, dimid_days_history ,status)
  495. IF_NOTOK_MDF(fid=ncid)
  496. endif
  497. if (megan .and. (n == 1) ) then
  498. call MDF_Def_Dim( ncid, 'hour_bvoc', nhours_history, dimid_hours_history ,status)
  499. IF_NOTOK_MDF(fid=ncid)
  500. call MDF_Def_Dim( ncid, 'layer_bvoc', n_layers, dimid_layers ,status)
  501. IF_NOTOK_MDF(fid=ncid)
  502. endif
  503. #endif
  504. #ifdef with_online_nox
  505. ! precipitation history and pulsing parameters
  506. if (pulsing_on .and. (n == 1) ) then
  507. call MDF_Def_Dim( ncid, 'lon_nox', n360, dimid_lon_nox ,status)
  508. IF_NOTOK_MDF(fid=ncid)
  509. call MDF_Def_Dim( ncid, 'lat_nox', n180, dimid_lat_nox ,status)
  510. IF_NOTOK_MDF(fid=ncid)
  511. call MDF_Def_Dim( ncid, 'day_nox', ndrydays, dimid_drydays ,status)
  512. IF_NOTOK_MDF(fid=ncid)
  513. endif
  514. #endif
  515. #ifdef with_m7
  516. ! --------------------
  517. ! M7 fields for optics
  518. ! --------------------
  519. call MDF_Def_Dim( ncid, 'nsol', nsol, dimid_nsol, status )
  520. IF_NOTOK_MDF(fid=ncid)
  521. call MDF_Def_Dim( ncid, 'nmod', nmod, dimid_nmod, status )
  522. IF_NOTOK_MDF(fid=ncid)
  523. #endif
  524. !------------------
  525. ! DEFINE VARIABLES
  526. !------------------
  527. select case ( kind(m_dat(n)%data) )
  528. case ( 4 ) ; rtype = MDF_FLOAT
  529. case ( 8 ) ; rtype = MDF_DOUBLE
  530. case default
  531. write (gol,'("unsupported real kind : ",i6)') kind(m_dat(n)%data)
  532. TRACEBACK; status=1; return
  533. end select
  534. ! surface pressure
  535. call MDF_Def_Var( ncid, 'sp', rtype, (/dimid_lon,dimid_lat/), varid, status )
  536. IF_NOTOK_MDF(fid=ncid)
  537. call MDF_Put_Att( ncid, varid, 'long_name', 'surface pressure', status )
  538. IF_NOTOK_MDF(fid=ncid)
  539. call MDF_Put_Att( ncid, varid, 'unit', 'Pa', status )
  540. IF_NOTOK_MDF(fid=ncid)
  541. varid_sp = varid
  542. ! at, bt coefficients for hybrid grid
  543. call MDF_Def_Var( ncid, 'at', rtype, (/dimid_hlev/), varid, status )
  544. IF_NOTOK_MDF(fid=ncid)
  545. call MDF_Put_Att( ncid, varid, 'long_name', 'hybrid grid a_t coefficient', status )
  546. IF_NOTOK_MDF(fid=ncid)
  547. varid_at = varid
  548. call MDF_Def_Var( ncid, 'bt', rtype, (/dimid_hlev/), varid, status )
  549. IF_NOTOK_MDF(fid=ncid)
  550. call MDF_Put_Att( ncid, varid, 'long_name', 'hybrid grid b_t coefficient', status )
  551. IF_NOTOK_MDF(fid=ncid)
  552. varid_bt = varid
  553. ! half level pressure
  554. call MDF_Def_Var( ncid, 'ph', rtype, (/dimid_lon,dimid_lat,dimid_hlev/), varid, status )
  555. IF_NOTOK_MDF(fid=ncid)
  556. call MDF_Put_Att( ncid, varid, 'long_name', 'half level pressure', status )
  557. IF_NOTOK_MDF(fid=ncid)
  558. call MDF_Put_Att( ncid, varid, 'unit', 'Pa', status )
  559. IF_NOTOK_MDF(fid=ncid)
  560. varid_ph = varid
  561. ! air mass
  562. call MDF_Def_Var( ncid, 'm', rtype, (/dimid_lon,dimid_lat,dimid_lev/), varid, status )
  563. IF_NOTOK_MDF(fid=ncid)
  564. call MDF_Put_Att( ncid, varid, 'long_name', 'air mass', status )
  565. IF_NOTOK_MDF(fid=ncid)
  566. call MDF_Put_Att( ncid, varid, 'unit', 'kg', status )
  567. IF_NOTOK_MDF(fid=ncid)
  568. varid_m = varid
  569. !! accumulated surface fluxes
  570. !!
  571. !call MDF_Def_Var( ncid, 'slhf', rtype, (/dimid_lon_sfc,dimid_lat_sfc/), varid, status )
  572. !IF_NOTOK_MDF(fid=ncid)
  573. !call MDF_Put_Att( ncid, varid, 'long_name', 'surface latent heat flux', status )
  574. !IF_NOTOK_MDF(fid=ncid)
  575. !call MDF_Put_Att( ncid, varid, 'unit', 'W/m2', status )
  576. !IF_NOTOK_MDF(fid=ncid)
  577. !varid_slhf = varid
  578. !!
  579. !call MDF_Def_Var( ncid, 'sshf', rtype, (/dimid_lon_sfc,dimid_lat_sfc/), varid, status )
  580. !IF_NOTOK_MDF(fid=ncid)
  581. !call MDF_Put_Att( ncid, varid, 'long_name', 'surface sensible heat flux', status )
  582. !IF_NOTOK_MDF(fid=ncid)
  583. !call MDF_Put_Att( ncid, varid, 'unit', 'W/m2', status )
  584. !IF_NOTOK_MDF(fid=ncid)
  585. !varid_sshf = varid
  586. ! tracer names
  587. call MDF_Def_Var( ncid, 'names', MDF_CHAR, (/dimid_name,dimid_trace/), varid, status )
  588. IF_NOTOK_MDF(fid=ncid)
  589. call MDF_Put_Att( ncid, varid, 'long_name', 'tracer names', status )
  590. IF_NOTOK_MDF(fid=ncid)
  591. varid_names = varid
  592. ! tracer mass
  593. call MDF_Def_Var( ncid, 'rm', rtype, &
  594. (/dimid_lon,dimid_lat,dimid_lev,dimid_trace_transp/), varid, status )
  595. IF_NOTOK_MDF(fid=ncid)
  596. call MDF_Put_Att( ncid, varid, 'long_name', 'transported tracer mass', status )
  597. IF_NOTOK_MDF(fid=ncid)
  598. call MDF_Put_Att( ncid, varid, 'unit', 'kg', status )
  599. IF_NOTOK_MDF(fid=ncid)
  600. varid_rm = varid
  601. ! tracer mass slopes:
  602. #ifdef slopes
  603. call MDF_Def_Var( ncid, 'rxm', rtype, &
  604. (/dimid_lon,dimid_lat,dimid_lev,dimid_trace_transp/), varid, status )
  605. IF_NOTOK_MDF(fid=ncid)
  606. call MDF_Put_Att( ncid, varid, 'long_name', 'tracer mass slope in x direction', status )
  607. IF_NOTOK_MDF(fid=ncid)
  608. call MDF_Put_Att( ncid, varid, 'unit', 'kg/(half cell)', status )
  609. IF_NOTOK_MDF(fid=ncid)
  610. varid_rxm = varid
  611. call MDF_Def_Var( ncid, 'rym', rtype, &
  612. (/dimid_lon,dimid_lat,dimid_lev,dimid_trace_transp/), varid, status )
  613. IF_NOTOK_MDF(fid=ncid)
  614. call MDF_Put_Att( ncid, varid, 'long_name', 'tracer mass slope in y direction', status )
  615. IF_NOTOK_MDF(fid=ncid)
  616. call MDF_Put_Att( ncid, varid, 'unit', 'kg/(half cell)', status )
  617. IF_NOTOK_MDF(fid=ncid)
  618. varid_rym = varid
  619. call MDF_Def_Var( ncid, 'rzm', rtype, &
  620. (/dimid_lon,dimid_lat,dimid_lev,dimid_trace_transp/), varid, status )
  621. IF_NOTOK_MDF(fid=ncid)
  622. call MDF_Put_Att( ncid, varid, 'long_name', 'tracer mass slope in z direction', status )
  623. IF_NOTOK_MDF(fid=ncid)
  624. call MDF_Put_Att( ncid, varid, 'unit', 'kg/(half cell)', status )
  625. IF_NOTOK_MDF(fid=ncid)
  626. varid_rzm = varid
  627. #endif
  628. ! non-transported tracers:
  629. if ( ntrace_chem > 0 ) then
  630. call MDF_Def_Var( ncid, 'rmc', rtype, &
  631. (/dimid_lon,dimid_lat,dimid_lev,dimid_trace_chem/), varid, status )
  632. IF_NOTOK_MDF(fid=ncid)
  633. call MDF_Put_Att( ncid, varid, 'long_name', 'non-transported tracer mass', status )
  634. IF_NOTOK_MDF(fid=ncid)
  635. call MDF_Put_Att( ncid, varid, 'unit', 'kg', status )
  636. IF_NOTOK_MDF(fid=ncid)
  637. varid_rmc = varid
  638. end if
  639. #ifdef with_tendencies
  640. ! production, loss, and concentration:
  641. do itr = 1, plc_ntr
  642. do ipr = 1, plc_npr
  643. ! define netcdf variable:
  644. call MDF_Def_Var( ncid, trim(plc_trname(itr))//'_'//trim(plc_prname(ipr)), rtype, &
  645. (/dimid_lon,dimid_lat,dimid_lev/), varid, status )
  646. IF_NOTOK_MDF(fid=ncid)
  647. call MDF_Put_Att( ncid, varid, 'long_name', 'chemical tendency', status )
  648. IF_NOTOK_MDF(fid=ncid)
  649. call MDF_Put_Att( ncid, varid, 'unit', trim(plc_dat(region,itr,ipr)%unit), status )
  650. IF_NOTOK_MDF(fid=ncid)
  651. ! extract time as 6 integers:
  652. call Get( plc_dat(region,itr,ipr)%t, time6=time6 )
  653. ! add time attribute:
  654. call MDF_Put_Att( ncid, varid, 'time', time6, status )
  655. IF_NOTOK_MDF(fid=ncid)
  656. ! store variable id:
  657. varid_plc(itr,ipr) = varid
  658. end do
  659. end do
  660. #endif
  661. #ifdef with_online_bvoc
  662. ! MEGAN/PCEEA history parameters
  663. if ( (megan .or. pceea) .and. (n == 1) ) then
  664. call MDF_Def_Var( ncid, 'skt_daily', rtype, (/dimid_lon_bvoc,dimid_lat_bvoc/), varid, status )
  665. IF_NOTOK_MDF(fid=ncid)
  666. call MDF_Put_Att( ncid, varid, 'long_name', 'average skin temperature since the start of this day', status )
  667. IF_NOTOK_MDF(fid=ncid)
  668. call MDF_Put_Att( ncid, varid, 'unit', 'K', status )
  669. IF_NOTOK_MDF(fid=ncid)
  670. varid_skt_daily = varid
  671. !
  672. call MDF_Def_Var( ncid, 'skt_10d_history', rtype, (/dimid_lon_bvoc,dimid_lat_bvoc,dimid_days_history/), varid, status )
  673. IF_NOTOK_MDF(fid=ncid)
  674. call MDF_Put_Att( ncid, varid, 'long_name', '10-day skin temperature record', status )
  675. IF_NOTOK_MDF(fid=ncid)
  676. call MDF_Put_Att( ncid, varid, 'unit', 'K', status )
  677. IF_NOTOK_MDF(fid=ncid)
  678. varid_skt_10d_history = varid
  679. endif
  680. if (megan .and. (n == 1) ) then
  681. !
  682. call MDF_Def_Var( ncid, 'pdir_daily', rtype, (/dimid_lon_bvoc,dimid_lat_bvoc/), varid, status )
  683. IF_NOTOK_MDF(fid=ncid)
  684. call MDF_Put_Att( ncid, varid, 'long_name', &
  685. 'average direct component of the photosynthetic photon flux density since the start of this day', status )
  686. IF_NOTOK_MDF(fid=ncid)
  687. call MDF_Put_Att( ncid, varid, 'unit', 'umol/(m2 s)', status )
  688. IF_NOTOK_MDF(fid=ncid)
  689. varid_pdir_daily = varid
  690. !
  691. call MDF_Def_Var( ncid, 'pdir_10d_history', rtype, (/dimid_lon_bvoc,dimid_lat_bvoc,dimid_days_history/), varid, status )
  692. IF_NOTOK_MDF(fid=ncid)
  693. call MDF_Put_Att( ncid, varid, 'long_name', &
  694. '10-day record of the direct component of the photosynthetic photon flux density', status )
  695. IF_NOTOK_MDF(fid=ncid)
  696. call MDF_Put_Att( ncid, varid, 'unit', 'umol/(m2 s)', status )
  697. IF_NOTOK_MDF(fid=ncid)
  698. varid_pdir_10d_history = varid
  699. !
  700. call MDF_Def_Var( ncid, 'pdif_daily', rtype, (/dimid_lon_bvoc,dimid_lat_bvoc,dimid_layers/), varid, status )
  701. IF_NOTOK_MDF(fid=ncid)
  702. call MDF_Put_Att( ncid, varid, 'long_name', &
  703. 'average diffuse component of the photosynthetic photon flux density since the start of this day', status )
  704. IF_NOTOK_MDF(fid=ncid)
  705. call MDF_Put_Att( ncid, varid, 'unit', 'umol/(m2 s)', status )
  706. IF_NOTOK_MDF(fid=ncid)
  707. varid_pdif_daily = varid
  708. !
  709. call MDF_Def_Var( ncid, 'pdif_10d_history', rtype, &
  710. (/dimid_lon_bvoc,dimid_lat_bvoc,dimid_layers,dimid_days_history/), varid, status )
  711. IF_NOTOK_MDF(fid=ncid)
  712. call MDF_Put_Att( ncid, varid, 'long_name', &
  713. '10-day record of the diffuse component of the photosynthetic photon flux density', status )
  714. IF_NOTOK_MDF(fid=ncid)
  715. call MDF_Put_Att( ncid, varid, 'unit', 'umol/(m2 s)', status )
  716. IF_NOTOK_MDF(fid=ncid)
  717. varid_pdif_10d_history = varid
  718. !
  719. call MDF_Def_Var( ncid, 'skt_hourly', rtype, (/dimid_lon_bvoc,dimid_lat_bvoc/), varid, status )
  720. IF_NOTOK_MDF(fid=ncid)
  721. call MDF_Put_Att( ncid, varid, 'long_name', 'averaged skin temperature since the start of this hour', status )
  722. IF_NOTOK_MDF(fid=ncid)
  723. call MDF_Put_Att( ncid, varid, 'unit', 'K', status )
  724. IF_NOTOK_MDF(fid=ncid)
  725. varid_skt_hourly = varid
  726. !
  727. call MDF_Def_Var( ncid, 'skt_24h_history', rtype, (/dimid_lon_bvoc,dimid_lat_bvoc,dimid_hours_history/), varid, status )
  728. IF_NOTOK_MDF(fid=ncid)
  729. call MDF_Put_Att( ncid, varid, 'long_name', '24-hour skin temperature record', status )
  730. IF_NOTOK_MDF(fid=ncid)
  731. call MDF_Put_Att( ncid, varid, 'unit', 'K', status )
  732. IF_NOTOK_MDF(fid=ncid)
  733. varid_skt_24h_history = varid
  734. !
  735. call MDF_Def_Var( ncid, 'pdir_hourly', rtype, (/dimid_lon_bvoc,dimid_lat_bvoc/), varid, status )
  736. IF_NOTOK_MDF(fid=ncid)
  737. call MDF_Put_Att( ncid, varid, 'long_name', &
  738. 'average direct component of the photosynthetic photon flux density since the start of this hour', status )
  739. IF_NOTOK_MDF(fid=ncid)
  740. call MDF_Put_Att( ncid, varid, 'unit', 'umol/(m2 s)', status )
  741. IF_NOTOK_MDF(fid=ncid)
  742. varid_pdir_hourly = varid
  743. !
  744. call MDF_Def_Var( ncid, 'pdir_24h_history', rtype, (/dimid_lon_bvoc,dimid_lat_bvoc,dimid_hours_history/), varid, status )
  745. IF_NOTOK_MDF(fid=ncid)
  746. call MDF_Put_Att( ncid, varid, 'long_name', &
  747. '24-hour record of the direct component of the photosynthetic photon flux density', status )
  748. IF_NOTOK_MDF(fid=ncid)
  749. call MDF_Put_Att( ncid, varid, 'unit', 'umol/(m2 s)', status )
  750. IF_NOTOK_MDF(fid=ncid)
  751. varid_pdir_24h_history = varid
  752. !
  753. call MDF_Def_Var( ncid, 'pdif_hourly', rtype, (/dimid_lon_bvoc,dimid_lat_bvoc,dimid_layers/), varid, status )
  754. IF_NOTOK_MDF(fid=ncid)
  755. call MDF_Put_Att( ncid, varid, 'long_name', &
  756. 'average diffuse component of the photosynthetic photon flux density since the start of this hour', status )
  757. IF_NOTOK_MDF(fid=ncid)
  758. call MDF_Put_Att( ncid, varid, 'unit', 'umol/(m2 s)', status )
  759. IF_NOTOK_MDF(fid=ncid)
  760. varid_pdif_hourly = varid
  761. !
  762. call MDF_Def_Var( ncid, 'pdif_24h_history', rtype, &
  763. (/dimid_lon_bvoc,dimid_lat_bvoc,dimid_layers,dimid_hours_history/), varid, status )
  764. IF_NOTOK_MDF(fid=ncid)
  765. call MDF_Put_Att( ncid, varid, 'long_name', &
  766. '24-hour record of the diffuse component of the photosynthetic photon flux density', status )
  767. IF_NOTOK_MDF(fid=ncid)
  768. call MDF_Put_Att( ncid, varid, 'unit', 'umol/(m2 s)', status )
  769. IF_NOTOK_MDF(fid=ncid)
  770. varid_pdif_24h_history = varid
  771. !
  772. else if ( pceea .and. (n == 1) ) then
  773. !
  774. call MDF_Def_Var( ncid, 'ssr_daily', rtype, (/dimid_lon_bvoc,dimid_lat_bvoc/), varid, status )
  775. IF_NOTOK_MDF(fid=ncid)
  776. call MDF_Put_Att( ncid, varid, 'long_name', 'average surface solar radiation since the start of this day', status )
  777. IF_NOTOK_MDF(fid=ncid)
  778. call MDF_Put_Att( ncid, varid, 'unit', 'W/m2', status )
  779. IF_NOTOK_MDF(fid=ncid)
  780. varid_ssr_daily = varid
  781. !
  782. call MDF_Def_Var( ncid, 'ssr_10d_history', rtype, (/dimid_lon_bvoc,dimid_lat_bvoc,dimid_days_history/), varid, status )
  783. IF_NOTOK_MDF(fid=ncid)
  784. call MDF_Put_Att( ncid, varid, 'long_name', '10-day surface solar radiation record', status )
  785. IF_NOTOK_MDF(fid=ncid)
  786. call MDF_Put_Att( ncid, varid, 'unit', 'W/m2', status )
  787. IF_NOTOK_MDF(fid=ncid)
  788. varid_ssr_10d_history = varid
  789. !
  790. endif
  791. #endif
  792. #ifdef with_online_nox
  793. ! precipitation history and pulsing parameters
  794. if (pulsing_on .and. (n == 1) ) then
  795. !
  796. call MDF_Def_Var( ncid, 'cp_daily', rtype, (/dimid_lon_nox,dimid_lat_nox/), varid, status )
  797. IF_NOTOK_MDF(fid=ncid)
  798. call MDF_Put_Att( ncid, varid, 'long_name', 'daily accumulated convective rainfall', status )
  799. IF_NOTOK_MDF(fid=ncid)
  800. call MDF_Put_Att( ncid, varid, 'unit', 'm', status )
  801. IF_NOTOK_MDF(fid=ncid)
  802. varid_cp_daily = varid
  803. !
  804. call MDF_Def_Var( ncid, 'lsp_daily', rtype, (/dimid_lon_nox,dimid_lat_nox/), varid, status )
  805. IF_NOTOK_MDF(fid=ncid)
  806. call MDF_Put_Att( ncid, varid, 'long_name', 'daily accumulated large-scale rainfall', status )
  807. IF_NOTOK_MDF(fid=ncid)
  808. call MDF_Put_Att( ncid, varid, 'unit', 'm', status )
  809. IF_NOTOK_MDF(fid=ncid)
  810. varid_lsp_daily = varid
  811. !
  812. call MDF_Def_Var( ncid, 'cp_history', rtype, (/dimid_lon_nox,dimid_lat_nox,dimid_drydays/), varid, status )
  813. IF_NOTOK_MDF(fid=ncid)
  814. call MDF_Put_Att( ncid, varid, 'long_name', '14-day convective rainfall record', status )
  815. IF_NOTOK_MDF(fid=ncid)
  816. call MDF_Put_Att( ncid, varid, 'unit', 'm', status )
  817. IF_NOTOK_MDF(fid=ncid)
  818. varid_cp_history = varid
  819. !
  820. call MDF_Def_Var( ncid, 'lsp_history', rtype, (/dimid_lon_nox,dimid_lat_nox,dimid_drydays/), varid, status )
  821. IF_NOTOK_MDF(fid=ncid)
  822. call MDF_Put_Att( ncid, varid, 'long_name', '14-day large-scale rainfall record', status )
  823. IF_NOTOK_MDF(fid=ncid)
  824. call MDF_Put_Att( ncid, varid, 'unit', 'm', status )
  825. IF_NOTOK_MDF(fid=ncid)
  826. varid_lsp_history = varid
  827. !
  828. call MDF_Def_Var( ncid, 'pulsing', rtype, (/dimid_lon_nox,dimid_lat_nox/), varid, status )
  829. IF_NOTOK_MDF(fid=ncid)
  830. call MDF_Put_Att( ncid, varid, 'long_name', 'pulsing regime', status )
  831. IF_NOTOK_MDF(fid=ncid)
  832. call MDF_Put_Att( ncid, varid, 'unit', 'unity', status )
  833. IF_NOTOK_MDF(fid=ncid)
  834. varid_pulsing = varid
  835. !
  836. call MDF_Def_Var( ncid, 'plsday', rtype, (/dimid_lon_nox,dimid_lat_nox/), varid, status )
  837. IF_NOTOK_MDF(fid=ncid)
  838. call MDF_Put_Att( ncid, varid, 'long_name', 'time of pulsing', status )
  839. IF_NOTOK_MDF(fid=ncid)
  840. call MDF_Put_Att( ncid, varid, 'unit', 'days', status )
  841. IF_NOTOK_MDF(fid=ncid)
  842. varid_plsday = varid
  843. !
  844. call MDF_Def_Var( ncid, 'plsdurat', rtype, (/dimid_lon_nox,dimid_lat_nox/), varid, status )
  845. IF_NOTOK_MDF(fid=ncid)
  846. call MDF_Put_Att( ncid, varid, 'long_name', 'duration of pulse', status )
  847. IF_NOTOK_MDF(fid=ncid)
  848. call MDF_Put_Att( ncid, varid, 'unit', 'days', status )
  849. IF_NOTOK_MDF(fid=ncid)
  850. varid_plsdurat = varid
  851. !
  852. endif
  853. #endif
  854. #ifdef with_m7
  855. #ifndef without_chemistry
  856. ! --------------------
  857. ! M7 fields for optics
  858. ! --------------------
  859. ! water fields
  860. call MDF_Def_Var( ncid, trim(h2o_name), rtype, (/dimid_lon,dimid_lat,dimid_lev,dimid_nsol/), varid, status )
  861. IF_NOTOK_MDF(fid=ncid)
  862. call MDF_Put_Att( ncid, varid, 'long_name', 'aerosol water content', status)
  863. IF_NOTOK_MDF(fid=ncid)
  864. call MDF_Put_Att( ncid, varid, 'unit', 'kg', status)
  865. IF_NOTOK_MDF(fid=ncid)
  866. varid_h2o = varid
  867. ! dry radii for soluble modes
  868. call MDF_Def_Var( ncid, trim(rwd_name), rtype, (/dimid_lon,dimid_lat,dimid_lev,dimid_nsol/), varid, status )
  869. IF_NOTOK_MDF(fid=ncid)
  870. call MDF_Put_Att( ncid, varid, 'long_name', 'mode dry radius', status )
  871. IF_NOTOK_MDF(fid=ncid)
  872. call MDF_Put_Att( ncid, varid, 'unit', 'm', status )
  873. IF_NOTOK_MDF(fid=ncid)
  874. varid_rwd = varid
  875. ! wet radii
  876. call MDF_Def_Var( ncid, trim(rw_name), rtype, (/dimid_lon,dimid_lat,dimid_lev,dimid_nmod/), varid, status )
  877. IF_NOTOK_MDF(fid=ncid)
  878. call MDF_Put_Att( ncid, varid, 'long_name', 'mode radius', status )
  879. IF_NOTOK_MDF(fid=ncid)
  880. call MDF_Put_Att( ncid, varid, 'unit', 'm', status )
  881. IF_NOTOK_MDF(fid=ncid)
  882. varid_rw = varid
  883. #endif
  884. #endif
  885. !------------------
  886. ! END DEFINITION MODE
  887. !------------------
  888. call MDF_EndDef( ncid, status )
  889. IF_NOTOK_MDF(fid=ncid)
  890. endif
  891. !------------------
  892. ! WRITE VARIABLES
  893. !------------------
  894. ! surface pressure
  895. call gather( dgrid(n), sp_dat(n)%data, arr3d(:,:,1:1), sp_dat(n)%halo, status)
  896. IF_NOTOK_RETURN(status=1)
  897. if (isRoot) call MDF_Put_Var( ncid, varid_sp, arr3d(:,:,1), status )
  898. IF_NOTOK_MDF(fid=ncid)
  899. ! half level pressure
  900. call gather( dgrid(n), phlb_dat(n)%data, arr3d, phlb_dat(n)%halo, status)
  901. IF_NOTOK_RETURN(status=1)
  902. if (isRoot) call MDF_Put_Var( ncid, varid_ph, arr3d, status)
  903. IF_NOTOK_MDF(fid=ncid)
  904. ! at, bt coefficients
  905. if (isRoot) then
  906. call MDF_Put_Var( ncid, varid_at, at(1:lmr+1), status )
  907. IF_NOTOK_MDF(fid=ncid)
  908. call MDF_Put_Var( ncid, varid_bt, bt(1:lmr+1), status )
  909. IF_NOTOK_MDF(fid=ncid)
  910. end if
  911. ! air mass
  912. call gather( dgrid(n), m_dat(n)%data, arr4d(:,:,:,1), m_dat(n)%halo, status)
  913. IF_NOTOK_RETURN(status=1)
  914. if (isRoot) call MDF_Put_Var( ncid, varid_m, arr4d(:,:,:,1), status)
  915. IF_NOTOK_MDF(fid=ncid)
  916. !! surface latent heat flux; global surface field !
  917. !call MDF_Put_Var( ncid, varid_slhf, slhf_dat(iglbsfc)%data(1:n360,1:n180,1), status )
  918. !IF_NOTOK_MDF(fid=ncid)
  919. !
  920. !! surface sensible heat flux; global surface field !
  921. !call MDF_Put_Var( ncid, varid_sshf, sshf_dat(iglbsfc)%data(1:n360,1:n180,1), status )
  922. !IF_NOTOK_MDF(fid=ncid)
  923. ! tracer names
  924. if (isRoot) call MDF_Put_Var( ncid, varid_names, names, status )
  925. IF_NOTOK_MDF(fid=ncid)
  926. ! write transported tracers
  927. call gather( dgrid(n), mass_dat(n)%rm, arr4d, mass_dat(n)%halo, status)
  928. IF_NOTOK_RETURN(status=1)
  929. if (isRoot) call MDF_Put_Var( ncid, varid_rm, arr4d, status)
  930. IF_NOTOK_MDF(fid=ncid)
  931. #ifdef slopes
  932. call gather( dgrid(n), mass_dat(n)%rxm, arr4d, mass_dat(n)%halo, status)
  933. IF_NOTOK_RETURN(status=1)
  934. if (isRoot) call MDF_Put_Var( ncid, varid_rxm, arr4d, status)
  935. IF_NOTOK_MDF(fid=ncid)
  936. call gather( dgrid(n), mass_dat(n)%rym, arr4d, mass_dat(n)%halo, status)
  937. IF_NOTOK_RETURN(status=1)
  938. if (isRoot) call MDF_Put_Var( ncid, varid_rym, arr4d, status)
  939. IF_NOTOK_MDF(fid=ncid)
  940. call gather( dgrid(n), mass_dat(n)%rzm, arr4d, mass_dat(n)%halo, status)
  941. IF_NOTOK_RETURN(status=1)
  942. if (isRoot) call MDF_Put_Var( ncid, varid_rzm, arr4d, status)
  943. IF_NOTOK_MDF(fid=ncid)
  944. #endif
  945. ! write non-transported tracers
  946. if (ntrace_chem > 0) then
  947. call gather( dgrid(n), chem_dat(n)%rm, arr4d(:,:,:,1:ntrace_chem), chem_dat(n)%halo, status)
  948. IF_NOTOK_RETURN(status=1)
  949. if (isRoot) call MDF_Put_Var( ncid, varid_rmc, arr4d(:,:,:,1:ntrace_chem), status)
  950. IF_NOTOK_MDF(fid=ncid)
  951. end if
  952. #ifdef with_tendencies
  953. ! write production/loss/concentration levels on this pe:
  954. do itr = 1, plc_ntr
  955. do ipr = 1, plc_npr
  956. call gather( dgrid(n), plc_dat(n,itr,ipr)%rm, arr3d(:,:,1:lmr), 0, status)
  957. IF_NOTOK_RETURN(status=1)
  958. if (isRoot) call MDF_Put_Var( ncid, varid_plc(itr,ipr), arr3d(:,:,1:lmr), status )
  959. IF_NOTOK_MDF(fid=ncid)
  960. end do
  961. end do
  962. #endif
  963. #ifdef with_online_bvoc
  964. ! MEGAN/PCEEA history parameters; write only once
  965. if (n==1) then
  966. if (megan .or. pceea) then
  967. call gather( dgrid(n), skt_daily, glb_sfc3D(:,:,1), 0, status)
  968. IF_NOTOK_RETURN(status=1)
  969. if (isRoot) call MDF_Put_Var( ncid, varid_skt_daily, glb_sfc3D(:,:,1), status)
  970. IF_NOTOK_MDF(fid=ncid)
  971. call gather( dgrid(n), skt_10d_history, glb_sfc3D(:,:,1:ndays_history), 0, status)
  972. IF_NOTOK_RETURN(status=1)
  973. if (isRoot) call MDF_Put_Var( ncid, varid_skt_10d_history, glb_sfc3D(:,:,1:ndays_history), status)
  974. IF_NOTOK_MDF(fid=ncid)
  975. endif
  976. !
  977. if (megan) then
  978. call gather( dgrid(n), pdir_daily, glb_sfc3D(:,:,1), 0, status)
  979. IF_NOTOK_RETURN(status=1)
  980. if (isRoot) call MDF_Put_Var( ncid, varid_pdir_daily, glb_sfc3D(:,:,1), status)
  981. IF_NOTOK_MDF(fid=ncid)
  982. call gather( dgrid(n), skt_daily, glb_sfc3D(:,:,1:ndays_history), 0, status)
  983. IF_NOTOK_RETURN(status=1)
  984. if (isRoot) call MDF_Put_Var( ncid, varid_pdir_10d_history, glb_sfc3D(:,:,1:ndays_history), status)
  985. IF_NOTOK_MDF(fid=ncid)
  986. call gather( dgrid(n), skt_daily, glb_sfc3D(:,:,1:n_layers), 0, status)
  987. IF_NOTOK_RETURN(status=1)
  988. if (isRoot) call MDF_Put_Var( ncid, varid_pdif_daily, glb_sfc3D(:,:,1:n_layers), status)
  989. IF_NOTOK_MDF(fid=ncid)
  990. call gather( dgrid(n), skt_daily, glb_sfc4D, 0, status)
  991. IF_NOTOK_RETURN(status=1)
  992. if (isRoot) call MDF_Put_Var( ncid, varid_pdif_10d_history, glb_sfc4D, status)
  993. IF_NOTOK_MDF(fid=ncid)
  994. call gather( dgrid(n), skt_daily, glb_sfc3D(:,:,1), 0, status)
  995. IF_NOTOK_RETURN(status=1)
  996. if (isRoot) call MDF_Put_Var( ncid, varid_skt_hourly, glb_sfc3D(:,:,1), status)
  997. IF_NOTOK_MDF(fid=ncid)
  998. call gather( dgrid(n), skt_daily, glb_sfc3D(:,:,1:nhours_history), 0, status)
  999. IF_NOTOK_RETURN(status=1)
  1000. if (isRoot) call MDF_Put_Var( ncid, varid_skt_24h_history, glb_sfc3D(:,:,1:nhours_history), status)
  1001. IF_NOTOK_MDF(fid=ncid)
  1002. call gather( dgrid(n), skt_daily, glb_sfc3D(:,:,1), 0, status)
  1003. IF_NOTOK_RETURN(status=1)
  1004. if (isRoot) call MDF_Put_Var( ncid, varid_pdir_hourly, glb_sfc3D(:,:,1), status)
  1005. IF_NOTOK_MDF(fid=ncid)
  1006. call gather( dgrid(n), skt_daily, glb_sfc3D(:,:,1:nhours_history), 0, status)
  1007. IF_NOTOK_RETURN(status=1)
  1008. if (isRoot) call MDF_Put_Var( ncid, varid_pdir_24h_history, glb_sfc3D(:,:,1:nhours_history), status)
  1009. IF_NOTOK_MDF(fid=ncid)
  1010. call gather( dgrid(n), skt_daily, glb_sfc3D(:,:,1:n_layers), 0, status)
  1011. IF_NOTOK_RETURN(status=1)
  1012. if (isRoot) call MDF_Put_Var( ncid, varid_pdif_hourly, glb_sfc3D(:,:,1:n_layers), status)
  1013. IF_NOTOK_MDF(fid=ncid)
  1014. call gather( dgrid(n), skt_daily, glb_sfc4D, 0, status)
  1015. IF_NOTOK_RETURN(status=1)
  1016. if (isRoot) call MDF_Put_Var( ncid, varid_pdif_24h_history, glb_sfc4D, status)
  1017. IF_NOTOK_MDF(fid=ncid)
  1018. else if (pceea) then
  1019. call gather( dgrid(n), skt_daily, glb_sfc3D(:,:,1), 0, status)
  1020. IF_NOTOK_RETURN(status=1)
  1021. if (isRoot) call MDF_Put_Var( ncid, varid_ssr_daily, glb_sfc3D(:,:,1), status)
  1022. IF_NOTOK_MDF(fid=ncid)
  1023. call gather( dgrid(n), skt_daily, glb_sfc3D(:,:,1:ndays_history), 0, status)
  1024. IF_NOTOK_RETURN(status=1)
  1025. if (isRoot) call MDF_Put_Var( ncid, varid_ssr_10d_history, glb_sfc3D(:,:,1:ndays_history), status)
  1026. IF_NOTOK_MDF(fid=ncid)
  1027. endif
  1028. !
  1029. endif
  1030. #endif
  1031. #ifdef with_online_nox
  1032. if (pulsing_on .and. (n == 1) ) then
  1033. ! precipitation history and pulsing parameters; write only once
  1034. call gather( dgrid(n), skt_daily, glb_sfc3D(:,:,1), 0, status)
  1035. IF_NOTOK_RETURN(status=1)
  1036. if (isRoot) call MDF_Put_Var( ncid, varid_cp_daily, glb_sfc3D(:,:,1), status)
  1037. IF_NOTOK_MDF(fid=ncid)
  1038. call gather( dgrid(n), skt_daily, glb_sfc3D(:,:,1), 0, status)
  1039. IF_NOTOK_RETURN(status=1)
  1040. if (isRoot) call MDF_Put_Var( ncid, varid_lsp_daily, glb_sfc3D(:,:,1), status)
  1041. IF_NOTOK_MDF(fid=ncid)
  1042. call gather( dgrid(n), skt_daily, glb_sfc3D(:,:,1:ndrydays), 0, status)
  1043. IF_NOTOK_RETURN(status=1)
  1044. if (isRoot) call MDF_Put_Var( ncid, varid_cp_history, glb_sfc3D(:,:,1:ndrydays), status)
  1045. IF_NOTOK_MDF(fid=ncid)
  1046. call gather( dgrid(n), skt_daily, glb_sfc3D(:,:,1:ndrydays), 0, status)
  1047. IF_NOTOK_RETURN(status=1)
  1048. if (isRoot) call MDF_Put_Var( ncid, varid_lsp_history, glb_sfc3D(:,:,1:ndrydays), status)
  1049. IF_NOTOK_MDF(fid=ncid)
  1050. call gather( dgrid(n), skt_daily, glb_sfc3D(:,:,1), 0, status)
  1051. IF_NOTOK_RETURN(status=1)
  1052. if (isRoot) call MDF_Put_Var( ncid, varid_pulsing, glb_sfc3D(:,:,1), status)
  1053. IF_NOTOK_MDF(fid=ncid)
  1054. call gather( dgrid(n), skt_daily, glb_sfc3D(:,:,1), 0, status)
  1055. IF_NOTOK_RETURN(status=1)
  1056. if (isRoot) call MDF_Put_Var( ncid, varid_plsday, glb_sfc3D(:,:,1), status)
  1057. IF_NOTOK_MDF(fid=ncid)
  1058. call gather( dgrid(n), skt_daily, glb_sfc3D(:,:,1), 0, status)
  1059. IF_NOTOK_RETURN(status=1)
  1060. if (isRoot) call MDF_Put_Var( ncid, varid_plsdurat, glb_sfc3D(:,:,1), status)
  1061. IF_NOTOK_MDF(fid=ncid)
  1062. endif
  1063. #endif
  1064. #ifdef with_m7
  1065. #ifndef without_chemistry
  1066. do imode=1,nsol
  1067. call gather( dgrid(n), h2o_mode(n,imode)%d3, arr4d(:,:,:,imode), h2o_mode(n,imode)%halo, status)
  1068. IF_NOTOK_RETURN(status=1)
  1069. enddo
  1070. if (isRoot) call MDF_Put_Var( ncid, varid_h2o, arr4d(:,:,:,1:nsol), status)
  1071. IF_NOTOK_MDF(fid=ncid)
  1072. do imode=1,nsol
  1073. call gather( dgrid(n), rwd_mode(n,imode)%d3, arr4d(:,:,:,imode), rwd_mode(n,imode)%halo, status)
  1074. IF_NOTOK_RETURN(status=1)
  1075. enddo
  1076. if (isRoot) call MDF_Put_Var( ncid, varid_rwd, arr4d(:,:,:,1:nsol), status)
  1077. IF_NOTOK_MDF(fid=ncid)
  1078. do imode=1,nmod
  1079. call gather( dgrid(n), rw_mode(n,imode)%d3, arr4d(:,:,:,imode), rw_mode(n,imode)%halo, status)
  1080. IF_NOTOK_RETURN(status=1)
  1081. enddo
  1082. if (isRoot) call MDF_Put_Var( ncid, varid_rw, arr4d(:,:,:,1:nmod), status)
  1083. IF_NOTOK_MDF(fid=ncid)
  1084. #endif
  1085. #endif
  1086. ! Done
  1087. if (isRoot) call MDF_Close( ncid, status )
  1088. IF_NOTOK_RETURN(status=1)
  1089. deallocate(arr4d, arr3d)
  1090. #if defined(with_online_bvoc) || defined(with_online_nox)
  1091. deallocate(glb_sfc3D, glb_sfc4D)
  1092. #endif
  1093. end do REG
  1094. status = 0
  1095. END SUBROUTINE RESTART_WRITE
  1096. !EOC
  1097. !--------------------------------------------------------------------------
  1098. ! TM5 !
  1099. !--------------------------------------------------------------------------
  1100. !BOP
  1101. !
  1102. ! !IROUTINE: RESTART_READ
  1103. !
  1104. ! !DESCRIPTION: Read restart file. Case of istart=33 (can read any of the
  1105. ! available variables) or 32 (can read only tracer mass).
  1106. !\\
  1107. !\\
  1108. ! !INTERFACE:
  1109. !
  1110. SUBROUTINE RESTART_READ( status, region, &
  1111. surface_pressure, pressure, air_mass, surface_fluxes, &
  1112. tracer_mass, tendencies, megan_history, nox_pulsing )
  1113. !
  1114. ! !USES:
  1115. !
  1116. use GO, only : TrcFile, Init, Done, ReadRc
  1117. use GO, only : goMatchValue
  1118. use dims, only : nregions, im, jm, istart, idate, idatei
  1119. use dims, only : iglbsfc
  1120. use grid, only : TllGridInfo, TLevelInfo, Init, Done, Fill3D
  1121. use chem_param, only : ntracet, ntrace_chem, ntrace, ich4
  1122. use chem_param, only : names, tracer_name_len
  1123. use partools, only : isRoot, par_broadcast
  1124. use tm5_distgrid, only : dgrid, gather, scatter
  1125. use global_data, only : rcfile, mass_dat, chem_dat
  1126. #ifdef with_online_bvoc
  1127. use emission_bvoc_data, only : megan, pceea
  1128. use emission_bvoc_data, only : ndays_history, nhours_history, n_layers
  1129. use emission_bvoc_data, only : skt_daily, pdir_daily, pdif_daily, ssr_daily
  1130. use emission_bvoc_data, only : skt_10d_history, pdir_10d_history, pdif_10d_history, ssr_10d_history
  1131. use emission_bvoc_data, only : skt_hourly, pdir_hourly, pdif_hourly
  1132. use emission_bvoc_data, only : skt_24h_history, pdir_24h_history, pdif_24h_history
  1133. use chem_param, only : iisop
  1134. use partools, only : tracer_active
  1135. #endif
  1136. #ifdef with_online_nox
  1137. use online_nox_data, only : ndrydays
  1138. use online_nox_data, only : cp_daily, lsp_daily
  1139. use online_nox_data, only : cp_history, lsp_history
  1140. use online_nox_data, only : pulsing_field, plsday_field, plsdurat_field
  1141. ! use partools, only : root_k
  1142. #endif
  1143. #ifdef with_m7
  1144. use mo_aero_m7, only : nsol, nmod
  1145. use m7_data, only : h2o_mode, rw_mode, rwd_mode
  1146. #endif
  1147. use meteodata, only : levi, global_lli, sp_dat, phlb_dat, m_dat
  1148. !use meteodata, only : slhf_dat, sshf_dat
  1149. use MDF, only : MDF_Open, MDF_Close, MDF_Inquire_Dimension
  1150. use MDF, only : MDF_Inq_VarID, MDF_Inquire_Variable, MDF_Inq_DimID
  1151. use MDf, only : MDF_Var_Par_Access, MDF_INDEPENDENT, MDF_COLLECTIVE
  1152. use MDF, only : MDF_Get_Att, MDF_Get_Var
  1153. use MDF, only : MDF_READ, MDF_NETCDF4
  1154. !
  1155. ! !OUTPUT PARAMETERS:
  1156. !
  1157. integer, intent(out) :: status
  1158. !
  1159. ! !INPUT PARAMETERS:
  1160. !
  1161. integer, intent(in), optional :: region
  1162. logical, intent(in), optional :: surface_pressure, pressure, air_mass, surface_fluxes
  1163. logical, intent(in), optional :: tracer_mass, tendencies, megan_history, nox_pulsing
  1164. !
  1165. ! !REVISION HISTORY:
  1166. ! 8 Apr 2011 - P. Le Sager - use IF_NOTOK_MDF macro
  1167. ! 28 Apr 2011 - P. Le Sager - Check on tracer availability in restart file.
  1168. ! - Allows for more tracers in restart file than needed
  1169. ! 10 May 2011 - P. Le Sager - Added deallocate statement to work with zoom regions
  1170. ! 16 Mar 2012 - P. Le Sager - adapted for lon-lat MPI domain decomposition
  1171. !
  1172. ! !REMARKS:
  1173. ! - logically, if we need to remap, then meteo is not read from restart
  1174. ! (but from met field and used for remapping): in other words, only
  1175. ! tracer mass is read, and istart should be 32.
  1176. ! - Serial reading not tested for cases: with_online_nox and with_online_bvoc (February 19, 2018)
  1177. !
  1178. !EOP
  1179. !------------------------------------------------------------------------
  1180. !BOC
  1181. character(len=*), parameter :: rname = mname//'/Restart_Read'
  1182. character(len=tracer_name_len), allocatable :: values_names(:)
  1183. character(len=256) :: rs_read_dir, fname
  1184. type(TrcFile) :: rcF
  1185. logical :: exist
  1186. logical :: do_sp, do_ph, do_m, do_sflux, do_rm, do_megan, do_pulse
  1187. integer :: imr, jmr, lmr, imr_restart, jmr_restart, lmr_restart
  1188. integer :: n, region1, region2
  1189. integer :: ncid
  1190. integer :: varid_sp, varid_ph, varid_m, varid_rm, varid_rmc, varid_names
  1191. !integer :: varid_slhf, varid_sshf
  1192. integer :: itr, itr_file
  1193. integer :: ntracet_restart, dimid
  1194. integer :: shp(2)
  1195. #ifdef slopes
  1196. integer :: varid_rxm, varid_rym, varid_rzm
  1197. #endif
  1198. #ifdef with_online_bvoc
  1199. integer :: varid_skt_daily, varid_pdir_daily, varid_pdif_daily, varid_ssr_daily
  1200. integer :: varid_skt_10d_history, varid_pdir_10d_history, varid_pdif_10d_history, varid_ssr_10d_history
  1201. integer :: varid_skt_hourly, varid_pdir_hourly, varid_pdif_hourly
  1202. integer :: varid_skt_24h_history, varid_pdir_24h_history, varid_pdif_24h_history
  1203. #endif
  1204. #ifdef with_online_nox
  1205. integer :: varid_cp_daily, varid_lsp_daily
  1206. integer :: varid_cp_history, varid_lsp_history
  1207. integer :: varid_pulsing, varid_plsday, varid_plsdurat
  1208. #endif
  1209. #ifdef with_m7
  1210. integer :: varid_h2o, varid_rw, varid_rwd !! , varid_ini_gph
  1211. integer :: imode
  1212. character(len=3), parameter :: h2o_name = 'h2o'
  1213. character(len=3), parameter :: rwd_name = 'rwd'
  1214. character(len=2), parameter :: rw_name = 'rw'
  1215. #endif
  1216. ! global work arrays to read data
  1217. real, allocatable :: tmp4d(:,:,:,:)
  1218. real, allocatable :: tmp3d(:,:,:)
  1219. real, allocatable :: rmt(:,:,:,:),rms(:,:,:,:), rmx(:,:,:,:),rmy(:,:,:,:), rmz(:,:,:,:)
  1220. #if defined(with_online_bvoc) || defined(with_online_nox)
  1221. real, allocatable :: glb_sfc3D(:,:,:), glb_sfc4D(:,:,:,:)
  1222. integer :: n360, n180
  1223. #endif
  1224. ! for remapping:
  1225. logical :: need_vremap, need_hremap, need_remap
  1226. integer :: varid_at, varid_bt
  1227. real :: dx, dy
  1228. real :: factor_ch4
  1229. real, allocatable :: sp_gbl(:,:,:)
  1230. real, allocatable :: at_restart(:), bt_restart(:)
  1231. real, allocatable :: src_glb(:,:,:)
  1232. type(TllGridInfo) :: lli_restart
  1233. type(TLevelInfo) :: levi_restart
  1234. ! --- begin --------------------------------
  1235. if ( istart /= 33 .and. istart /= 32 ) then
  1236. write (gol,'(" skip read restart; istart not 33 or 32 but ",i2)') istart; call goPr
  1237. status=0; return
  1238. endif
  1239. if ( any( idate /= idatei ) ) then
  1240. write (gol,'(" skip read restart; idate not idatei but ",i4,5i2.2)') idate; call goPr
  1241. status=0; return
  1242. endif
  1243. ! input directory:
  1244. call Init( rcF, rcfile, status )
  1245. IF_NOTOK_RETURN(status=1)
  1246. call ReadRc( rcF, 'restart.read.dir', rs_read_dir, status )
  1247. IF_NOTOK_RETURN(status=1)
  1248. call ReadRc( rcF, 'restart.factor.ch4', factor_ch4, status, default = 1.0 )
  1249. IF_ERROR_RETURN(status=1)
  1250. call Done( rcF, status )
  1251. IF_NOTOK_RETURN(status=1)
  1252. ! region range:
  1253. if ( present(region) ) then
  1254. region1 = region
  1255. region2 = region
  1256. else
  1257. region1 = 1
  1258. region2 = nregions
  1259. end if
  1260. ! data sets:
  1261. do_rm = .false. ; if ( present(tracer_mass ) ) do_rm = tracer_mass
  1262. do_m = .false. ; if ( present(air_mass ).and.(istart==33) ) do_m = air_mass
  1263. do_sp = .false. ; if ( present(surface_pressure ).and.(istart==33) ) do_sp = surface_pressure
  1264. do_ph = .false. ; if ( present(pressure ).and.(istart==33) ) do_ph = pressure
  1265. do_sflux = .false. ; if ( present(surface_fluxes ).and.(istart==33) ) do_sflux = surface_fluxes
  1266. do_megan = .false. ; if ( present(megan_history ).and.(istart==33) ) do_megan = megan_history
  1267. do_pulse = .false. ; if ( present(nox_pulsing ).and.(istart==33) ) do_pulse = nox_pulsing
  1268. ! sorry ..
  1269. if ( do_sflux ) then
  1270. write (gol,'("no surface fluxes in restart files until somebody")') ; call goErr
  1271. write (gol,'("has a good idea on what should be storred:")') ; call goErr
  1272. write (gol,'(" o global surface field (1x1 ?)")') ; call goErr
  1273. write (gol,'(" o zoom regions")') ; call goErr
  1274. write (gol,'(" o both")') ; call goErr
  1275. TRACEBACK; status=1; return
  1276. end if
  1277. ! do we need anything?
  1278. if(.not.(do_rm.or.do_m.or.do_sp.or.do_ph.or.do_sflux.or.do_megan.or.do_pulse))then
  1279. status=0; return
  1280. endif
  1281. REG: do n = region1, region2
  1282. imr = global_lli(n)%nlon
  1283. jmr = global_lli(n)%nlat
  1284. lmr = levi%nlev
  1285. ! name of restart file
  1286. call Restart_FileName( n, fname, status, dir=trim(rs_read_dir) )
  1287. IF_NOTOK_RETURN(status=1)
  1288. write (gol,'(" read restart file: ",a)') trim(fname); call goPr
  1289. inquire( file=fname, exist=exist )
  1290. if ( .not. exist ) then
  1291. write (gol,'("restart file not found : ",a)') trim(fname); call goErr
  1292. TRACEBACK; status=1; return
  1293. end if
  1294. ! ** open netcdf file
  1295. if (isRoot) then
  1296. call MDF_Open( trim(fname), MDF_NETCDF4, MDF_READ, ncid, status )
  1297. IF_NOTOK_RETURN(status=1)
  1298. ! ** check for dimension compatibility
  1299. call MDF_Inq_DimID( ncid, 'lev', dimid, status )
  1300. IF_NOTOK_MDF(fid=ncid)
  1301. call MDF_Inquire_Dimension( ncid, dimid, status, length=lmr_restart )
  1302. IF_NOTOK_MDF(fid=ncid)
  1303. call MDF_Inq_DimID( ncid, 'lat', dimid, status )
  1304. IF_NOTOK_MDF(fid=ncid)
  1305. call MDF_Inquire_Dimension( ncid, dimid, status, length=jmr_restart )
  1306. IF_NOTOK_MDF(fid=ncid)
  1307. call MDF_Inq_DimID( ncid, 'lon', dimid, status )
  1308. IF_NOTOK_MDF(fid=ncid)
  1309. call MDF_Inquire_Dimension( ncid, dimid, status, length=imr_restart )
  1310. IF_NOTOK_MDF(fid=ncid)
  1311. need_vremap = (lmr /= lmr_restart)
  1312. need_hremap = (jmr /= jmr_restart) .or. (imr /= imr_restart)
  1313. need_remap = need_hremap .or. need_vremap
  1314. endif
  1315. call par_broadcast( need_remap, status)
  1316. IF_NOTOK_RETURN(status=1)
  1317. if ((istart /= 32).and.need_remap) then
  1318. status=1
  1319. write(gol,*)' you must use istart=32 for using a restart file at different resolution'
  1320. call goErr
  1321. TRACEBACK; return
  1322. endif
  1323. ! work arrays
  1324. if (isRoot) then
  1325. allocate( rmt(imr,jmr,lmr,ntracet) )
  1326. allocate( rmx(imr,jmr,lmr,ntracet) )
  1327. allocate( rmy(imr,jmr,lmr,ntracet) )
  1328. allocate( rmz(imr,jmr,lmr,ntracet) )
  1329. if ( ntrace_chem > 0 ) allocate( rms(imr,jmr,lmr,ntracet+1:ntracet+ntrace_chem) )
  1330. allocate( tmp4d(imr,jmr,lmr, ntracet) ) ! assume that ntracet is the max size needed
  1331. allocate( tmp3d(imr,jmr,lmr+1 ) )
  1332. else
  1333. allocate( rmt(1,1,1,1) )
  1334. allocate( rmx(1,1,1,1) )
  1335. allocate( rmy(1,1,1,1) )
  1336. allocate( rmz(1,1,1,1) )
  1337. if ( ntrace_chem > 0 ) allocate( rms(1,1,1,1) )
  1338. allocate( tmp4d(1,1,1,1) )
  1339. allocate( tmp3d(1,1,1) )
  1340. endif
  1341. ! get extra work arrays for 1x1 dataset
  1342. #if defined(with_online_bvoc) || defined(with_online_nox)
  1343. if(n==region1) then
  1344. n360 = dgrid(iglbsfc)%im_region
  1345. n180 = dgrid(iglbsfc)%jm_region
  1346. if (isRoot) then
  1347. allocate( glb_sfc3d(n360, n180, max(ndays_history, n_layers, ndrydays, nhours_history ) )
  1348. allocate( glb_sfc4d(n360, n180, n_layers, ndays_history) )
  1349. else
  1350. allocate( glb_sfc3d(1,1,1) )
  1351. allocate( glb_sfc4d(1,1,1,1) )
  1352. endif
  1353. end if
  1354. #endif
  1355. ! prepare for remap
  1356. if (need_remap .and. do_rm) then
  1357. write (gol,'(" remap tracer from restart file")') ; call goPr
  1358. if (isRoot) then
  1359. allocate( sp_gbl(imr,jmr,1) )
  1360. allocate( src_glb(imr_restart,jmr_restart,lmr_restart))
  1361. else
  1362. allocate(sp_gbl(1,1,1))
  1363. allocate(src_glb(1,1,1))
  1364. endif
  1365. call gather( dgrid(n), sp_dat(n)%data, sp_gbl, sp_dat(n)%halo, status)
  1366. IF_NOTOK_RETURN(status=1)
  1367. ! init to 0 in case of data not found in file
  1368. rmt=0.
  1369. rms=0.
  1370. ! init lli_restart/levi_restart
  1371. if (isRoot) then
  1372. allocate(at_restart(lmr_restart+1))
  1373. allocate(bt_restart(lmr_restart+1))
  1374. !
  1375. call MDF_Inq_VarID( ncid, 'at', varid_at, status )
  1376. IF_NOTOK_MDF(fid=ncid)
  1377. !
  1378. call MDF_Get_Var( ncid, varid_at, at_restart(1:(lmr_restart+1)), status )
  1379. IF_NOTOK_MDF(fid=ncid)
  1380. !
  1381. call MDF_Inq_VarID( ncid, 'bt', varid_bt, status )
  1382. IF_NOTOK_MDF(fid=ncid)
  1383. !
  1384. call MDF_Get_Var( ncid, varid_bt, bt_restart(1:(lmr_restart+1)), status )
  1385. IF_NOTOK_MDF(fid=ncid)
  1386. !
  1387. call Init( levi_restart, lmr_restart, at_restart, bt_restart, status )
  1388. IF_NOTOK_RETURN(status=1)
  1389. !
  1390. deallocate(at_restart,bt_restart)
  1391. !
  1392. dx=360./imr_restart
  1393. dy=180./jmr_restart
  1394. call Init( lli_restart, -180.+0.5*dx, dx, imr_restart, &
  1395. -90.+0.5*dy, dy, jmr_restart, status )
  1396. IF_NOTOK_RETURN(status=1)
  1397. endif
  1398. endif
  1399. ! ** get variables id
  1400. if (isRoot) then
  1401. ! surface pressure
  1402. if ( do_sp ) call MDF_Inq_VarID( ncid, 'sp', varid_sp, status )
  1403. IF_NOTOK_MDF(fid=ncid)
  1404. ! half level pressure
  1405. if ( do_ph ) call MDF_Inq_VarID( ncid, 'ph', varid_ph, status )
  1406. IF_NOTOK_MDF(fid=ncid)
  1407. ! air mass
  1408. if ( do_m ) call MDF_Inq_VarID( ncid, 'm', varid_m, status )
  1409. IF_NOTOK_MDF(fid=ncid)
  1410. !! surface fluxes
  1411. !if ( do_sflux ) then
  1412. !end if
  1413. ! tracer mass
  1414. if ( do_rm ) then
  1415. call MDF_Inq_VarID( ncid, 'names', varid_names, status )
  1416. if ( status /= 0 ) then
  1417. write (gol,'("could not find variable `names` in restart file;")'); call goErr
  1418. write (gol,'(" using an old restart file to initialize the model ?")'); call goErr
  1419. status=1
  1420. end if
  1421. IF_NOTOK_MDF(fid=ncid)
  1422. ! get dimension of "names"
  1423. call MDF_Inquire_Variable( ncid, varid_names, status, shp=shp )
  1424. IF_NOTOK_MDF(fid=ncid)
  1425. ! get number of transported tracer in restart file
  1426. call MDF_Inq_DimID( ncid, 'trace_transp', dimid, status )
  1427. IF_NOTOK_MDF(fid=ncid)
  1428. call MDF_Inquire_Dimension( ncid, dimid, status, length=ntracet_restart )
  1429. IF_NOTOK_MDF(fid=ncid)
  1430. ! tracers mass id
  1431. call MDF_Inq_VarID( ncid, 'rm', varid_rm, status )
  1432. IF_NOTOK_MDF(fid=ncid)
  1433. #ifdef slopes
  1434. call MDF_Inq_VarID( ncid, 'rxm', varid_rxm, status )
  1435. IF_NOTOK_MDF(fid=ncid)
  1436. call MDF_Inq_VarID( ncid, 'rym', varid_rym, status )
  1437. IF_NOTOK_MDF(fid=ncid)
  1438. call MDF_Inq_VarID( ncid, 'rzm', varid_rzm, status )
  1439. IF_NOTOK_MDF(fid=ncid)
  1440. #endif
  1441. ! read non-transported tracers if any
  1442. if ( ntrace_chem > 0 ) then
  1443. call MDF_Inq_VarID( ncid, 'rmc', varid_rmc, status )
  1444. IF_NOTOK_MDF(fid=ncid)
  1445. end if
  1446. end if
  1447. #ifdef with_online_bvoc
  1448. ! MEGAN/PCEEA history records; only once is ok
  1449. if ( do_megan .and. (n==region1) ) then
  1450. call MDF_Inq_VarID( ncid, 'skt_daily' , varid_skt_daily , status )
  1451. IF_NOTOK_MDF(fid=ncid)
  1452. call MDF_Inq_VarID( ncid, 'skt_10d_history' , varid_skt_10d_history , status )
  1453. IF_NOTOK_MDF(fid=ncid)
  1454. if (megan) then
  1455. call MDF_Inq_VarID( ncid, 'pdir_daily' , varid_pdir_daily , status )
  1456. IF_NOTOK_MDF(fid=ncid)
  1457. call MDF_Inq_VarID( ncid, 'pdir_10d_history' , varid_pdir_10d_history , status )
  1458. IF_NOTOK_MDF(fid=ncid)
  1459. call MDF_Inq_VarID( ncid, 'pdif_daily' , varid_pdif_daily , status )
  1460. IF_NOTOK_MDF(fid=ncid)
  1461. call MDF_Inq_VarID( ncid, 'pdif_10d_history' , varid_pdif_10d_history , status )
  1462. IF_NOTOK_MDF(fid=ncid)
  1463. call MDF_Inq_VarID( ncid, 'skt_hourly' , varid_skt_hourly , status )
  1464. IF_NOTOK_MDF(fid=ncid)
  1465. call MDF_Inq_VarID( ncid, 'skt_24h_history' , varid_skt_24h_history , status )
  1466. IF_NOTOK_MDF(fid=ncid)
  1467. call MDF_Inq_VarID( ncid, 'pdir_hourly' , varid_pdir_hourly , status )
  1468. IF_NOTOK_MDF(fid=ncid)
  1469. call MDF_Inq_VarID( ncid, 'pdir_24h_history' , varid_pdir_24h_history , status )
  1470. IF_NOTOK_MDF(fid=ncid)
  1471. call MDF_Inq_VarID( ncid, 'pdif_hourly' , varid_pdif_hourly , status )
  1472. IF_NOTOK_MDF(fid=ncid)
  1473. call MDF_Inq_VarID( ncid, 'pdif_24h_history' , varid_pdif_24h_history , status )
  1474. IF_NOTOK_MDF(fid=ncid)
  1475. else if (pceea) then
  1476. call MDF_Inq_VarID( ncid, 'ssr_daily' , varid_ssr_daily , status )
  1477. IF_NOTOK_MDF(fid=ncid)
  1478. call MDF_Inq_VarID( ncid, 'ssr_10d_history' , varid_ssr_10d_history , status )
  1479. IF_NOTOK_MDF(fid=ncid)
  1480. endif
  1481. end if
  1482. #endif
  1483. #ifdef with_online_nox
  1484. ! precipitation history and pulsing parameters; only once is ok
  1485. if ( do_pulse .and. (n==region1) ) then
  1486. call MDF_Inq_VarID( ncid, 'cp_daily' , varid_cp_daily, status )
  1487. IF_NOTOK_MDF(fid=ncid)
  1488. call MDF_Inq_VarID( ncid, 'lsp_daily' , varid_lsp_daily, status )
  1489. IF_NOTOK_MDF(fid=ncid)
  1490. call MDF_Inq_VarID( ncid, 'cp_history' , varid_cp_history, status )
  1491. IF_NOTOK_MDF(fid=ncid)
  1492. call MDF_Inq_VarID( ncid, 'lsp_history', varid_lsp_history, status )
  1493. IF_NOTOK_MDF(fid=ncid)
  1494. call MDF_Inq_VarID( ncid, 'pulsing' , varid_pulsing, status )
  1495. IF_NOTOK_MDF(fid=ncid)
  1496. call MDF_Inq_VarID( ncid, 'plsday' , varid_plsday, status )
  1497. IF_NOTOK_MDF(fid=ncid)
  1498. call MDF_Inq_VarID( ncid, 'plsdurat' , varid_plsdurat, status )
  1499. IF_NOTOK_MDF(fid=ncid)
  1500. end if
  1501. #endif
  1502. #ifdef with_m7
  1503. #ifndef without_chemistry
  1504. if (do_m) then
  1505. ! M7 fields for optics
  1506. call MDF_Inq_VarID( ncid, trim(h2o_name) , varid_h2o, status )
  1507. IF_NOTOK_MDF(fid=ncid)
  1508. call MDF_Inq_VarID( ncid, trim(rwd_name) , varid_rwd, status )
  1509. IF_NOTOK_MDF(fid=ncid)
  1510. call MDF_Inq_VarID( ncid, trim(rw_name ) , varid_rw, status )
  1511. IF_NOTOK_MDF(fid=ncid)
  1512. end if
  1513. #endif
  1514. #endif
  1515. end if
  1516. ! *** READ VARIABLES ***
  1517. if ( do_sp ) then
  1518. write (gol,'(" restore surface pressure ...")'); call goPr
  1519. if (isRoot) call MDF_Get_Var( ncid, varid_sp, tmp3d(:,:,1), status )
  1520. IF_NOTOK_MDF(fid=ncid)
  1521. call scatter( dgrid(n), sp_dat(n)%data, tmp3d(:,:,1:1), sp_dat(n)%halo, status)
  1522. IF_NOTOK_RETURN(status=1)
  1523. end if
  1524. if ( do_ph ) then
  1525. write (gol,'(" restore half level pressure ...")'); call goPr
  1526. if (isRoot) call MDF_Get_Var( ncid, varid_ph, tmp3d, status)
  1527. IF_NOTOK_MDF(fid=ncid)
  1528. call scatter( dgrid(n), phlb_dat(n)%data, tmp3d, phlb_dat(n)%halo, status)
  1529. IF_NOTOK_RETURN(status=1)
  1530. end if
  1531. if ( do_m ) then
  1532. write (gol,'(" restore air mass ...")'); call goPr
  1533. if (isRoot) call MDF_Get_Var( ncid, varid_m, tmp3d(:,:,1:lmr), status)
  1534. IF_NOTOK_MDF(fid=ncid)
  1535. call scatter( dgrid(n), m_dat(n)%data, tmp3d(:,:,1:lmr), m_dat(n)%halo, status)
  1536. IF_NOTOK_RETURN(status=1)
  1537. end if
  1538. !! surface fluxes
  1539. !if ( do_sflux ) then
  1540. !end if
  1541. ! tracer mass
  1542. READRM: if ( do_rm ) then
  1543. write (gol,'(" restore tracer mass ...")'); call goPr
  1544. ! read list with tracer names in rcfile
  1545. allocate( values_names(shp(2)) )
  1546. if (isRoot) call MDF_Get_Var( ncid, varid_names, values_names, status )
  1547. IF_NOTOK_MDF(fid=ncid)
  1548. ! loop over all model tracers
  1549. do itr = 1, ntrace
  1550. if (isRoot) then
  1551. ! search in list:
  1552. call goMatchValue( names(itr), values_names, itr_file, status )
  1553. if ( status < 0 ) then
  1554. write(gol,'("*WARNING* Requested tracer `",a,"` not FOUND in restart file!")') trim(names(itr))
  1555. if (istart /= 32) then
  1556. call goErr
  1557. IF_NOTOK_MDF(fid=ncid)
  1558. else
  1559. status=0
  1560. call goPr
  1561. if ( itr <= ntracet ) then
  1562. rmt(:,:,:,itr) = 1.e-30
  1563. write(gol,'("*WARNING* Requested TRANSPORTED tracer `",a,"` has been SET to a default value of 1.e30")') trim(names(itr))
  1564. else
  1565. rms(:,:,:,itr) = 1.e-30
  1566. write(gol,'("*WARNING* Requested SHORT-LIVED tracer `",a,"` has been SET to a default value of 1.e30")') trim(names(itr))
  1567. endif
  1568. call goPr
  1569. endif
  1570. else
  1571. ! transported or short lived tracer ?
  1572. if ( itr <= ntracet ) then
  1573. if ( itr_file > ntracet_restart ) then
  1574. write (gol,'("tracer `",a,"` is transported but seems to be not-transported in restart file")') trim(names(itr)); call goErr
  1575. status=1
  1576. IF_NOTOK_MDF(fid=ncid)
  1577. end if
  1578. if (need_remap) then
  1579. call MDF_Get_Var( ncid, varid_rm, src_glb, status, start=(/1,1,1,itr_file/))
  1580. IF_NOTOK_MDF(fid=ncid)
  1581. call Fill3D( global_lli(n), levi, 'n', sp_gbl(:,:,1), rmt(:,:,:,itr), &
  1582. lli_restart, levi_restart, src_glb, 'sum', status )
  1583. IF_NOTOK_RETURN(status=1)
  1584. else
  1585. call MDF_Get_Var( ncid, varid_rm, rmt(:,:,:,itr), status, start=(/1,1,1,itr_file/))
  1586. IF_NOTOK_MDF(fid=ncid)
  1587. endif
  1588. ! Scale methane concentrations by a factor specified in the rc file
  1589. if ( (factor_ch4 /= 1.) .and. (itr == ich4) ) then
  1590. write(gol,*) '*WARNING*: CH4 mixing ratio and slopes from restart file'; call goPr
  1591. write(gol,*) '*WARNING*: ... scaled by a factor: ', factor_ch4; call goPr
  1592. rmt(:,:,:,itr) = rmt(:,:,:,itr) * factor_ch4
  1593. endif
  1594. #ifdef slopes
  1595. ! read slopes
  1596. if (.not. need_remap) then
  1597. if (isRoot) call MDF_Get_Var( ncid, varid_rxm, rmx(:,:,:,itr), status, start=(/1,1,1,itr_file/))
  1598. IF_NOTOK_MDF(fid=ncid)
  1599. if (isRoot) call MDF_Get_Var( ncid, varid_rym, rmy(:,:,:,itr), status, start=(/1,1,1,itr_file/))
  1600. IF_NOTOK_MDF(fid=ncid)
  1601. if (isRoot) call MDF_Get_Var( ncid, varid_rzm, rmz(:,:,:,itr), status, start=(/1,1,1,itr_file/))
  1602. IF_NOTOK_MDF(fid=ncid)
  1603. ! Scale methane concentration slopes by a factor specified in the rc file
  1604. if ( (factor_ch4 /= 1.) .and. (itr == ich4) ) then
  1605. mass_dat(n)%rxm(:,:,:,itr)= mass_dat(n)%rxm(:,:,:,itr) * factor_ch4
  1606. mass_dat(n)%rym(:,:,:,itr)= mass_dat(n)%rym(:,:,:,itr) * factor_ch4
  1607. mass_dat(n)%rzm(:,:,:,itr)= mass_dat(n)%rzm(:,:,:,itr) * factor_ch4
  1608. endif
  1609. endif
  1610. #endif
  1611. else ! short lived tracer:
  1612. if ( itr_file <= ntracet_restart ) then
  1613. write (gol,'("tracer `",a,"` is not-transported but seems to be transported in restart file")') trim(names(itr)); call goErr
  1614. status=1
  1615. IF_NOTOK_MDF(fid=ncid)
  1616. end if
  1617. itr_file = itr_file - ntracet_restart
  1618. if (need_remap) then
  1619. call MDF_Get_Var( ncid, varid_rmc, src_glb, status, start=(/1,1,1,itr_file/) )
  1620. IF_NOTOK_MDF(fid=ncid)
  1621. call Fill3D( global_lli(n), levi, 'n', sp_gbl(:,:,1), rms(:,:,:,itr), &
  1622. lli_restart, levi_restart, src_glb, 'sum', status )
  1623. IF_NOTOK_RETURN(status=1)
  1624. else
  1625. call MDF_Get_Var( ncid, varid_rmc, rms(:,:,:,itr), status, start=(/1,1,1,itr_file/) )
  1626. IF_NOTOK_MDF(fid=ncid)
  1627. endif
  1628. end if ! transported or short-lived
  1629. endif ! in the file
  1630. endif ! root
  1631. end do ! tracers
  1632. ! distribute
  1633. call scatter( dgrid(n), mass_dat(n)%rm, rmt, mass_dat(n)%halo, status)
  1634. IF_NOTOK_RETURN(status=1)
  1635. if ( ntrace_chem > 0 ) then
  1636. call scatter( dgrid(n), chem_dat(n)%rm, rms, chem_dat(n)%halo, status)
  1637. IF_NOTOK_RETURN(status=1)
  1638. endif
  1639. #ifdef slopes
  1640. if (.not. need_remap) then
  1641. call scatter( dgrid(n), mass_dat(n)%rxm, rmx, mass_dat(n)%halo, status)
  1642. IF_NOTOK_RETURN(status=1)
  1643. call scatter( dgrid(n), mass_dat(n)%rym, rmy, mass_dat(n)%halo, status)
  1644. IF_NOTOK_RETURN(status=1)
  1645. call scatter( dgrid(n), mass_dat(n)%rzm, rmz, mass_dat(n)%halo, status)
  1646. IF_NOTOK_RETURN(status=1)
  1647. else
  1648. ! Ensure that slopes are initialized to "unset" values of 0.0. Wouter says that
  1649. ! we could remap levels for rxm et al., but 0.0 will also work. The noise
  1650. ! induced from remapping the rm array is almost certainly bigger than any issues
  1651. ! from having this "default=0.0" slopes information. -ARJ 1 Jan 12
  1652. mass_dat(n)%rxm = 0.0
  1653. mass_dat(n)%rym = 0.0
  1654. mass_dat(n)%rzm = 0.0
  1655. endif
  1656. #endif
  1657. ! free mem for next region
  1658. deallocate( values_names)
  1659. if (need_remap) then
  1660. deallocate(sp_gbl,src_glb)
  1661. if (isRoot) then
  1662. call Done( levi_restart, status )
  1663. IF_NOTOK_RETURN(status=1)
  1664. call Done( lli_restart, status )
  1665. IF_NOTOK_RETURN(status=1)
  1666. endif
  1667. endif
  1668. ENDIF READRM
  1669. ! clean "READRM"
  1670. deallocate(rmt)
  1671. if ( ntrace_chem > 0 ) deallocate(rms)
  1672. #ifdef slopes
  1673. deallocate(rmx, rmy, rmz)
  1674. #endif
  1675. #ifdef with_online_bvoc
  1676. ! MEGAN/PCEEA history records; read only once
  1677. if ( do_megan .and. (n==region1) ) then
  1678. if (isRoot) call MDF_Get_Var( ncid, varid_skt_daily, glb_sfc3d(:,:,1), status)
  1679. IF_NOTOK_MDF(fid=ncid)
  1680. call scatter( dgrid(n), skt_daily, glb_sfc3d(:,:,1), 0, status)
  1681. if (isRoot) call MDF_Get_Var( ncid, varid_skt_10d_history, glb_sfc3d(:,:, 1:ndays_history), status)
  1682. IF_NOTOK_MDF(fid=ncid)
  1683. call scatter( dgrid(n), skt_10d_history(:,:, 1:ndays_history), glb_sfc3d(:,:, 1:ndays_history), 0, status)
  1684. if (megan) then
  1685. write (gol,'(" restore MEGAN history parameters ...")'); call goPr
  1686. if (isRoot) call MDF_Get_Var( ncid, varid_pdir_daily, glb_sfc3d(:,:,1), status)
  1687. IF_NOTOK_MDF(fid=ncid)
  1688. call scatter( dgrid(n), pdir_daily, glb_sfc3d(:,:,1), 0, status)
  1689. IF_NOTOK_RETURN(status=1)
  1690. if (isRoot) call MDF_Get_Var( ncid, varid_pdir_10d_history, glb_sfc3d(:,:, 1:ndays_history), status)
  1691. IF_NOTOK_MDF(fid=ncid)
  1692. call scatter( dgrid(n), pdir_10d_history(:,:, 1:ndays_history), glb_sfc3d(:,:, 1:ndays_history), 0, status)
  1693. IF_NOTOK_RETURN(status=1)
  1694. if (isRoot) call MDF_Get_Var( ncid, varid_pdif_daily, glb_sfc3d (:,:,1:n_layers), status)
  1695. IF_NOTOK_MDF(fid=ncid)
  1696. call scatter( dgrid(n), pdif_daily, glb_sfc3d(:,:,1:n_layers), 0, status)
  1697. IF_NOTOK_RETURN(status=1)
  1698. if (isRoot) call MDF_Get_Var( ncid, varid_pdif_10d_history, glb_sfc4D, status)
  1699. IF_NOTOK_MDF(fid=ncid)
  1700. call scatter( dgrid(n), pdif_10d_history, glb_sfc4D, 0, status)
  1701. IF_NOTOK_RETURN(status=1)
  1702. if (isRoot) call MDF_Get_Var( ncid, varid_skt_hourly, glb_sfc3d(:,:,1), status)
  1703. IF_NOTOK_MDF(fid=ncid)
  1704. call scatter( dgrid(n), skt_hourly, glb_sfc3d(:,:,1), 0, status)
  1705. IF_NOTOK_RETURN(status=1)
  1706. if (isRoot) call MDF_Get_Var( ncid, varid_skt_24h_history, glb_sfc3d(:,:, 1:nhours_history), status)
  1707. IF_NOTOK_MDF(fid=ncid)
  1708. call scatter( dgrid(n), skt_24h_history, glb_sfc3d(:,:,1:nhours_history), 0, status)
  1709. IF_NOTOK_RETURN(status=1)
  1710. if (isRoot) call MDF_Get_Var( ncid, varid_pdir_hourly, glb_sfc3d(:,:,1), status)
  1711. IF_NOTOK_MDF(fid=ncid)
  1712. call scatter( dgrid(n), pdir_hourly, glb_sfc3d(:,:,1), 0, status)
  1713. IF_NOTOK_RETURN(status=1)
  1714. if (isRoot) call MDF_Get_Var( ncid, varid_pdir_24h_history, glb_sfc3d(:,:, 1:nhours_history), status)
  1715. IF_NOTOK_MDF(fid=ncid)
  1716. call scatter( dgrid(n), pdir_24h_history, glb_sfc3d(:,:,1:nhours_history), 0, status)
  1717. IF_NOTOK_RETURN(status=1)
  1718. if (isRoot) call MDF_Get_Var( ncid, varid_pdif_hourly, glb_sfc3d(:,:, 1:n_layers), status)
  1719. IF_NOTOK_MDF(fid=ncid)
  1720. call scatter( dgrid(n), pdif_hourly, glb_sfc3d(:,:,1), 0, status)
  1721. IF_NOTOK_RETURN(status=1)
  1722. if (isRoot) call MDF_Get_Var( ncid, varid_pdif_24h_history, glb_sfc4D, status)
  1723. IF_NOTOK_MDF(fid=ncid)
  1724. call scatter( dgrid(n), pdif_24h_history, glb_sfc4D, 0, status)
  1725. IF_NOTOK_RETURN(status=1)
  1726. else if (pceea) then
  1727. write (gol,'(" restore PCEEA history parameters ...")'); call goPr
  1728. if (isRoot) call MDF_Get_Var( ncid, varid_ssr_daily, glb_sfc3d(:,:,1), status)
  1729. IF_NOTOK_MDF(fid=ncid)
  1730. call scatter( dgrid(n), ssr_daily, glb_sfc3d(:,:,1), 0, status)
  1731. IF_NOTOK_RETURN(status=1)
  1732. if (isRoot) call MDF_Get_Var( ncid, varid_ssr_10d_history, ssr_10d_history(:,:, 1:ndays_history), status)
  1733. IF_NOTOK_MDF(fid=ncid)
  1734. call scatter( dgrid(n), ssr_10d_history(:,:, 1:ndays_history), glb_sfc3d(:,:, 1:ndays_history), 0, status)
  1735. IF_NOTOK_RETURN(status=1)
  1736. endif
  1737. end if
  1738. #endif
  1739. #ifdef with_online_nox
  1740. ! precipitation history and pulsing parameters; read only once
  1741. if ( do_pulse .and. (n==region1) ) then
  1742. write (gol,'(" restore precipitation history and pulsing parameters ...")'); call goPr
  1743. if (isRoot) call MDF_Get_Var( ncid, varid_cp_daily, glb_sfc3d(:,:,1), status)
  1744. IF_NOTOK_MDF(fid=ncid)
  1745. call scatter( dgrid(n), cp_daily, glb_sfc3d(:,:,1), 0, status)
  1746. IF_NOTOK_RETURN(status=1)
  1747. if (isRoot) call MDF_Get_Var( ncid, varid_lsp_daily, glb_sfc3d(:,:,1), status)
  1748. IF_NOTOK_MDF(fid=ncid)
  1749. call scatter( dgrid(n), lsp_daily, glb_sfc3d(:,:,1), 0, status)
  1750. IF_NOTOK_RETURN(status=1)
  1751. if (isRoot) call MDF_Get_Var( ncid, varid_cp_history, glb_sfc3d(:,:, 1:ndrydays), status)
  1752. IF_NOTOK_MDF(fid=ncid)
  1753. call scatter( dgrid(n), cp_history(:,:, 1:ndrydays), glb_sfc3d(:,:, 1:ndrydays), 0, status)
  1754. IF_NOTOK_RETURN(status=1)
  1755. if (isRoot) call MDF_Get_Var( ncid, varid_lsp_history, glb_sfc3d(:,:, 1:ndrydays), status)
  1756. IF_NOTOK_MDF(fid=ncid)
  1757. call scatter( dgrid(n), lsp_history(:,:, 1:ndrydays), glb_sfc3d(:,:, 1:ndrydays), 0, status)
  1758. IF_NOTOK_RETURN(status=1)
  1759. if (isRoot) call MDF_Get_Var( ncid, varid_pulsing, glb_sfc3d(:,:,1), status)
  1760. IF_NOTOK_MDF(fid=ncid)
  1761. call scatter( dgrid(n), pulsing_field, glb_sfc3d(:,:,1), 0, status)
  1762. IF_NOTOK_RETURN(status=1)
  1763. if (isRoot) call MDF_Get_Var( ncid, varid_plsday, glb_sfc3d(:,:,1), status)
  1764. IF_NOTOK_MDF(fid=ncid)
  1765. call scatter( dgrid(n), plsday_field, glb_sfc3d(:,:,1), 0, status)
  1766. IF_NOTOK_RETURN(status=1)
  1767. if (isRoot) call MDF_Get_Var( ncid, varid_plsdurat, glb_sfc3d(:,:,1), status)
  1768. IF_NOTOK_MDF(fid=ncid)
  1769. call scatter( dgrid(n), plsdurat_field, glb_sfc3d(:,:,1), 0, status)
  1770. IF_NOTOK_RETURN(status=1)
  1771. end if
  1772. #endif
  1773. #ifdef with_m7
  1774. #ifndef without_chemistry
  1775. if (do_m) then
  1776. write (gol,'(" restore M7 fields for optics ...")'); call goPr
  1777. ! water: get 4d array
  1778. if (isRoot) call MDF_Get_Var( ncid, varid_h2o, tmp4d(:,:,:,1:nsol), status )
  1779. IF_NOTOK_MDF(fid=ncid)
  1780. do imode=1,nsol
  1781. call scatter( dgrid(n), h2o_mode(n,imode)%d3, tmp4d(:,:,:,imode), h2o_mode(n,imode)%halo, status)
  1782. end do
  1783. ! dry radii: get 4d array
  1784. if (isRoot) call MDF_Get_Var( ncid, varid_rwd, tmp4d(:,:,:,1:nsol), status)
  1785. IF_NOTOK_MDF(fid=ncid)
  1786. do imode=1,nsol
  1787. call scatter( dgrid(n), rwd_mode(n,imode)%d3, tmp4d(:,:,:,imode), rwd_mode(n,imode)%halo, status)
  1788. end do
  1789. ! (wet) radii: get 4d array
  1790. if (isRoot) call MDF_Get_Var( ncid, varid_rw, tmp4d(:,:,:,1:nmod), status)
  1791. IF_NOTOK_MDF(fid=ncid)
  1792. do imode=1,nmod
  1793. call scatter( dgrid(n), rw_mode(n,imode)%d3, tmp4d(:,:,:,imode), rw_mode(n,imode)%halo, status)
  1794. end do
  1795. end if
  1796. #endif
  1797. #endif /* with_m7 */
  1798. if (isRoot) call MDF_Close( ncid, status )
  1799. IF_NOTOK_RETURN(status=1)
  1800. deallocate( tmp4d )
  1801. deallocate( tmp3d )
  1802. #if defined(with_online_bvoc) || defined(with_online_nox)
  1803. deallocate(glb_sfc3D, glb_sfc4D)
  1804. #endif
  1805. ENDDO REG
  1806. status = 0
  1807. END SUBROUTINE RESTART_READ
  1808. !EOC
  1809. END MODULE RESTART