tm5_restart.F90 86 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196
  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. ! - If we need to remap, then meteo is not read from restart.
  1174. ! Airmass is still read but only to convert tracer masses to mixing ratios.
  1175. ! 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, mxmode
  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. real, allocatable :: tmp4d(:,:,:,:)
  1216. real, allocatable :: src_glb_4d(:,:,:,:)
  1217. #endif
  1218. ! global work arrays to read data
  1219. real, allocatable :: tmp3d(:,:,:), airmass(:,:,:), run_airmass(:,:,:)
  1220. real, allocatable :: rmt(:,:,:,:),rms(:,:,:,:), rmx(:,:,:,:),rmy(:,:,:,:), rmz(:,:,:,:)
  1221. #if defined(with_online_bvoc) || defined(with_online_nox)
  1222. real, allocatable :: glb_sfc3D(:,:,:), glb_sfc4D(:,:,:,:)
  1223. integer :: n360, n180
  1224. #endif
  1225. ! for remapping:
  1226. logical :: need_vremap, need_hremap, need_remap
  1227. integer :: varid_at, varid_bt
  1228. real :: dx, dy
  1229. real :: factor_ch4
  1230. real, allocatable :: sp_gbl(:,:,:)
  1231. real, allocatable :: at_restart(:), bt_restart(:)
  1232. real, allocatable :: src_glb(:,:,:)
  1233. type(TllGridInfo) :: lli_restart
  1234. type(TLevelInfo) :: levi_restart
  1235. ! --- begin --------------------------------
  1236. if ( istart /= 33 .and. istart /= 32 ) then
  1237. write (gol,'(" skip read restart; istart not 33 or 32 but ",i2)') istart; call goPr
  1238. status=0; return
  1239. endif
  1240. if ( any( idate /= idatei ) ) then
  1241. write (gol,'(" skip read restart; idate not idatei but ",i4,5i2.2)') idate; call goPr
  1242. status=0; return
  1243. endif
  1244. ! input directory:
  1245. call Init( rcF, rcfile, status )
  1246. IF_NOTOK_RETURN(status=1)
  1247. call ReadRc( rcF, 'restart.read.dir', rs_read_dir, status )
  1248. IF_NOTOK_RETURN(status=1)
  1249. call ReadRc( rcF, 'restart.factor.ch4', factor_ch4, status, default = 1.0 )
  1250. IF_ERROR_RETURN(status=1)
  1251. call Done( rcF, status )
  1252. IF_NOTOK_RETURN(status=1)
  1253. ! region range:
  1254. if ( present(region) ) then
  1255. region1 = region
  1256. region2 = region
  1257. else
  1258. region1 = 1
  1259. region2 = nregions
  1260. end if
  1261. ! data sets:
  1262. do_rm = .false. ; if ( present(tracer_mass ) ) do_rm = tracer_mass
  1263. do_m = .false. ; if ( present(air_mass ).and.(istart==33) ) do_m = air_mass
  1264. do_sp = .false. ; if ( present(surface_pressure ).and.(istart==33) ) do_sp = surface_pressure
  1265. do_ph = .false. ; if ( present(pressure ).and.(istart==33) ) do_ph = pressure
  1266. do_sflux = .false. ; if ( present(surface_fluxes ).and.(istart==33) ) do_sflux = surface_fluxes
  1267. do_megan = .false. ; if ( present(megan_history ).and.(istart==33) ) do_megan = megan_history
  1268. do_pulse = .false. ; if ( present(nox_pulsing ).and.(istart==33) ) do_pulse = nox_pulsing
  1269. ! sorry ..
  1270. if ( do_sflux ) then
  1271. write (gol,'("no surface fluxes in restart files until somebody")') ; call goErr
  1272. write (gol,'("has a good idea on what should be storred:")') ; call goErr
  1273. write (gol,'(" o global surface field (1x1 ?)")') ; call goErr
  1274. write (gol,'(" o zoom regions")') ; call goErr
  1275. write (gol,'(" o both")') ; call goErr
  1276. TRACEBACK; status=1; return
  1277. end if
  1278. ! do we need anything?
  1279. if(.not.(do_rm.or.do_m.or.do_sp.or.do_ph.or.do_sflux.or.do_megan.or.do_pulse))then
  1280. status=0; return
  1281. endif
  1282. #ifdef with_m7
  1283. mxmode = max(nsol, nmod)
  1284. #endif
  1285. REG: do n = region1, region2
  1286. imr = global_lli(n)%nlon
  1287. jmr = global_lli(n)%nlat
  1288. lmr = levi%nlev
  1289. ! name of restart file
  1290. call Restart_FileName( n, fname, status, dir=trim(rs_read_dir) )
  1291. IF_NOTOK_RETURN(status=1)
  1292. write (gol,'(" read restart file: ",a)') trim(fname); call goPr
  1293. inquire( file=fname, exist=exist )
  1294. if ( .not. exist ) then
  1295. write (gol,'("restart file not found : ",a)') trim(fname); call goErr
  1296. TRACEBACK; status=1; return
  1297. end if
  1298. ! ** open netcdf file
  1299. if (isRoot) then
  1300. call MDF_Open( trim(fname), MDF_NETCDF4, MDF_READ, ncid, status )
  1301. IF_NOTOK_RETURN(status=1)
  1302. ! ** check for dimension compatibility
  1303. call MDF_Inq_DimID( ncid, 'lev', dimid, status )
  1304. IF_NOTOK_MDF(fid=ncid)
  1305. call MDF_Inquire_Dimension( ncid, dimid, status, length=lmr_restart )
  1306. IF_NOTOK_MDF(fid=ncid)
  1307. call MDF_Inq_DimID( ncid, 'lat', dimid, status )
  1308. IF_NOTOK_MDF(fid=ncid)
  1309. call MDF_Inquire_Dimension( ncid, dimid, status, length=jmr_restart )
  1310. IF_NOTOK_MDF(fid=ncid)
  1311. call MDF_Inq_DimID( ncid, 'lon', dimid, status )
  1312. IF_NOTOK_MDF(fid=ncid)
  1313. call MDF_Inquire_Dimension( ncid, dimid, status, length=imr_restart )
  1314. IF_NOTOK_MDF(fid=ncid)
  1315. need_vremap = (lmr /= lmr_restart)
  1316. need_hremap = (jmr /= jmr_restart) .or. (imr /= imr_restart)
  1317. need_remap = need_hremap .or. need_vremap
  1318. endif
  1319. call par_broadcast( need_remap, status)
  1320. IF_NOTOK_RETURN(status=1)
  1321. if ((istart /= 32).and.need_remap) then
  1322. status=1
  1323. write(gol,*)' you must use istart=32 for using a restart file at different resolution'
  1324. call goErr
  1325. TRACEBACK; return
  1326. endif
  1327. ! work arrays
  1328. if (isRoot) then
  1329. allocate( rmt(imr,jmr,lmr,ntracet) )
  1330. allocate( rmx(imr,jmr,lmr,ntracet) )
  1331. allocate( rmy(imr,jmr,lmr,ntracet) )
  1332. allocate( rmz(imr,jmr,lmr,ntracet) )
  1333. if ( ntrace_chem > 0 ) allocate( rms(imr,jmr,lmr,ntracet+1:ntracet+ntrace_chem) )
  1334. #ifdef with_m7
  1335. allocate( tmp4d(imr,jmr,lmr, mxmode) )
  1336. #endif
  1337. allocate( tmp3d(imr,jmr,lmr+1 ) )
  1338. allocate( airmass(imr_restart, jmr_restart, lmr_restart) )
  1339. if (istart==32) allocate( run_airmass(imr, jmr, lmr) )
  1340. else
  1341. allocate( rmt(1,1,1,1) )
  1342. allocate( rmx(1,1,1,1) )
  1343. allocate( rmy(1,1,1,1) )
  1344. allocate( rmz(1,1,1,1) )
  1345. if ( ntrace_chem > 0 ) allocate( rms(1,1,1,1) )
  1346. #ifdef with_m7
  1347. allocate( tmp4d(1,1,1,1) )
  1348. #endif
  1349. allocate( airmass(1,1,1) )
  1350. if (istart==32) allocate( run_airmass(1,1,1) )
  1351. allocate( tmp3d(1,1,1) )
  1352. endif
  1353. if (istart==32) then
  1354. CALL GATHER( dgrid(n), m_dat(n)%data, run_airmass, m_dat(n)%halo, status )
  1355. IF_NOTOK_RETURN(status=1)
  1356. endif
  1357. ! get extra work arrays for 1x1 dataset
  1358. #if defined(with_online_bvoc) || defined(with_online_nox)
  1359. if(n==region1) then
  1360. n360 = dgrid(iglbsfc)%im_region
  1361. n180 = dgrid(iglbsfc)%jm_region
  1362. if (isRoot) then
  1363. allocate( glb_sfc3d(n360, n180, max(ndays_history, n_layers, ndrydays, nhours_history ) )
  1364. allocate( glb_sfc4d(n360, n180, n_layers, ndays_history) )
  1365. else
  1366. allocate( glb_sfc3d(1,1,1) )
  1367. allocate( glb_sfc4d(1,1,1,1) )
  1368. endif
  1369. end if
  1370. #endif
  1371. ! prepare for remap
  1372. if (need_remap .and. do_rm) then
  1373. write (gol,'(" remap tracer from restart file")') ; call goPr
  1374. if (isRoot) then
  1375. allocate( sp_gbl(imr,jmr,1) )
  1376. allocate( src_glb(imr_restart,jmr_restart,lmr_restart))
  1377. #ifdef with_m7
  1378. allocate(src_glb_4d(imr_restart,jmr_restart,lmr_restart,mxmode))
  1379. #endif
  1380. else
  1381. allocate(sp_gbl(1,1,1))
  1382. allocate(src_glb(1,1,1))
  1383. #ifdef with_m7
  1384. allocate(src_glb_4d(1,1,1,1))
  1385. #endif
  1386. endif
  1387. call gather( dgrid(n), sp_dat(n)%data, sp_gbl, sp_dat(n)%halo, status)
  1388. IF_NOTOK_RETURN(status=1)
  1389. ! init to 0 in case of data not found in file
  1390. rmt=0.
  1391. rms=0.
  1392. ! init lli_restart/levi_restart
  1393. if (isRoot) then
  1394. allocate(at_restart(lmr_restart+1))
  1395. allocate(bt_restart(lmr_restart+1))
  1396. !
  1397. call MDF_Inq_VarID( ncid, 'at', varid_at, status )
  1398. IF_NOTOK_MDF(fid=ncid)
  1399. !
  1400. call MDF_Get_Var( ncid, varid_at, at_restart(1:(lmr_restart+1)), status )
  1401. IF_NOTOK_MDF(fid=ncid)
  1402. !
  1403. call MDF_Inq_VarID( ncid, 'bt', varid_bt, status )
  1404. IF_NOTOK_MDF(fid=ncid)
  1405. !
  1406. call MDF_Get_Var( ncid, varid_bt, bt_restart(1:(lmr_restart+1)), status )
  1407. IF_NOTOK_MDF(fid=ncid)
  1408. !
  1409. call Init( levi_restart, lmr_restart, at_restart, bt_restart, status )
  1410. IF_NOTOK_RETURN(status=1)
  1411. !
  1412. deallocate(at_restart,bt_restart)
  1413. !
  1414. dx=360./imr_restart
  1415. dy=180./jmr_restart
  1416. call Init( lli_restart, -180.+0.5*dx, dx, imr_restart, &
  1417. -90.+0.5*dy, dy, jmr_restart, status )
  1418. IF_NOTOK_RETURN(status=1)
  1419. endif
  1420. endif
  1421. ! ** get variables id
  1422. if (isRoot) then
  1423. ! surface pressure
  1424. if ( do_sp ) call MDF_Inq_VarID( ncid, 'sp', varid_sp, status )
  1425. IF_NOTOK_MDF(fid=ncid)
  1426. ! half level pressure
  1427. if ( do_ph ) call MDF_Inq_VarID( ncid, 'ph', varid_ph, status )
  1428. IF_NOTOK_MDF(fid=ncid)
  1429. ! air mass
  1430. call MDF_Inq_VarID( ncid, 'm', varid_m, status )
  1431. IF_NOTOK_MDF(fid=ncid)
  1432. !! surface fluxes
  1433. !if ( do_sflux ) then
  1434. !end if
  1435. ! tracer mass
  1436. if ( do_rm ) then
  1437. call MDF_Inq_VarID( ncid, 'names', varid_names, status )
  1438. if ( status /= 0 ) then
  1439. write (gol,'("could not find variable `names` in restart file;")'); call goErr
  1440. write (gol,'(" using an old restart file to initialize the model ?")'); call goErr
  1441. status=1
  1442. end if
  1443. IF_NOTOK_MDF(fid=ncid)
  1444. ! get dimension of "names"
  1445. call MDF_Inquire_Variable( ncid, varid_names, status, shp=shp )
  1446. IF_NOTOK_MDF(fid=ncid)
  1447. ! get number of transported tracer in restart file
  1448. call MDF_Inq_DimID( ncid, 'trace_transp', dimid, status )
  1449. IF_NOTOK_MDF(fid=ncid)
  1450. call MDF_Inquire_Dimension( ncid, dimid, status, length=ntracet_restart )
  1451. IF_NOTOK_MDF(fid=ncid)
  1452. ! tracers mass id
  1453. call MDF_Inq_VarID( ncid, 'rm', varid_rm, status )
  1454. IF_NOTOK_MDF(fid=ncid)
  1455. #ifdef slopes
  1456. call MDF_Inq_VarID( ncid, 'rxm', varid_rxm, status )
  1457. IF_NOTOK_MDF(fid=ncid)
  1458. call MDF_Inq_VarID( ncid, 'rym', varid_rym, status )
  1459. IF_NOTOK_MDF(fid=ncid)
  1460. call MDF_Inq_VarID( ncid, 'rzm', varid_rzm, status )
  1461. IF_NOTOK_MDF(fid=ncid)
  1462. #endif
  1463. ! read non-transported tracers if any
  1464. if ( ntrace_chem > 0 ) then
  1465. call MDF_Inq_VarID( ncid, 'rmc', varid_rmc, status )
  1466. IF_NOTOK_MDF(fid=ncid)
  1467. end if
  1468. end if
  1469. #ifdef with_online_bvoc
  1470. ! MEGAN/PCEEA history records; only once is ok
  1471. if ( do_megan .and. (n==region1) ) then
  1472. call MDF_Inq_VarID( ncid, 'skt_daily' , varid_skt_daily , status )
  1473. IF_NOTOK_MDF(fid=ncid)
  1474. call MDF_Inq_VarID( ncid, 'skt_10d_history' , varid_skt_10d_history , status )
  1475. IF_NOTOK_MDF(fid=ncid)
  1476. if (megan) then
  1477. call MDF_Inq_VarID( ncid, 'pdir_daily' , varid_pdir_daily , status )
  1478. IF_NOTOK_MDF(fid=ncid)
  1479. call MDF_Inq_VarID( ncid, 'pdir_10d_history' , varid_pdir_10d_history , status )
  1480. IF_NOTOK_MDF(fid=ncid)
  1481. call MDF_Inq_VarID( ncid, 'pdif_daily' , varid_pdif_daily , status )
  1482. IF_NOTOK_MDF(fid=ncid)
  1483. call MDF_Inq_VarID( ncid, 'pdif_10d_history' , varid_pdif_10d_history , status )
  1484. IF_NOTOK_MDF(fid=ncid)
  1485. call MDF_Inq_VarID( ncid, 'skt_hourly' , varid_skt_hourly , status )
  1486. IF_NOTOK_MDF(fid=ncid)
  1487. call MDF_Inq_VarID( ncid, 'skt_24h_history' , varid_skt_24h_history , status )
  1488. IF_NOTOK_MDF(fid=ncid)
  1489. call MDF_Inq_VarID( ncid, 'pdir_hourly' , varid_pdir_hourly , status )
  1490. IF_NOTOK_MDF(fid=ncid)
  1491. call MDF_Inq_VarID( ncid, 'pdir_24h_history' , varid_pdir_24h_history , status )
  1492. IF_NOTOK_MDF(fid=ncid)
  1493. call MDF_Inq_VarID( ncid, 'pdif_hourly' , varid_pdif_hourly , status )
  1494. IF_NOTOK_MDF(fid=ncid)
  1495. call MDF_Inq_VarID( ncid, 'pdif_24h_history' , varid_pdif_24h_history , status )
  1496. IF_NOTOK_MDF(fid=ncid)
  1497. else if (pceea) then
  1498. call MDF_Inq_VarID( ncid, 'ssr_daily' , varid_ssr_daily , status )
  1499. IF_NOTOK_MDF(fid=ncid)
  1500. call MDF_Inq_VarID( ncid, 'ssr_10d_history' , varid_ssr_10d_history , status )
  1501. IF_NOTOK_MDF(fid=ncid)
  1502. endif
  1503. end if
  1504. #endif
  1505. #ifdef with_online_nox
  1506. ! precipitation history and pulsing parameters; only once is ok
  1507. if ( do_pulse .and. (n==region1) ) then
  1508. call MDF_Inq_VarID( ncid, 'cp_daily' , varid_cp_daily, status )
  1509. IF_NOTOK_MDF(fid=ncid)
  1510. call MDF_Inq_VarID( ncid, 'lsp_daily' , varid_lsp_daily, status )
  1511. IF_NOTOK_MDF(fid=ncid)
  1512. call MDF_Inq_VarID( ncid, 'cp_history' , varid_cp_history, status )
  1513. IF_NOTOK_MDF(fid=ncid)
  1514. call MDF_Inq_VarID( ncid, 'lsp_history', varid_lsp_history, status )
  1515. IF_NOTOK_MDF(fid=ncid)
  1516. call MDF_Inq_VarID( ncid, 'pulsing' , varid_pulsing, status )
  1517. IF_NOTOK_MDF(fid=ncid)
  1518. call MDF_Inq_VarID( ncid, 'plsday' , varid_plsday, status )
  1519. IF_NOTOK_MDF(fid=ncid)
  1520. call MDF_Inq_VarID( ncid, 'plsdurat' , varid_plsdurat, status )
  1521. IF_NOTOK_MDF(fid=ncid)
  1522. end if
  1523. #endif
  1524. #ifdef with_m7
  1525. #ifndef without_chemistry
  1526. if (do_rm) then
  1527. ! M7 fields for optics
  1528. call MDF_Inq_VarID( ncid, trim(h2o_name) , varid_h2o, status )
  1529. IF_NOTOK_MDF(fid=ncid)
  1530. call MDF_Inq_VarID( ncid, trim(rwd_name) , varid_rwd, status )
  1531. IF_NOTOK_MDF(fid=ncid)
  1532. call MDF_Inq_VarID( ncid, trim(rw_name ) , varid_rw, status )
  1533. IF_NOTOK_MDF(fid=ncid)
  1534. end if
  1535. #endif
  1536. #endif
  1537. end if
  1538. ! *** READ VARIABLES ***
  1539. if ( do_sp ) then
  1540. write (gol,'(" restore surface pressure ...")'); call goPr
  1541. if (isRoot) call MDF_Get_Var( ncid, varid_sp, tmp3d(:,:,1), status )
  1542. IF_NOTOK_MDF(fid=ncid)
  1543. call scatter( dgrid(n), sp_dat(n)%data, tmp3d(:,:,1:1), sp_dat(n)%halo, status)
  1544. IF_NOTOK_RETURN(status=1)
  1545. end if
  1546. if ( do_ph ) then
  1547. write (gol,'(" restore half level pressure ...")'); call goPr
  1548. if (isRoot) call MDF_Get_Var( ncid, varid_ph, tmp3d, status)
  1549. IF_NOTOK_MDF(fid=ncid)
  1550. call scatter( dgrid(n), phlb_dat(n)%data, tmp3d, phlb_dat(n)%halo, status)
  1551. IF_NOTOK_RETURN(status=1)
  1552. end if
  1553. ! get air mass in all cases
  1554. if (isRoot) call MDF_Get_Var( ncid, varid_m, airmass, status)
  1555. IF_NOTOK_MDF(fid=ncid)
  1556. if ( do_m ) then
  1557. write (gol,'(" restore air mass ...")'); call goPr
  1558. call scatter( dgrid(n), m_dat(n)%data, airmass, m_dat(n)%halo, status)
  1559. IF_NOTOK_RETURN(status=1)
  1560. end if
  1561. !! surface fluxes
  1562. !if ( do_sflux ) then
  1563. !end if
  1564. ! tracer mass
  1565. READRM: if ( do_rm ) then
  1566. write (gol,'(" restore tracer mass ...")'); call goPr
  1567. ! read list with tracer names in rcfile
  1568. allocate( values_names(shp(2)) )
  1569. if (isRoot) call MDF_Get_Var( ncid, varid_names, values_names, status )
  1570. IF_NOTOK_MDF(fid=ncid)
  1571. ! loop over all model tracers
  1572. do itr = 1, ntrace
  1573. if (isRoot) then
  1574. ! search in list:
  1575. call goMatchValue( names(itr), values_names, itr_file, status )
  1576. if ( status < 0 ) then
  1577. write(gol,'("*WARNING* Requested tracer `",a,"` not FOUND in restart file!")') trim(names(itr))
  1578. if (istart /= 32) then
  1579. call goErr
  1580. IF_NOTOK_MDF(fid=ncid)
  1581. else
  1582. status=0
  1583. call goPr
  1584. if ( itr <= ntracet ) then
  1585. rmt(:,:,:,itr) = 1.e-30
  1586. write(gol,'("*WARNING* Requested TRANSPORTED tracer `",a,"` has been SET to a default value of 1.e-30")') trim(names(itr))
  1587. else
  1588. rms(:,:,:,itr) = 1.e-30
  1589. write(gol,'("*WARNING* Requested SHORT-LIVED tracer `",a,"` has been SET to a default value of 1.e-30")') trim(names(itr))
  1590. endif
  1591. call goPr
  1592. endif
  1593. else
  1594. ! transported or short lived tracer ?
  1595. if ( itr <= ntracet ) then
  1596. if ( itr_file > ntracet_restart ) then
  1597. write (gol,'("tracer `",a,"` is transported but seems to be not-transported in restart file")') trim(names(itr)); call goErr
  1598. status=1
  1599. IF_NOTOK_MDF(fid=ncid)
  1600. end if
  1601. if (need_remap) then
  1602. call MDF_Get_Var( ncid, varid_rm, src_glb, status, start=(/1,1,1,itr_file/))
  1603. IF_NOTOK_MDF(fid=ncid)
  1604. src_glb = src_glb / airmass
  1605. call Fill3D( global_lli(n), levi, 'n', sp_gbl(:,:,1), rmt(:,:,:,itr), &
  1606. lli_restart, levi_restart, src_glb, 'mass-aver', status )
  1607. IF_NOTOK_RETURN(status=1)
  1608. rmt(:,:,:,itr) = rmt(:,:,:,itr) * run_airmass
  1609. else
  1610. call MDF_Get_Var( ncid, varid_rm, rmt(:,:,:,itr), status, start=(/1,1,1,itr_file/))
  1611. IF_NOTOK_MDF(fid=ncid)
  1612. if (istart==32) then
  1613. rmt(:,:,:,itr) = rmt(:,:,:,itr) * run_airmass / airmass
  1614. endif
  1615. endif
  1616. ! Scale methane concentrations by a factor specified in the rc file
  1617. if ( (factor_ch4 /= 1.) .and. (itr == ich4) ) then
  1618. write(gol,*) '*WARNING*: CH4 mixing ratio and slopes from restart file'; call goPr
  1619. write(gol,*) '*WARNING*: ... scaled by a factor: ', factor_ch4; call goPr
  1620. rmt(:,:,:,itr) = rmt(:,:,:,itr) * factor_ch4
  1621. endif
  1622. #ifdef slopes
  1623. ! read slopes
  1624. if ((.not. need_remap) .and. (istart==33)) then
  1625. if (isRoot) call MDF_Get_Var( ncid, varid_rxm, rmx(:,:,:,itr), status, start=(/1,1,1,itr_file/))
  1626. IF_NOTOK_MDF(fid=ncid)
  1627. if (isRoot) call MDF_Get_Var( ncid, varid_rym, rmy(:,:,:,itr), status, start=(/1,1,1,itr_file/))
  1628. IF_NOTOK_MDF(fid=ncid)
  1629. if (isRoot) call MDF_Get_Var( ncid, varid_rzm, rmz(:,:,:,itr), status, start=(/1,1,1,itr_file/))
  1630. IF_NOTOK_MDF(fid=ncid)
  1631. ! Scale methane concentration slopes by a factor specified in the rc file
  1632. if ( (factor_ch4 /= 1.) .and. (itr == ich4) ) then
  1633. mass_dat(n)%rxm(:,:,:,itr)= mass_dat(n)%rxm(:,:,:,itr) * factor_ch4
  1634. mass_dat(n)%rym(:,:,:,itr)= mass_dat(n)%rym(:,:,:,itr) * factor_ch4
  1635. mass_dat(n)%rzm(:,:,:,itr)= mass_dat(n)%rzm(:,:,:,itr) * factor_ch4
  1636. endif
  1637. endif
  1638. #endif
  1639. else ! short lived tracer:
  1640. if ( itr_file <= ntracet_restart ) then
  1641. write (gol,'("tracer `",a,"` is not-transported but seems to be transported in restart file")') trim(names(itr)); call goErr
  1642. status=1
  1643. IF_NOTOK_MDF(fid=ncid)
  1644. end if
  1645. itr_file = itr_file - ntracet_restart
  1646. if (need_remap) then
  1647. call MDF_Get_Var( ncid, varid_rmc, src_glb, status, start=(/1,1,1,itr_file/) )
  1648. IF_NOTOK_MDF(fid=ncid)
  1649. src_glb = src_glb / airmass
  1650. call Fill3D( global_lli(n), levi, 'n', sp_gbl(:,:,1), rms(:,:,:,itr), &
  1651. lli_restart, levi_restart, src_glb, 'mass-aver', status )
  1652. IF_NOTOK_RETURN(status=1)
  1653. rms(:,:,:,itr) = rms(:,:,:,itr) * run_airmass
  1654. else
  1655. call MDF_Get_Var( ncid, varid_rmc, rms(:,:,:,itr), status, start=(/1,1,1,itr_file/) )
  1656. IF_NOTOK_MDF(fid=ncid)
  1657. if (istart==32) then
  1658. rms(:,:,:,itr) = rms(:,:,:,itr) * run_airmass / airmass
  1659. endif
  1660. endif
  1661. end if ! transported or short-lived
  1662. endif ! in the file
  1663. endif ! root
  1664. end do ! tracers
  1665. ! distribute
  1666. call scatter( dgrid(n), mass_dat(n)%rm, rmt, mass_dat(n)%halo, status)
  1667. IF_NOTOK_RETURN(status=1)
  1668. if ( ntrace_chem > 0 ) then
  1669. call scatter( dgrid(n), chem_dat(n)%rm, rms, chem_dat(n)%halo, status)
  1670. IF_NOTOK_RETURN(status=1)
  1671. endif
  1672. #ifdef slopes
  1673. if ((.not. need_remap).and.(istart==33)) then
  1674. call scatter( dgrid(n), mass_dat(n)%rxm, rmx, mass_dat(n)%halo, status)
  1675. IF_NOTOK_RETURN(status=1)
  1676. call scatter( dgrid(n), mass_dat(n)%rym, rmy, mass_dat(n)%halo, status)
  1677. IF_NOTOK_RETURN(status=1)
  1678. call scatter( dgrid(n), mass_dat(n)%rzm, rmz, mass_dat(n)%halo, status)
  1679. IF_NOTOK_RETURN(status=1)
  1680. else
  1681. ! Ensure that slopes are initialized to "unset" values of 0.0. Wouter says that
  1682. ! we could remap levels for rxm et al., but 0.0 will also work. The noise
  1683. ! induced from remapping the rm array is almost certainly bigger than any issues
  1684. ! from having this "default=0.0" slopes information. -ARJ 1 Jan 12
  1685. mass_dat(n)%rxm = 0.0
  1686. mass_dat(n)%rym = 0.0
  1687. mass_dat(n)%rzm = 0.0
  1688. endif
  1689. #endif
  1690. ENDIF READRM
  1691. ! clean "READRM"
  1692. deallocate(rmt)
  1693. if ( ntrace_chem > 0 ) deallocate(rms)
  1694. #ifdef slopes
  1695. deallocate(rmx, rmy, rmz)
  1696. #endif
  1697. #ifdef with_online_bvoc
  1698. ! MEGAN/PCEEA history records; read only once
  1699. if ( do_megan .and. (n==region1) ) then
  1700. if (isRoot) call MDF_Get_Var( ncid, varid_skt_daily, glb_sfc3d(:,:,1), status)
  1701. IF_NOTOK_MDF(fid=ncid)
  1702. call scatter( dgrid(n), skt_daily, glb_sfc3d(:,:,1), 0, status)
  1703. if (isRoot) call MDF_Get_Var( ncid, varid_skt_10d_history, glb_sfc3d(:,:, 1:ndays_history), status)
  1704. IF_NOTOK_MDF(fid=ncid)
  1705. call scatter( dgrid(n), skt_10d_history(:,:, 1:ndays_history), glb_sfc3d(:,:, 1:ndays_history), 0, status)
  1706. if (megan) then
  1707. write (gol,'(" restore MEGAN history parameters ...")'); call goPr
  1708. if (isRoot) call MDF_Get_Var( ncid, varid_pdir_daily, glb_sfc3d(:,:,1), status)
  1709. IF_NOTOK_MDF(fid=ncid)
  1710. call scatter( dgrid(n), pdir_daily, glb_sfc3d(:,:,1), 0, status)
  1711. IF_NOTOK_RETURN(status=1)
  1712. if (isRoot) call MDF_Get_Var( ncid, varid_pdir_10d_history, glb_sfc3d(:,:, 1:ndays_history), status)
  1713. IF_NOTOK_MDF(fid=ncid)
  1714. call scatter( dgrid(n), pdir_10d_history(:,:, 1:ndays_history), glb_sfc3d(:,:, 1:ndays_history), 0, status)
  1715. IF_NOTOK_RETURN(status=1)
  1716. if (isRoot) call MDF_Get_Var( ncid, varid_pdif_daily, glb_sfc3d (:,:,1:n_layers), status)
  1717. IF_NOTOK_MDF(fid=ncid)
  1718. call scatter( dgrid(n), pdif_daily, glb_sfc3d(:,:,1:n_layers), 0, status)
  1719. IF_NOTOK_RETURN(status=1)
  1720. if (isRoot) call MDF_Get_Var( ncid, varid_pdif_10d_history, glb_sfc4D, status)
  1721. IF_NOTOK_MDF(fid=ncid)
  1722. call scatter( dgrid(n), pdif_10d_history, glb_sfc4D, 0, status)
  1723. IF_NOTOK_RETURN(status=1)
  1724. if (isRoot) call MDF_Get_Var( ncid, varid_skt_hourly, glb_sfc3d(:,:,1), status)
  1725. IF_NOTOK_MDF(fid=ncid)
  1726. call scatter( dgrid(n), skt_hourly, glb_sfc3d(:,:,1), 0, status)
  1727. IF_NOTOK_RETURN(status=1)
  1728. if (isRoot) call MDF_Get_Var( ncid, varid_skt_24h_history, glb_sfc3d(:,:, 1:nhours_history), status)
  1729. IF_NOTOK_MDF(fid=ncid)
  1730. call scatter( dgrid(n), skt_24h_history, glb_sfc3d(:,:,1:nhours_history), 0, status)
  1731. IF_NOTOK_RETURN(status=1)
  1732. if (isRoot) call MDF_Get_Var( ncid, varid_pdir_hourly, glb_sfc3d(:,:,1), status)
  1733. IF_NOTOK_MDF(fid=ncid)
  1734. call scatter( dgrid(n), pdir_hourly, glb_sfc3d(:,:,1), 0, status)
  1735. IF_NOTOK_RETURN(status=1)
  1736. if (isRoot) call MDF_Get_Var( ncid, varid_pdir_24h_history, glb_sfc3d(:,:, 1:nhours_history), status)
  1737. IF_NOTOK_MDF(fid=ncid)
  1738. call scatter( dgrid(n), pdir_24h_history, glb_sfc3d(:,:,1:nhours_history), 0, status)
  1739. IF_NOTOK_RETURN(status=1)
  1740. if (isRoot) call MDF_Get_Var( ncid, varid_pdif_hourly, glb_sfc3d(:,:, 1:n_layers), status)
  1741. IF_NOTOK_MDF(fid=ncid)
  1742. call scatter( dgrid(n), pdif_hourly, glb_sfc3d(:,:,1), 0, status)
  1743. IF_NOTOK_RETURN(status=1)
  1744. if (isRoot) call MDF_Get_Var( ncid, varid_pdif_24h_history, glb_sfc4D, status)
  1745. IF_NOTOK_MDF(fid=ncid)
  1746. call scatter( dgrid(n), pdif_24h_history, glb_sfc4D, 0, status)
  1747. IF_NOTOK_RETURN(status=1)
  1748. else if (pceea) then
  1749. write (gol,'(" restore PCEEA history parameters ...")'); call goPr
  1750. if (isRoot) call MDF_Get_Var( ncid, varid_ssr_daily, glb_sfc3d(:,:,1), status)
  1751. IF_NOTOK_MDF(fid=ncid)
  1752. call scatter( dgrid(n), ssr_daily, glb_sfc3d(:,:,1), 0, status)
  1753. IF_NOTOK_RETURN(status=1)
  1754. if (isRoot) call MDF_Get_Var( ncid, varid_ssr_10d_history, ssr_10d_history(:,:, 1:ndays_history), status)
  1755. IF_NOTOK_MDF(fid=ncid)
  1756. call scatter( dgrid(n), ssr_10d_history(:,:, 1:ndays_history), glb_sfc3d(:,:, 1:ndays_history), 0, status)
  1757. IF_NOTOK_RETURN(status=1)
  1758. endif
  1759. end if
  1760. #endif
  1761. #ifdef with_online_nox
  1762. ! precipitation history and pulsing parameters; read only once
  1763. if ( do_pulse .and. (n==region1) ) then
  1764. write (gol,'(" restore precipitation history and pulsing parameters ...")'); call goPr
  1765. if (isRoot) call MDF_Get_Var( ncid, varid_cp_daily, glb_sfc3d(:,:,1), status)
  1766. IF_NOTOK_MDF(fid=ncid)
  1767. call scatter( dgrid(n), cp_daily, glb_sfc3d(:,:,1), 0, status)
  1768. IF_NOTOK_RETURN(status=1)
  1769. if (isRoot) call MDF_Get_Var( ncid, varid_lsp_daily, glb_sfc3d(:,:,1), status)
  1770. IF_NOTOK_MDF(fid=ncid)
  1771. call scatter( dgrid(n), lsp_daily, glb_sfc3d(:,:,1), 0, status)
  1772. IF_NOTOK_RETURN(status=1)
  1773. if (isRoot) call MDF_Get_Var( ncid, varid_cp_history, glb_sfc3d(:,:, 1:ndrydays), status)
  1774. IF_NOTOK_MDF(fid=ncid)
  1775. call scatter( dgrid(n), cp_history(:,:, 1:ndrydays), glb_sfc3d(:,:, 1:ndrydays), 0, status)
  1776. IF_NOTOK_RETURN(status=1)
  1777. if (isRoot) call MDF_Get_Var( ncid, varid_lsp_history, glb_sfc3d(:,:, 1:ndrydays), status)
  1778. IF_NOTOK_MDF(fid=ncid)
  1779. call scatter( dgrid(n), lsp_history(:,:, 1:ndrydays), glb_sfc3d(:,:, 1:ndrydays), 0, status)
  1780. IF_NOTOK_RETURN(status=1)
  1781. if (isRoot) call MDF_Get_Var( ncid, varid_pulsing, glb_sfc3d(:,:,1), status)
  1782. IF_NOTOK_MDF(fid=ncid)
  1783. call scatter( dgrid(n), pulsing_field, glb_sfc3d(:,:,1), 0, status)
  1784. IF_NOTOK_RETURN(status=1)
  1785. if (isRoot) call MDF_Get_Var( ncid, varid_plsday, glb_sfc3d(:,:,1), status)
  1786. IF_NOTOK_MDF(fid=ncid)
  1787. call scatter( dgrid(n), plsday_field, glb_sfc3d(:,:,1), 0, status)
  1788. IF_NOTOK_RETURN(status=1)
  1789. if (isRoot) call MDF_Get_Var( ncid, varid_plsdurat, glb_sfc3d(:,:,1), status)
  1790. IF_NOTOK_MDF(fid=ncid)
  1791. call scatter( dgrid(n), plsdurat_field, glb_sfc3d(:,:,1), 0, status)
  1792. IF_NOTOK_RETURN(status=1)
  1793. end if
  1794. #endif
  1795. #ifdef with_m7
  1796. if (do_rm) then
  1797. write (gol,'(" restore M7 fields for optics ...")'); call goPr
  1798. ! water: get 4d array
  1799. if (need_remap) then
  1800. if (isRoot) then
  1801. call MDF_Get_Var( ncid, varid_h2o, src_glb_4d(:,:,:,1:nsol), status )
  1802. IF_NOTOK_MDF(fid=ncid)
  1803. do imode=1,nsol
  1804. src_glb_4d(:,:,:,imode) = src_glb_4d(:,:,:,imode) / airmass
  1805. call Fill3D( global_lli(n), levi, 'n', sp_gbl(:,:,1), tmp4d(:,:,:,imode), &
  1806. lli_restart, levi_restart, src_glb_4d(:,:,:,imode), 'mass-aver', status )
  1807. IF_NOTOK_RETURN(status=1)
  1808. tmp4d(:,:,:,imode) = tmp4d(:,:,:,imode) * run_airmass
  1809. enddo
  1810. endif
  1811. do imode=1,nsol
  1812. call scatter( dgrid(n), h2o_mode(n,imode)%d3, tmp4d(:,:,:,imode), h2o_mode(n,imode)%halo, status)
  1813. enddo
  1814. else
  1815. if (isRoot) call MDF_Get_Var( ncid, varid_h2o, tmp4d(:,:,:,1:nsol), status )
  1816. IF_NOTOK_MDF(fid=ncid)
  1817. do imode=1,nsol
  1818. if ((istart==32).and.(isRoot)) then
  1819. tmp4d(:,:,:,imode) = tmp4d(:,:,:,imode) * run_airmass / airmass
  1820. endif
  1821. call scatter( dgrid(n), h2o_mode(n,imode)%d3, tmp4d(:,:,:,imode), h2o_mode(n,imode)%halo, status)
  1822. end do
  1823. endif
  1824. if (need_remap) then
  1825. status=1
  1826. write(gol,*)' remapping not fully implemented yet for M7 radii'
  1827. call goErr
  1828. TRACEBACK; return
  1829. endif
  1830. ! dry radii: get 4d array
  1831. if (isRoot) call MDF_Get_Var( ncid, varid_rwd, tmp4d(:,:,:,1:nsol), status)
  1832. IF_NOTOK_MDF(fid=ncid)
  1833. do imode=1,nsol
  1834. call scatter( dgrid(n), rwd_mode(n,imode)%d3, tmp4d(:,:,:,imode), rwd_mode(n,imode)%halo, status)
  1835. end do
  1836. ! (wet) radii: get 4d array
  1837. if (isRoot) call MDF_Get_Var( ncid, varid_rw, tmp4d(:,:,:,1:nmod), status)
  1838. IF_NOTOK_MDF(fid=ncid)
  1839. do imode=1,nmod
  1840. call scatter( dgrid(n), rw_mode(n,imode)%d3, tmp4d(:,:,:,imode), rw_mode(n,imode)%halo, status)
  1841. end do
  1842. end if
  1843. #endif /* with_m7 */
  1844. if (isRoot) call MDF_Close( ncid, status )
  1845. IF_NOTOK_RETURN(status=1)
  1846. ! free mem for next region
  1847. if (do_rm) deallocate(values_names)
  1848. if (need_remap) then
  1849. deallocate(sp_gbl,src_glb)
  1850. if (isRoot) then
  1851. call Done( levi_restart, status )
  1852. IF_NOTOK_RETURN(status=1)
  1853. call Done( lli_restart, status )
  1854. IF_NOTOK_RETURN(status=1)
  1855. endif
  1856. endif
  1857. deallocate( tmp3d )
  1858. deallocate( airmass)
  1859. if (istart==32) deallocate(run_airmass)
  1860. #if defined(with_online_bvoc) || defined(with_online_nox)
  1861. deallocate(glb_sfc3D, glb_sfc4D)
  1862. #endif
  1863. #ifdef with_m7
  1864. deallocate( tmp4d )
  1865. if (need_remap) deallocate(src_glb_4d)
  1866. #endif
  1867. ENDDO REG
  1868. status = 0
  1869. END SUBROUTINE RESTART_READ
  1870. !EOC
  1871. END MODULE RESTART