123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196 |
- !
- #define TRACEBACK write (gol,'("in ",a," (",a,", line",i5,")")') rname, __FILE__, __LINE__; call goErr
- #define IF_NOTOK_RETURN(action) if (status/=0) then; TRACEBACK; action; return; end if
- #define IF_NOTOK_MDF(action) if (status/=0) then; TRACEBACK; action; if (isRoot) call MDF_CLose(fid,status); status=1; return; end if
- #define IF_ERROR_RETURN(action) if (status> 0) then; TRACEBACK; action; return; end if
- !
- #include "tm5.inc"
- !
- !----------------------------------------------------------------------------
- ! TM5 !
- !----------------------------------------------------------------------------
- !BOP
- !
- ! !MODULE: RESTART
- !
- ! !DESCRIPTION: Write and read restart files. This version differs from the
- ! 'base' version by accounting for "with_online_nox",
- ! "with_online_bvoc", and "with_m7" cpp flags, which read/write
- ! additional datasets.
- !\\
- !\\
- ! !INTERFACE:
- !
- MODULE RESTART
- !
- ! !USES:
- !
- use GO , only : gol, goPr, goErr
- use dims , only : nregions
- implicit none
- private
- !
- ! !PUBLIC MEMBER FUNCTIONS:
- !
- public :: Restart_Init ! read restart keys in rc file
- public :: Restart_Done ! nothing yet
- public :: Restart_Save ! wrapper around Restart_Write
- public :: Restart_Write ! write a restart file
- public :: Restart_Read ! read a restart file
- public :: rs_write ! model must write restart
- !
- ! !PRIVATE DATA MEMBERS:
- !
- character(len=*), parameter :: mname = 'Restart'
- character(len=256) :: rs_write_dir
- logical :: rs_write
- logical :: rs_write_extra
- integer :: rs_write_extra_dhour, rs_write_extra_hour
- integer :: fid ! file id for IF_NOTOK_MDF macro
- !
- ! !REVISION HISTORY:
- ! 25 Aug 2010 - P. Le Sager - Merged with Base version for Pycasso
- ! 8 Apr 2011 - P. Le Sager - Close MDF file if error occurs. This is
- ! needed for mpi_abort not to hang. See TM5_MPI_Abort in
- ! partools, and remarks below. Made IF_NOTOK_MDF macro for
- ! that purpose.
- ! 28 Apr 2011 - P. Le Sager - Read method : handle restart file with extra
- ! tracers.
- ! 10 Oct 2011 - P. Le Sager - adapted for lon-lat MPI domain decomposition
- !
- ! !REMARKS:
- ! (1) when an error occurs when accessing MDF files, you should first close
- ! the file before returning. The IF_NOTOK_MDF macro takes care of that.
- ! The only thing you need is to call it like that :
- !
- ! IF_NOTOK_MDF(fid=xxxx)
- !
- ! where you replace xxxx with the integer id (file handler) of the file
- ! you are accessing. Note that this does not solve all problems (but
- ! probably most of them): it is still possible that MDF_Close hangs...
- !
- !EOP
- !------------------------------------------------------------------------
- CONTAINS
- !--------------------------------------------------------------------------
- ! TM5 !
- !--------------------------------------------------------------------------
- !BOP
- !
- ! !IROUTINE: RESTART_INIT
- !
- ! !DESCRIPTION: read settings from rcfile
- !\\
- !\\
- ! !INTERFACE:
- !
- SUBROUTINE RESTART_INIT( status )
- !
- ! !USES:
- !
- use GO , only : TrcFile, Init, Done, ReadRc
- use global_data, only : rcfile
- use global_data, only : outdir
- use meteodata , only : lli
- !
- ! !OUTPUT PARAMETERS:
- !
- integer, intent(out) :: status
- !
- ! !REVISION HISTORY:
- !
- !EOP
- !------------------------------------------------------------------------
- !BOC
- character(len=*), parameter :: rname = 'Restart_Init'
- type(TrcFile) :: rcF
- ! ---- begin
-
- call Init( rcF, rcfile, status )
- IF_NOTOK_RETURN(status=1)
- ! write restart files at all ?
- call ReadRc( rcF, 'restart.write', rs_write, status, default=.false. )
- IF_ERROR_RETURN(status=1)
- ! further settings ...
- if ( rs_write ) then
- ! output directory:
- call ReadRc( rcF, 'restart.write.dir', rs_write_dir, status, default=outdir )
- IF_ERROR_RETURN(status=1)
- ! extra restart files ?
- call ReadRc( rcF, 'restart.write.extra', rs_write_extra, status, default=.false. )
- IF_ERROR_RETURN(status=1)
- if ( rs_write_extra ) then
- call ReadRc( rcF, 'restart.write.extra.hour', rs_write_extra_hour, status, default=0 )
- IF_ERROR_RETURN(status=1)
- call ReadRc( rcF, 'restart.write.extra.dhour', rs_write_extra_dhour, status, default=24 )
- IF_ERROR_RETURN(status=1)
- end if
- end if ! write restart files
- call Done( rcF, status )
- IF_NOTOK_RETURN(status=1)
- status = 0
- END SUBROUTINE RESTART_INIT
- !EOC
- !--------------------------------------------------------------------------
- ! TM5 !
- !--------------------------------------------------------------------------
- !BOP
- !
- ! !IROUTINE: RESTART_DONE
- !
- ! !DESCRIPTION:
- !\\
- !\\
- ! !INTERFACE:
- !
- SUBROUTINE RESTART_DONE( status )
- !
- ! !OUTPUT PARAMETERS:
- !
- integer, intent(out) :: status
- !
- ! !REVISION HISTORY:
- !
- !EOP
- !------------------------------------------------------------------------
- !BOC
- character(len=*), parameter :: rname = 'Restart_Done'
- ! --- begin --------------------------------
- ! nothing to be done ...
- ! ok
- status = 0
- END SUBROUTINE RESTART_DONE
- !EOC
- !--------------------------------------------------------------------------
- ! TM5 !
- !--------------------------------------------------------------------------
- !BOP
- !
- ! !IROUTINE: RESTART_SAVE
- !
- ! !DESCRIPTION:
- !\\
- !\\
- ! !INTERFACE:
- !
- SUBROUTINE RESTART_SAVE( status, extra, isfirst )
- !
- ! !USES:
- !
- use dims, only : idate
- !
- ! !OUTPUT PARAMETERS:
- !
- integer, intent(out) :: status
- !
- ! !INPUT PARAMETERS:
- !
- logical, intent(in), optional :: extra
- logical, intent(in), optional :: isfirst
- !
- ! !REVISION HISTORY:
- !
- !EOP
- !------------------------------------------------------------------------
- !BOC
- character(len=*), parameter :: rname = 'Restart_Save'
- logical :: is_extra
- real :: t1, t2
-
- ! --- begin --------------------------------
- ! options ...
- is_extra = .false.
- if ( present(extra) ) is_extra = extra
- ! write restart files at all ?
- if ( rs_write ) then
- ! end or extra ?
- if ( is_extra ) then
- ! save extra restart files ?
- if ( rs_write_extra ) then
- ! every hour+n*dhour only :
- if ( modulo( idate(4) - rs_write_extra_hour, rs_write_extra_dhour ) == 0 .and. &
- all( idate(5:6) == 0 ) ) then
- ! write restart file for this time:
- call Restart_Write( status, isfirst=isfirst )
- IF_NOTOK_RETURN(status=1)
- end if ! for this hour
- end if ! extra restart files ?
- else
- ! write restart file :
- call cpu_time(t1)
- call Restart_Write( status, isfirst=isfirst )
- IF_NOTOK_RETURN(status=1)
- call cpu_time(t2)
- write (gol,*) " time to write restart [s]: ", t2-t1 ; call goPr
- end if ! not extra
- end if ! write at all
- ! ok
- status = 0
- END SUBROUTINE RESTART_SAVE
- !EOC
- !--------------------------------------------------------------------------
- ! TM5 !
- !--------------------------------------------------------------------------
- !BOP
- !
- ! !IROUTINE: RESTART_FILENAME
- !
- ! !DESCRIPTION: Build restart filename from inputs.
- !\\
- !\\
- ! !INTERFACE:
- !
- SUBROUTINE RESTART_FILENAME( region, fname, status, key, dir, isfirst )
- !
- ! !USES:
- !
- use dims , only : idate
- use global_data, only : outdir
- use meteodata , only : lli
- !
- ! !INPUT PARAMETERS:
- !
- integer, intent(in) :: region
- logical, intent(in), optional :: isfirst
- character(len=*), intent(in), optional :: dir
- character(len=*), intent(in), optional :: key
- !
- ! !OUTPUT PARAMETERS:
- !
- character(len=*), intent(out) :: fname
- integer, intent(out) :: status
- !
- ! !REVISION HISTORY:
- ! 24 Aug 2010 - P. Le Sager - merged w/ trunk for pycasso
- !
- !EOP
- !------------------------------------------------------------------------
- !BOC
-
- character(len=*), parameter :: rname = 'Restart_FileName'
- character(len=256) :: adir
- character(len=32) :: akey
- ! --- begin --------------------------------
- ! destination directory:
- adir = trim(outdir)
- if ( present(dir) ) adir = trim(dir)
- ! extra key, for example '_x' to denote that
- ! a restart file was dumped after process 'x':
- akey = ''
- if ( present(key) ) akey = trim(key)
- ! if this is the initial time, add an extra key to avoid
- ! that the restart file for this hour from the previous
- ! run is overwritten:
- if ( present(isfirst) ) then
- if ( isfirst ) akey = trim(akey)//'_initial'
- end if
- ! write filename:
- write (fname,'(a,"/TM5_restart_",i4.4,2i2.2,"_",2i2.2,"_",a,a,".nc")') &
- trim(adir), idate(1:5), trim(lli(region)%name), trim(akey)
- ! ok
- status = 0
- END SUBROUTINE RESTART_FILENAME
- !EOC
- !--------------------------------------------------------------------------
- ! TM5 !
- !--------------------------------------------------------------------------
- !BOP
- !
- ! !IROUTINE: RESTART_WRITE
- !
- ! !DESCRIPTION: write restart
- !\\
- !\\
- ! !INTERFACE:
- !
- SUBROUTINE RESTART_WRITE( status, key, region, isfirst )
- !
- ! !USES:
- !
- use GO , only : Get
- use dims , only : nregions, at, bt
- use dims , only : iglbsfc
- use chem_param , only : ntracet, ntrace_chem, ntrace, names
- use partools , only : isRoot
- use tm5_distgrid, only : dgrid, Get_DistGrid, gather
- use global_data , only : mass_dat, chem_dat
- #ifdef with_tendencies
- use tm5_tendency, only : plc_ntr, plc_trname
- use tm5_tendency, only : plc_npr, plc_prname
- use tracer_data , only : plc_dat
- #endif
- #ifdef with_online_bvoc
- use emission_bvoc_data, only : megan, pceea
- use emission_bvoc_data, only : ndays_history, nhours_history, n_layers
- use emission_bvoc_data, only : skt_daily, pdir_daily, pdif_daily, ssr_daily
- use emission_bvoc_data, only : skt_10d_history, pdir_10d_history, pdif_10d_history, ssr_10d_history
- use emission_bvoc_data, only : skt_hourly, pdir_hourly, pdif_hourly
- use emission_bvoc_data, only : skt_24h_history, pdir_24h_history, pdif_24h_history
- use chem_param, only : iisop
- #endif
- #ifdef with_online_nox
- use online_nox_data, only : pulsing_on, ndrydays
- use online_nox_data, only : cp_daily, lsp_daily
- use online_nox_data, only : cp_history, lsp_history
- use online_nox_data, only : pulsing_field, plsday_field, plsdurat_field
- #endif
- #ifdef with_m7
- use mo_aero_m7, only : nsol, nmod
- use m7_data, only : h2o_mode, rw_mode, rwd_mode
- #endif
- use meteodata , only : global_lli, levi
- use meteodata , only : sp_dat, phlb_dat, m_dat
- use MDF , only : MDF_Create, MDF_EndDef, MDF_Close
- use MDF , only : MDF_Def_Dim, MDF_Def_Var
- use MDF , only : MDF_Put_Att, MDF_Put_Var
- use MDF , only : MDF_REPLACE, MDF_NETCDF4
- use MDF , only : MDF_FLOAT, MDF_DOUBLE, MDF_CHAR
- !
- ! !OUTPUT PARAMETERS:
- !
- integer, intent(out) :: status
- !
- ! !INPUT PARAMETERS:
- !
- character(len=*), intent(in), optional :: key
- integer, intent(in), optional :: region
- logical, intent(in), optional :: isfirst
- !
- ! !REVISION HISTORY:
- ! 8 Apr 2011 - P. Le Sager - use IF_NOTOK_MDF macro
- ! 16 Mar 2012 - P. Le Sager - adapted for lon-lat MPI domain decomposition
- !
- ! !REMARKS:
- ! - Serial writing not tested for cases: with_online_nox and with_online_bvoc (February 19, 2018)
- !
- !EOP
- !------------------------------------------------------------------------
- !BOC
- character(len=*), parameter :: rname = 'Restart_Write'
- integer :: imr, jmr, lmr, n
- character(len=256) :: fname
- integer :: ftype
- integer :: ncid
- integer :: dimid_lon, dimid_lat, dimid_lev, dimid_hlev
- integer :: dimid_lon_sfc, dimid_lat_sfc
- integer :: dimid_trace, dimid_trace_transp, dimid_trace_chem
- integer :: dimid_name
- integer :: varid, varid_at, varid_bt
- integer :: varid_sp, varid_ph, varid_m
- integer :: varid_names, varid_rm
- #ifdef slopes
- integer :: varid_rxm, varid_rym, varid_rzm
- #endif
- integer :: varid_rmc
- #ifdef with_tendencies
- integer :: varid_plc(plc_ntr,plc_npr)
- integer :: itr, ipr
- integer :: time6(6)
- #endif
- #ifdef with_online_bvoc
- integer :: dimid_lon_bvoc, dimid_lat_bvoc
- integer :: dimid_days_history, dimid_hours_history, dimid_layers
- integer :: varid_skt_daily, varid_pdir_daily, varid_pdif_daily, varid_ssr_daily
- integer :: varid_skt_10d_history, varid_pdir_10d_history, varid_pdif_10d_history, varid_ssr_10d_history
- integer :: varid_skt_hourly, varid_pdir_hourly, varid_pdif_hourly
- integer :: varid_skt_24h_history, varid_pdir_24h_history, varid_pdif_24h_history
- #endif
- #ifdef with_online_nox
- integer :: dimid_lon_nox, dimid_lat_nox
- integer :: dimid_drydays
- integer :: varid_cp_daily, varid_lsp_daily
- integer :: varid_cp_history, varid_lsp_history
- integer :: varid_pulsing, varid_plsday, varid_plsdurat
- #endif
- #ifdef with_m7
- integer :: varid_h2o, varid_rw, varid_rwd
- integer :: dimid_nsol, dimid_nmod
- integer :: imode
- character(len=3), parameter :: h2o_name = 'h2o'
- character(len=3), parameter :: rwd_name = 'rwd'
- character(len=2), parameter :: rw_name = 'rw'
- #endif
- integer :: rtype, n360, n180
- real, allocatable :: arr4d(:,:,:,:), arr3d(:,:,:)
- #if defined(with_online_bvoc) || defined(with_online_nox)
- real, allocatable :: glb_sfc3D(:,:,:), glb_sfc4D(:,:,:,:)
- #endif
- ! --- begin --------------------------------
- write (gol,'("write restart file(s) ...")'); call goPr
- ! loop over regions:
- REG: do n = 1, nregions
- ! only selected region ?
- if ( present(region) ) then
- if ( n /= region ) cycle
- end if
- ! entire region grid size
- imr = global_lli(n)%nlon
- jmr = global_lli(n)%nlat
- lmr = levi%nlev
- ! allocate 3D and 4D global arrays for gathering data
- if (isRoot) then
- allocate( arr4d(imr,jmr,lmr,ntracet) )
- allocate( arr3d(imr,jmr,lmr+1) )
- else
- allocate( arr4d(1,1,1,1) )
- allocate( arr3d(1,1,1) )
- endif
- ! get extra bounds for 1x1 dataset
- #if defined(with_online_bvoc) || defined(with_online_nox)
- if(n==1) then
- n360 = dgrid(iglbsfc)%im_region
- n180 = dgrid(iglbsfc)%jm_region
- if (isRoot) then
- allocate( glb_sfc3d(n360, n180, max(ndays_history, n_layers, ndrydays, nhours_history ) )
- allocate( glb_sfc4d(n360, n180, n_layers, ndays_history) )
- else
- allocate( glb_sfc3d(1,1,1) )
- allocate( glb_sfc4d(1,1,1,1) )
- endif
- end if
- #endif
- ! name of restart file
- call Restart_FileName( n, fname, status, key=key, dir=rs_write_dir, isfirst=isfirst )
- IF_NOTOK_RETURN(status=1)
- write (gol,'(" destination : ",a)') trim(fname); call goPr
- if (isRoot) then
- !------------------
- ! OPEN NETCDF FILE
- !------------------
- ! overwrite existing files (clobber)
- call MDF_Create( trim(fname), MDF_NETCDF4, MDF_REPLACE, ncid, status )
- IF_NOTOK_RETURN(status=1)
- !------------------
- ! DEFINE DIMENSIONS
- !------------------
- call MDF_Def_Dim( ncid, 'lon', imr, dimid_lon, status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Def_Dim( ncid, 'lat', jmr, dimid_lat, status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Def_Dim( ncid, 'lon_sfc', global_lli(iglbsfc)%nlon, dimid_lon_sfc, status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Def_Dim( ncid, 'lat_sfc', global_lli(iglbsfc)%nlat, dimid_lat_sfc, status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Def_Dim( ncid, 'lev', lmr, dimid_lev, status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Def_Dim( ncid, 'hlev', lmr+1, dimid_hlev, status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Def_Dim( ncid, 'trace_transp', ntracet, dimid_trace_transp, status )
- IF_NOTOK_MDF(fid=ncid)
- if ( ntrace_chem > 0 ) then
- call MDF_Def_Dim( ncid, 'trace_chem', ntrace_chem, dimid_trace_chem, status )
- IF_NOTOK_MDF(fid=ncid)
- else
- dimid_trace_chem = -1
- end if
- call MDF_Def_Dim( ncid, 'trace', ntrace, dimid_trace, status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Def_Dim( ncid, 'name', len(names(1)), dimid_name, status )
- IF_NOTOK_MDF(fid=ncid)
- #ifdef with_online_bvoc
- ! MEGAN/PCEEA history
- if ( (megan .or. pceea) .and. (n == 1) ) then
- call MDF_Def_Dim( ncid, 'lon_bvoc', n360, dimid_lon_bvoc ,status)
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Def_Dim( ncid, 'lat_bvoc', n180, dimid_lat_bvoc ,status)
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Def_Dim( ncid, 'day_bvoc', ndays_history, dimid_days_history ,status)
- IF_NOTOK_MDF(fid=ncid)
- endif
- if (megan .and. (n == 1) ) then
- call MDF_Def_Dim( ncid, 'hour_bvoc', nhours_history, dimid_hours_history ,status)
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Def_Dim( ncid, 'layer_bvoc', n_layers, dimid_layers ,status)
- IF_NOTOK_MDF(fid=ncid)
- endif
- #endif
- #ifdef with_online_nox
- ! precipitation history and pulsing parameters
- if (pulsing_on .and. (n == 1) ) then
- call MDF_Def_Dim( ncid, 'lon_nox', n360, dimid_lon_nox ,status)
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Def_Dim( ncid, 'lat_nox', n180, dimid_lat_nox ,status)
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Def_Dim( ncid, 'day_nox', ndrydays, dimid_drydays ,status)
- IF_NOTOK_MDF(fid=ncid)
- endif
- #endif
- #ifdef with_m7
- ! --------------------
- ! M7 fields for optics
- ! --------------------
- call MDF_Def_Dim( ncid, 'nsol', nsol, dimid_nsol, status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Def_Dim( ncid, 'nmod', nmod, dimid_nmod, status )
- IF_NOTOK_MDF(fid=ncid)
- #endif
- !------------------
- ! DEFINE VARIABLES
- !------------------
- select case ( kind(m_dat(n)%data) )
- case ( 4 ) ; rtype = MDF_FLOAT
- case ( 8 ) ; rtype = MDF_DOUBLE
- case default
- write (gol,'("unsupported real kind : ",i6)') kind(m_dat(n)%data)
- TRACEBACK; status=1; return
- end select
- ! surface pressure
- call MDF_Def_Var( ncid, 'sp', rtype, (/dimid_lon,dimid_lat/), varid, status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'long_name', 'surface pressure', status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'unit', 'Pa', status )
- IF_NOTOK_MDF(fid=ncid)
- varid_sp = varid
- ! at, bt coefficients for hybrid grid
- call MDF_Def_Var( ncid, 'at', rtype, (/dimid_hlev/), varid, status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'long_name', 'hybrid grid a_t coefficient', status )
- IF_NOTOK_MDF(fid=ncid)
- varid_at = varid
- call MDF_Def_Var( ncid, 'bt', rtype, (/dimid_hlev/), varid, status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'long_name', 'hybrid grid b_t coefficient', status )
- IF_NOTOK_MDF(fid=ncid)
- varid_bt = varid
- ! half level pressure
- call MDF_Def_Var( ncid, 'ph', rtype, (/dimid_lon,dimid_lat,dimid_hlev/), varid, status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'long_name', 'half level pressure', status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'unit', 'Pa', status )
- IF_NOTOK_MDF(fid=ncid)
- varid_ph = varid
- ! air mass
- call MDF_Def_Var( ncid, 'm', rtype, (/dimid_lon,dimid_lat,dimid_lev/), varid, status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'long_name', 'air mass', status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'unit', 'kg', status )
- IF_NOTOK_MDF(fid=ncid)
- varid_m = varid
- !! accumulated surface fluxes
- !!
- !call MDF_Def_Var( ncid, 'slhf', rtype, (/dimid_lon_sfc,dimid_lat_sfc/), varid, status )
- !IF_NOTOK_MDF(fid=ncid)
- !call MDF_Put_Att( ncid, varid, 'long_name', 'surface latent heat flux', status )
- !IF_NOTOK_MDF(fid=ncid)
- !call MDF_Put_Att( ncid, varid, 'unit', 'W/m2', status )
- !IF_NOTOK_MDF(fid=ncid)
- !varid_slhf = varid
- !!
- !call MDF_Def_Var( ncid, 'sshf', rtype, (/dimid_lon_sfc,dimid_lat_sfc/), varid, status )
- !IF_NOTOK_MDF(fid=ncid)
- !call MDF_Put_Att( ncid, varid, 'long_name', 'surface sensible heat flux', status )
- !IF_NOTOK_MDF(fid=ncid)
- !call MDF_Put_Att( ncid, varid, 'unit', 'W/m2', status )
- !IF_NOTOK_MDF(fid=ncid)
- !varid_sshf = varid
- ! tracer names
- call MDF_Def_Var( ncid, 'names', MDF_CHAR, (/dimid_name,dimid_trace/), varid, status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'long_name', 'tracer names', status )
- IF_NOTOK_MDF(fid=ncid)
- varid_names = varid
- ! tracer mass
- call MDF_Def_Var( ncid, 'rm', rtype, &
- (/dimid_lon,dimid_lat,dimid_lev,dimid_trace_transp/), varid, status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'long_name', 'transported tracer mass', status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'unit', 'kg', status )
- IF_NOTOK_MDF(fid=ncid)
- varid_rm = varid
- ! tracer mass slopes:
- #ifdef slopes
- call MDF_Def_Var( ncid, 'rxm', rtype, &
- (/dimid_lon,dimid_lat,dimid_lev,dimid_trace_transp/), varid, status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'long_name', 'tracer mass slope in x direction', status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'unit', 'kg/(half cell)', status )
- IF_NOTOK_MDF(fid=ncid)
- varid_rxm = varid
- call MDF_Def_Var( ncid, 'rym', rtype, &
- (/dimid_lon,dimid_lat,dimid_lev,dimid_trace_transp/), varid, status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'long_name', 'tracer mass slope in y direction', status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'unit', 'kg/(half cell)', status )
- IF_NOTOK_MDF(fid=ncid)
- varid_rym = varid
- call MDF_Def_Var( ncid, 'rzm', rtype, &
- (/dimid_lon,dimid_lat,dimid_lev,dimid_trace_transp/), varid, status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'long_name', 'tracer mass slope in z direction', status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'unit', 'kg/(half cell)', status )
- IF_NOTOK_MDF(fid=ncid)
- varid_rzm = varid
- #endif
- ! non-transported tracers:
- if ( ntrace_chem > 0 ) then
- call MDF_Def_Var( ncid, 'rmc', rtype, &
- (/dimid_lon,dimid_lat,dimid_lev,dimid_trace_chem/), varid, status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'long_name', 'non-transported tracer mass', status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'unit', 'kg', status )
- IF_NOTOK_MDF(fid=ncid)
- varid_rmc = varid
- end if
- #ifdef with_tendencies
- ! production, loss, and concentration:
- do itr = 1, plc_ntr
- do ipr = 1, plc_npr
- ! define netcdf variable:
- call MDF_Def_Var( ncid, trim(plc_trname(itr))//'_'//trim(plc_prname(ipr)), rtype, &
- (/dimid_lon,dimid_lat,dimid_lev/), varid, status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'long_name', 'chemical tendency', status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'unit', trim(plc_dat(region,itr,ipr)%unit), status )
- IF_NOTOK_MDF(fid=ncid)
- ! extract time as 6 integers:
- call Get( plc_dat(region,itr,ipr)%t, time6=time6 )
- ! add time attribute:
- call MDF_Put_Att( ncid, varid, 'time', time6, status )
- IF_NOTOK_MDF(fid=ncid)
- ! store variable id:
- varid_plc(itr,ipr) = varid
- end do
- end do
- #endif
- #ifdef with_online_bvoc
- ! MEGAN/PCEEA history parameters
- if ( (megan .or. pceea) .and. (n == 1) ) then
- call MDF_Def_Var( ncid, 'skt_daily', rtype, (/dimid_lon_bvoc,dimid_lat_bvoc/), varid, status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'long_name', 'average skin temperature since the start of this day', status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'unit', 'K', status )
- IF_NOTOK_MDF(fid=ncid)
- varid_skt_daily = varid
- !
- call MDF_Def_Var( ncid, 'skt_10d_history', rtype, (/dimid_lon_bvoc,dimid_lat_bvoc,dimid_days_history/), varid, status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'long_name', '10-day skin temperature record', status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'unit', 'K', status )
- IF_NOTOK_MDF(fid=ncid)
- varid_skt_10d_history = varid
- endif
- if (megan .and. (n == 1) ) then
- !
- call MDF_Def_Var( ncid, 'pdir_daily', rtype, (/dimid_lon_bvoc,dimid_lat_bvoc/), varid, status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'long_name', &
- 'average direct component of the photosynthetic photon flux density since the start of this day', status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'unit', 'umol/(m2 s)', status )
- IF_NOTOK_MDF(fid=ncid)
- varid_pdir_daily = varid
- !
- call MDF_Def_Var( ncid, 'pdir_10d_history', rtype, (/dimid_lon_bvoc,dimid_lat_bvoc,dimid_days_history/), varid, status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'long_name', &
- '10-day record of the direct component of the photosynthetic photon flux density', status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'unit', 'umol/(m2 s)', status )
- IF_NOTOK_MDF(fid=ncid)
- varid_pdir_10d_history = varid
- !
- call MDF_Def_Var( ncid, 'pdif_daily', rtype, (/dimid_lon_bvoc,dimid_lat_bvoc,dimid_layers/), varid, status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'long_name', &
- 'average diffuse component of the photosynthetic photon flux density since the start of this day', status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'unit', 'umol/(m2 s)', status )
- IF_NOTOK_MDF(fid=ncid)
- varid_pdif_daily = varid
- !
- call MDF_Def_Var( ncid, 'pdif_10d_history', rtype, &
- (/dimid_lon_bvoc,dimid_lat_bvoc,dimid_layers,dimid_days_history/), varid, status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'long_name', &
- '10-day record of the diffuse component of the photosynthetic photon flux density', status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'unit', 'umol/(m2 s)', status )
- IF_NOTOK_MDF(fid=ncid)
- varid_pdif_10d_history = varid
- !
- call MDF_Def_Var( ncid, 'skt_hourly', rtype, (/dimid_lon_bvoc,dimid_lat_bvoc/), varid, status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'long_name', 'averaged skin temperature since the start of this hour', status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'unit', 'K', status )
- IF_NOTOK_MDF(fid=ncid)
- varid_skt_hourly = varid
- !
- call MDF_Def_Var( ncid, 'skt_24h_history', rtype, (/dimid_lon_bvoc,dimid_lat_bvoc,dimid_hours_history/), varid, status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'long_name', '24-hour skin temperature record', status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'unit', 'K', status )
- IF_NOTOK_MDF(fid=ncid)
- varid_skt_24h_history = varid
- !
- call MDF_Def_Var( ncid, 'pdir_hourly', rtype, (/dimid_lon_bvoc,dimid_lat_bvoc/), varid, status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'long_name', &
- 'average direct component of the photosynthetic photon flux density since the start of this hour', status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'unit', 'umol/(m2 s)', status )
- IF_NOTOK_MDF(fid=ncid)
- varid_pdir_hourly = varid
- !
- call MDF_Def_Var( ncid, 'pdir_24h_history', rtype, (/dimid_lon_bvoc,dimid_lat_bvoc,dimid_hours_history/), varid, status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'long_name', &
- '24-hour record of the direct component of the photosynthetic photon flux density', status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'unit', 'umol/(m2 s)', status )
- IF_NOTOK_MDF(fid=ncid)
- varid_pdir_24h_history = varid
- !
- call MDF_Def_Var( ncid, 'pdif_hourly', rtype, (/dimid_lon_bvoc,dimid_lat_bvoc,dimid_layers/), varid, status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'long_name', &
- 'average diffuse component of the photosynthetic photon flux density since the start of this hour', status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'unit', 'umol/(m2 s)', status )
- IF_NOTOK_MDF(fid=ncid)
- varid_pdif_hourly = varid
- !
- call MDF_Def_Var( ncid, 'pdif_24h_history', rtype, &
- (/dimid_lon_bvoc,dimid_lat_bvoc,dimid_layers,dimid_hours_history/), varid, status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'long_name', &
- '24-hour record of the diffuse component of the photosynthetic photon flux density', status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'unit', 'umol/(m2 s)', status )
- IF_NOTOK_MDF(fid=ncid)
- varid_pdif_24h_history = varid
- !
- else if ( pceea .and. (n == 1) ) then
- !
- call MDF_Def_Var( ncid, 'ssr_daily', rtype, (/dimid_lon_bvoc,dimid_lat_bvoc/), varid, status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'long_name', 'average surface solar radiation since the start of this day', status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'unit', 'W/m2', status )
- IF_NOTOK_MDF(fid=ncid)
- varid_ssr_daily = varid
- !
- call MDF_Def_Var( ncid, 'ssr_10d_history', rtype, (/dimid_lon_bvoc,dimid_lat_bvoc,dimid_days_history/), varid, status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'long_name', '10-day surface solar radiation record', status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'unit', 'W/m2', status )
- IF_NOTOK_MDF(fid=ncid)
- varid_ssr_10d_history = varid
- !
- endif
- #endif
- #ifdef with_online_nox
- ! precipitation history and pulsing parameters
- if (pulsing_on .and. (n == 1) ) then
- !
- call MDF_Def_Var( ncid, 'cp_daily', rtype, (/dimid_lon_nox,dimid_lat_nox/), varid, status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'long_name', 'daily accumulated convective rainfall', status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'unit', 'm', status )
- IF_NOTOK_MDF(fid=ncid)
- varid_cp_daily = varid
- !
- call MDF_Def_Var( ncid, 'lsp_daily', rtype, (/dimid_lon_nox,dimid_lat_nox/), varid, status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'long_name', 'daily accumulated large-scale rainfall', status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'unit', 'm', status )
- IF_NOTOK_MDF(fid=ncid)
- varid_lsp_daily = varid
- !
- call MDF_Def_Var( ncid, 'cp_history', rtype, (/dimid_lon_nox,dimid_lat_nox,dimid_drydays/), varid, status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'long_name', '14-day convective rainfall record', status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'unit', 'm', status )
- IF_NOTOK_MDF(fid=ncid)
- varid_cp_history = varid
- !
- call MDF_Def_Var( ncid, 'lsp_history', rtype, (/dimid_lon_nox,dimid_lat_nox,dimid_drydays/), varid, status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'long_name', '14-day large-scale rainfall record', status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'unit', 'm', status )
- IF_NOTOK_MDF(fid=ncid)
- varid_lsp_history = varid
- !
- call MDF_Def_Var( ncid, 'pulsing', rtype, (/dimid_lon_nox,dimid_lat_nox/), varid, status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'long_name', 'pulsing regime', status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'unit', 'unity', status )
- IF_NOTOK_MDF(fid=ncid)
- varid_pulsing = varid
- !
- call MDF_Def_Var( ncid, 'plsday', rtype, (/dimid_lon_nox,dimid_lat_nox/), varid, status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'long_name', 'time of pulsing', status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'unit', 'days', status )
- IF_NOTOK_MDF(fid=ncid)
- varid_plsday = varid
- !
- call MDF_Def_Var( ncid, 'plsdurat', rtype, (/dimid_lon_nox,dimid_lat_nox/), varid, status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'long_name', 'duration of pulse', status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'unit', 'days', status )
- IF_NOTOK_MDF(fid=ncid)
- varid_plsdurat = varid
- !
- endif
- #endif
- #ifdef with_m7
- #ifndef without_chemistry
- ! --------------------
- ! M7 fields for optics
- ! --------------------
- ! water fields
- call MDF_Def_Var( ncid, trim(h2o_name), rtype, (/dimid_lon,dimid_lat,dimid_lev,dimid_nsol/), varid, status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'long_name', 'aerosol water content', status)
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'unit', 'kg', status)
- IF_NOTOK_MDF(fid=ncid)
- varid_h2o = varid
- ! dry radii for soluble modes
- call MDF_Def_Var( ncid, trim(rwd_name), rtype, (/dimid_lon,dimid_lat,dimid_lev,dimid_nsol/), varid, status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'long_name', 'mode dry radius', status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'unit', 'm', status )
- IF_NOTOK_MDF(fid=ncid)
- varid_rwd = varid
- ! wet radii
- call MDF_Def_Var( ncid, trim(rw_name), rtype, (/dimid_lon,dimid_lat,dimid_lev,dimid_nmod/), varid, status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'long_name', 'mode radius', status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Att( ncid, varid, 'unit', 'm', status )
- IF_NOTOK_MDF(fid=ncid)
- varid_rw = varid
- #endif
- #endif
- !------------------
- ! END DEFINITION MODE
- !------------------
- call MDF_EndDef( ncid, status )
- IF_NOTOK_MDF(fid=ncid)
- endif
- !------------------
- ! WRITE VARIABLES
- !------------------
- ! surface pressure
- call gather( dgrid(n), sp_dat(n)%data, arr3d(:,:,1:1), sp_dat(n)%halo, status)
- IF_NOTOK_RETURN(status=1)
- if (isRoot) call MDF_Put_Var( ncid, varid_sp, arr3d(:,:,1), status )
- IF_NOTOK_MDF(fid=ncid)
- ! half level pressure
- call gather( dgrid(n), phlb_dat(n)%data, arr3d, phlb_dat(n)%halo, status)
- IF_NOTOK_RETURN(status=1)
- if (isRoot) call MDF_Put_Var( ncid, varid_ph, arr3d, status)
- IF_NOTOK_MDF(fid=ncid)
- ! at, bt coefficients
- if (isRoot) then
- call MDF_Put_Var( ncid, varid_at, at(1:lmr+1), status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Put_Var( ncid, varid_bt, bt(1:lmr+1), status )
- IF_NOTOK_MDF(fid=ncid)
- end if
- ! air mass
- call gather( dgrid(n), m_dat(n)%data, arr4d(:,:,:,1), m_dat(n)%halo, status)
- IF_NOTOK_RETURN(status=1)
- if (isRoot) call MDF_Put_Var( ncid, varid_m, arr4d(:,:,:,1), status)
- IF_NOTOK_MDF(fid=ncid)
- !! surface latent heat flux; global surface field !
- !call MDF_Put_Var( ncid, varid_slhf, slhf_dat(iglbsfc)%data(1:n360,1:n180,1), status )
- !IF_NOTOK_MDF(fid=ncid)
- !
- !! surface sensible heat flux; global surface field !
- !call MDF_Put_Var( ncid, varid_sshf, sshf_dat(iglbsfc)%data(1:n360,1:n180,1), status )
- !IF_NOTOK_MDF(fid=ncid)
- ! tracer names
- if (isRoot) call MDF_Put_Var( ncid, varid_names, names, status )
- IF_NOTOK_MDF(fid=ncid)
- ! write transported tracers
- call gather( dgrid(n), mass_dat(n)%rm, arr4d, mass_dat(n)%halo, status)
- IF_NOTOK_RETURN(status=1)
- if (isRoot) call MDF_Put_Var( ncid, varid_rm, arr4d, status)
- IF_NOTOK_MDF(fid=ncid)
- #ifdef slopes
- call gather( dgrid(n), mass_dat(n)%rxm, arr4d, mass_dat(n)%halo, status)
- IF_NOTOK_RETURN(status=1)
- if (isRoot) call MDF_Put_Var( ncid, varid_rxm, arr4d, status)
- IF_NOTOK_MDF(fid=ncid)
- call gather( dgrid(n), mass_dat(n)%rym, arr4d, mass_dat(n)%halo, status)
- IF_NOTOK_RETURN(status=1)
- if (isRoot) call MDF_Put_Var( ncid, varid_rym, arr4d, status)
- IF_NOTOK_MDF(fid=ncid)
- call gather( dgrid(n), mass_dat(n)%rzm, arr4d, mass_dat(n)%halo, status)
- IF_NOTOK_RETURN(status=1)
- if (isRoot) call MDF_Put_Var( ncid, varid_rzm, arr4d, status)
- IF_NOTOK_MDF(fid=ncid)
- #endif
- ! write non-transported tracers
- if (ntrace_chem > 0) then
- call gather( dgrid(n), chem_dat(n)%rm, arr4d(:,:,:,1:ntrace_chem), chem_dat(n)%halo, status)
- IF_NOTOK_RETURN(status=1)
- if (isRoot) call MDF_Put_Var( ncid, varid_rmc, arr4d(:,:,:,1:ntrace_chem), status)
- IF_NOTOK_MDF(fid=ncid)
- end if
- #ifdef with_tendencies
- ! write production/loss/concentration levels on this pe:
- do itr = 1, plc_ntr
- do ipr = 1, plc_npr
- call gather( dgrid(n), plc_dat(n,itr,ipr)%rm, arr3d(:,:,1:lmr), 0, status)
- IF_NOTOK_RETURN(status=1)
- if (isRoot) call MDF_Put_Var( ncid, varid_plc(itr,ipr), arr3d(:,:,1:lmr), status )
- IF_NOTOK_MDF(fid=ncid)
- end do
- end do
- #endif
- #ifdef with_online_bvoc
- ! MEGAN/PCEEA history parameters; write only once
- if (n==1) then
- if (megan .or. pceea) then
- call gather( dgrid(n), skt_daily, glb_sfc3D(:,:,1), 0, status)
- IF_NOTOK_RETURN(status=1)
- if (isRoot) call MDF_Put_Var( ncid, varid_skt_daily, glb_sfc3D(:,:,1), status)
- IF_NOTOK_MDF(fid=ncid)
- call gather( dgrid(n), skt_10d_history, glb_sfc3D(:,:,1:ndays_history), 0, status)
- IF_NOTOK_RETURN(status=1)
- if (isRoot) call MDF_Put_Var( ncid, varid_skt_10d_history, glb_sfc3D(:,:,1:ndays_history), status)
- IF_NOTOK_MDF(fid=ncid)
- endif
- !
- if (megan) then
- call gather( dgrid(n), pdir_daily, glb_sfc3D(:,:,1), 0, status)
- IF_NOTOK_RETURN(status=1)
- if (isRoot) call MDF_Put_Var( ncid, varid_pdir_daily, glb_sfc3D(:,:,1), status)
- IF_NOTOK_MDF(fid=ncid)
- call gather( dgrid(n), skt_daily, glb_sfc3D(:,:,1:ndays_history), 0, status)
- IF_NOTOK_RETURN(status=1)
- if (isRoot) call MDF_Put_Var( ncid, varid_pdir_10d_history, glb_sfc3D(:,:,1:ndays_history), status)
- IF_NOTOK_MDF(fid=ncid)
- call gather( dgrid(n), skt_daily, glb_sfc3D(:,:,1:n_layers), 0, status)
- IF_NOTOK_RETURN(status=1)
- if (isRoot) call MDF_Put_Var( ncid, varid_pdif_daily, glb_sfc3D(:,:,1:n_layers), status)
- IF_NOTOK_MDF(fid=ncid)
- call gather( dgrid(n), skt_daily, glb_sfc4D, 0, status)
- IF_NOTOK_RETURN(status=1)
- if (isRoot) call MDF_Put_Var( ncid, varid_pdif_10d_history, glb_sfc4D, status)
- IF_NOTOK_MDF(fid=ncid)
- call gather( dgrid(n), skt_daily, glb_sfc3D(:,:,1), 0, status)
- IF_NOTOK_RETURN(status=1)
- if (isRoot) call MDF_Put_Var( ncid, varid_skt_hourly, glb_sfc3D(:,:,1), status)
- IF_NOTOK_MDF(fid=ncid)
- call gather( dgrid(n), skt_daily, glb_sfc3D(:,:,1:nhours_history), 0, status)
- IF_NOTOK_RETURN(status=1)
- if (isRoot) call MDF_Put_Var( ncid, varid_skt_24h_history, glb_sfc3D(:,:,1:nhours_history), status)
- IF_NOTOK_MDF(fid=ncid)
- call gather( dgrid(n), skt_daily, glb_sfc3D(:,:,1), 0, status)
- IF_NOTOK_RETURN(status=1)
- if (isRoot) call MDF_Put_Var( ncid, varid_pdir_hourly, glb_sfc3D(:,:,1), status)
- IF_NOTOK_MDF(fid=ncid)
- call gather( dgrid(n), skt_daily, glb_sfc3D(:,:,1:nhours_history), 0, status)
- IF_NOTOK_RETURN(status=1)
- if (isRoot) call MDF_Put_Var( ncid, varid_pdir_24h_history, glb_sfc3D(:,:,1:nhours_history), status)
- IF_NOTOK_MDF(fid=ncid)
- call gather( dgrid(n), skt_daily, glb_sfc3D(:,:,1:n_layers), 0, status)
- IF_NOTOK_RETURN(status=1)
- if (isRoot) call MDF_Put_Var( ncid, varid_pdif_hourly, glb_sfc3D(:,:,1:n_layers), status)
- IF_NOTOK_MDF(fid=ncid)
- call gather( dgrid(n), skt_daily, glb_sfc4D, 0, status)
- IF_NOTOK_RETURN(status=1)
- if (isRoot) call MDF_Put_Var( ncid, varid_pdif_24h_history, glb_sfc4D, status)
- IF_NOTOK_MDF(fid=ncid)
- else if (pceea) then
- call gather( dgrid(n), skt_daily, glb_sfc3D(:,:,1), 0, status)
- IF_NOTOK_RETURN(status=1)
- if (isRoot) call MDF_Put_Var( ncid, varid_ssr_daily, glb_sfc3D(:,:,1), status)
- IF_NOTOK_MDF(fid=ncid)
- call gather( dgrid(n), skt_daily, glb_sfc3D(:,:,1:ndays_history), 0, status)
- IF_NOTOK_RETURN(status=1)
- if (isRoot) call MDF_Put_Var( ncid, varid_ssr_10d_history, glb_sfc3D(:,:,1:ndays_history), status)
- IF_NOTOK_MDF(fid=ncid)
- endif
- !
- endif
- #endif
- #ifdef with_online_nox
- if (pulsing_on .and. (n == 1) ) then
- ! precipitation history and pulsing parameters; write only once
- call gather( dgrid(n), skt_daily, glb_sfc3D(:,:,1), 0, status)
- IF_NOTOK_RETURN(status=1)
- if (isRoot) call MDF_Put_Var( ncid, varid_cp_daily, glb_sfc3D(:,:,1), status)
- IF_NOTOK_MDF(fid=ncid)
- call gather( dgrid(n), skt_daily, glb_sfc3D(:,:,1), 0, status)
- IF_NOTOK_RETURN(status=1)
- if (isRoot) call MDF_Put_Var( ncid, varid_lsp_daily, glb_sfc3D(:,:,1), status)
- IF_NOTOK_MDF(fid=ncid)
- call gather( dgrid(n), skt_daily, glb_sfc3D(:,:,1:ndrydays), 0, status)
- IF_NOTOK_RETURN(status=1)
- if (isRoot) call MDF_Put_Var( ncid, varid_cp_history, glb_sfc3D(:,:,1:ndrydays), status)
- IF_NOTOK_MDF(fid=ncid)
- call gather( dgrid(n), skt_daily, glb_sfc3D(:,:,1:ndrydays), 0, status)
- IF_NOTOK_RETURN(status=1)
- if (isRoot) call MDF_Put_Var( ncid, varid_lsp_history, glb_sfc3D(:,:,1:ndrydays), status)
- IF_NOTOK_MDF(fid=ncid)
- call gather( dgrid(n), skt_daily, glb_sfc3D(:,:,1), 0, status)
- IF_NOTOK_RETURN(status=1)
- if (isRoot) call MDF_Put_Var( ncid, varid_pulsing, glb_sfc3D(:,:,1), status)
- IF_NOTOK_MDF(fid=ncid)
- call gather( dgrid(n), skt_daily, glb_sfc3D(:,:,1), 0, status)
- IF_NOTOK_RETURN(status=1)
- if (isRoot) call MDF_Put_Var( ncid, varid_plsday, glb_sfc3D(:,:,1), status)
- IF_NOTOK_MDF(fid=ncid)
- call gather( dgrid(n), skt_daily, glb_sfc3D(:,:,1), 0, status)
- IF_NOTOK_RETURN(status=1)
- if (isRoot) call MDF_Put_Var( ncid, varid_plsdurat, glb_sfc3D(:,:,1), status)
- IF_NOTOK_MDF(fid=ncid)
- endif
- #endif
- #ifdef with_m7
- #ifndef without_chemistry
- do imode=1,nsol
- call gather( dgrid(n), h2o_mode(n,imode)%d3, arr4d(:,:,:,imode), h2o_mode(n,imode)%halo, status)
- IF_NOTOK_RETURN(status=1)
- enddo
- if (isRoot) call MDF_Put_Var( ncid, varid_h2o, arr4d(:,:,:,1:nsol), status)
- IF_NOTOK_MDF(fid=ncid)
- do imode=1,nsol
- call gather( dgrid(n), rwd_mode(n,imode)%d3, arr4d(:,:,:,imode), rwd_mode(n,imode)%halo, status)
- IF_NOTOK_RETURN(status=1)
- enddo
- if (isRoot) call MDF_Put_Var( ncid, varid_rwd, arr4d(:,:,:,1:nsol), status)
- IF_NOTOK_MDF(fid=ncid)
- do imode=1,nmod
- call gather( dgrid(n), rw_mode(n,imode)%d3, arr4d(:,:,:,imode), rw_mode(n,imode)%halo, status)
- IF_NOTOK_RETURN(status=1)
- enddo
- if (isRoot) call MDF_Put_Var( ncid, varid_rw, arr4d(:,:,:,1:nmod), status)
- IF_NOTOK_MDF(fid=ncid)
- #endif
- #endif
- ! Done
- if (isRoot) call MDF_Close( ncid, status )
- IF_NOTOK_RETURN(status=1)
- deallocate(arr4d, arr3d)
- #if defined(with_online_bvoc) || defined(with_online_nox)
- deallocate(glb_sfc3D, glb_sfc4D)
- #endif
- end do REG
- status = 0
- END SUBROUTINE RESTART_WRITE
- !EOC
-
- !--------------------------------------------------------------------------
- ! TM5 !
- !--------------------------------------------------------------------------
- !BOP
- !
- ! !IROUTINE: RESTART_READ
- !
- ! !DESCRIPTION: Read restart file. Case of istart=33 (can read any of the
- ! available variables) or 32 (can read only tracer mass).
- !\\
- !\\
- ! !INTERFACE:
- !
- SUBROUTINE RESTART_READ( status, region, &
- surface_pressure, pressure, air_mass, surface_fluxes, &
- tracer_mass, tendencies, megan_history, nox_pulsing )
- !
- ! !USES:
- !
- use GO, only : TrcFile, Init, Done, ReadRc
- use GO, only : goMatchValue
- use dims, only : nregions, im, jm, istart, idate, idatei
- use dims, only : iglbsfc
- use grid, only : TllGridInfo, TLevelInfo, Init, Done, Fill3D
- use chem_param, only : ntracet, ntrace_chem, ntrace, ich4
- use chem_param, only : names, tracer_name_len
- use partools, only : isRoot, par_broadcast
- use tm5_distgrid, only : dgrid, gather, scatter
- use global_data, only : rcfile, mass_dat, chem_dat
- #ifdef with_online_bvoc
- use emission_bvoc_data, only : megan, pceea
- use emission_bvoc_data, only : ndays_history, nhours_history, n_layers
- use emission_bvoc_data, only : skt_daily, pdir_daily, pdif_daily, ssr_daily
- use emission_bvoc_data, only : skt_10d_history, pdir_10d_history, pdif_10d_history, ssr_10d_history
- use emission_bvoc_data, only : skt_hourly, pdir_hourly, pdif_hourly
- use emission_bvoc_data, only : skt_24h_history, pdir_24h_history, pdif_24h_history
- use chem_param, only : iisop
- use partools, only : tracer_active
- #endif
- #ifdef with_online_nox
- use online_nox_data, only : ndrydays
- use online_nox_data, only : cp_daily, lsp_daily
- use online_nox_data, only : cp_history, lsp_history
- use online_nox_data, only : pulsing_field, plsday_field, plsdurat_field
- ! use partools, only : root_k
- #endif
- #ifdef with_m7
- use mo_aero_m7, only : nsol, nmod
- use m7_data, only : h2o_mode, rw_mode, rwd_mode
- #endif
- use meteodata, only : levi, global_lli, sp_dat, phlb_dat, m_dat
- !use meteodata, only : slhf_dat, sshf_dat
- use MDF, only : MDF_Open, MDF_Close, MDF_Inquire_Dimension
- use MDF, only : MDF_Inq_VarID, MDF_Inquire_Variable, MDF_Inq_DimID
- use MDf, only : MDF_Var_Par_Access, MDF_INDEPENDENT, MDF_COLLECTIVE
- use MDF, only : MDF_Get_Att, MDF_Get_Var
- use MDF, only : MDF_READ, MDF_NETCDF4
- !
- ! !OUTPUT PARAMETERS:
- !
- integer, intent(out) :: status
- !
- ! !INPUT PARAMETERS:
- !
- integer, intent(in), optional :: region
- logical, intent(in), optional :: surface_pressure, pressure, air_mass, surface_fluxes
- logical, intent(in), optional :: tracer_mass, tendencies, megan_history, nox_pulsing
- !
- ! !REVISION HISTORY:
- ! 8 Apr 2011 - P. Le Sager - use IF_NOTOK_MDF macro
- ! 28 Apr 2011 - P. Le Sager - Check on tracer availability in restart file.
- ! - Allows for more tracers in restart file than needed
- ! 10 May 2011 - P. Le Sager - Added deallocate statement to work with zoom regions
- ! 16 Mar 2012 - P. Le Sager - adapted for lon-lat MPI domain decomposition
- !
- ! !REMARKS:
- ! - If we need to remap, then meteo is not read from restart.
- ! Airmass is still read but only to convert tracer masses to mixing ratios.
- ! And istart should be 32.
- ! - Serial reading not tested for cases: with_online_nox and with_online_bvoc (February 19, 2018)
- !
- !EOP
- !------------------------------------------------------------------------
- !BOC
- character(len=*), parameter :: rname = mname//'/Restart_Read'
- character(len=tracer_name_len), allocatable :: values_names(:)
- character(len=256) :: rs_read_dir, fname
- type(TrcFile) :: rcF
- logical :: exist
- logical :: do_sp, do_ph, do_m, do_sflux, do_rm, do_megan, do_pulse
- integer :: imr, jmr, lmr, imr_restart, jmr_restart, lmr_restart
- integer :: n, region1, region2
- integer :: ncid
- integer :: varid_sp, varid_ph, varid_m, varid_rm, varid_rmc, varid_names
- !integer :: varid_slhf, varid_sshf
- integer :: itr, itr_file
- integer :: ntracet_restart, dimid
- integer :: shp(2)
- #ifdef slopes
- integer :: varid_rxm, varid_rym, varid_rzm
- #endif
-
- #ifdef with_online_bvoc
- integer :: varid_skt_daily, varid_pdir_daily, varid_pdif_daily, varid_ssr_daily
- integer :: varid_skt_10d_history, varid_pdir_10d_history, varid_pdif_10d_history, varid_ssr_10d_history
- integer :: varid_skt_hourly, varid_pdir_hourly, varid_pdif_hourly
- integer :: varid_skt_24h_history, varid_pdir_24h_history, varid_pdif_24h_history
- #endif
- #ifdef with_online_nox
- integer :: varid_cp_daily, varid_lsp_daily
- integer :: varid_cp_history, varid_lsp_history
- integer :: varid_pulsing, varid_plsday, varid_plsdurat
- #endif
- #ifdef with_m7
- integer :: varid_h2o, varid_rw, varid_rwd !! , varid_ini_gph
- integer :: imode, mxmode
- character(len=3), parameter :: h2o_name = 'h2o'
- character(len=3), parameter :: rwd_name = 'rwd'
- character(len=2), parameter :: rw_name = 'rw'
- real, allocatable :: tmp4d(:,:,:,:)
- real, allocatable :: src_glb_4d(:,:,:,:)
- #endif
- ! global work arrays to read data
- real, allocatable :: tmp3d(:,:,:), airmass(:,:,:), run_airmass(:,:,:)
- real, allocatable :: rmt(:,:,:,:),rms(:,:,:,:), rmx(:,:,:,:),rmy(:,:,:,:), rmz(:,:,:,:)
- #if defined(with_online_bvoc) || defined(with_online_nox)
- real, allocatable :: glb_sfc3D(:,:,:), glb_sfc4D(:,:,:,:)
- integer :: n360, n180
- #endif
- ! for remapping:
- logical :: need_vremap, need_hremap, need_remap
- integer :: varid_at, varid_bt
- real :: dx, dy
- real :: factor_ch4
- real, allocatable :: sp_gbl(:,:,:)
- real, allocatable :: at_restart(:), bt_restart(:)
- real, allocatable :: src_glb(:,:,:)
- type(TllGridInfo) :: lli_restart
- type(TLevelInfo) :: levi_restart
- ! --- begin --------------------------------
-
- if ( istart /= 33 .and. istart /= 32 ) then
- write (gol,'(" skip read restart; istart not 33 or 32 but ",i2)') istart; call goPr
- status=0; return
- endif
-
- if ( any( idate /= idatei ) ) then
- write (gol,'(" skip read restart; idate not idatei but ",i4,5i2.2)') idate; call goPr
- status=0; return
- endif
- ! input directory:
- call Init( rcF, rcfile, status )
- IF_NOTOK_RETURN(status=1)
- call ReadRc( rcF, 'restart.read.dir', rs_read_dir, status )
- IF_NOTOK_RETURN(status=1)
- call ReadRc( rcF, 'restart.factor.ch4', factor_ch4, status, default = 1.0 )
- IF_ERROR_RETURN(status=1)
- call Done( rcF, status )
- IF_NOTOK_RETURN(status=1)
- ! region range:
- if ( present(region) ) then
- region1 = region
- region2 = region
- else
- region1 = 1
- region2 = nregions
- end if
- ! data sets:
- do_rm = .false. ; if ( present(tracer_mass ) ) do_rm = tracer_mass
- do_m = .false. ; if ( present(air_mass ).and.(istart==33) ) do_m = air_mass
- do_sp = .false. ; if ( present(surface_pressure ).and.(istart==33) ) do_sp = surface_pressure
- do_ph = .false. ; if ( present(pressure ).and.(istart==33) ) do_ph = pressure
- do_sflux = .false. ; if ( present(surface_fluxes ).and.(istart==33) ) do_sflux = surface_fluxes
- do_megan = .false. ; if ( present(megan_history ).and.(istart==33) ) do_megan = megan_history
- do_pulse = .false. ; if ( present(nox_pulsing ).and.(istart==33) ) do_pulse = nox_pulsing
- ! sorry ..
- if ( do_sflux ) then
- write (gol,'("no surface fluxes in restart files until somebody")') ; call goErr
- write (gol,'("has a good idea on what should be storred:")') ; call goErr
- write (gol,'(" o global surface field (1x1 ?)")') ; call goErr
- write (gol,'(" o zoom regions")') ; call goErr
- write (gol,'(" o both")') ; call goErr
- TRACEBACK; status=1; return
- end if
- ! do we need anything?
- if(.not.(do_rm.or.do_m.or.do_sp.or.do_ph.or.do_sflux.or.do_megan.or.do_pulse))then
- status=0; return
- endif
-
- #ifdef with_m7
- mxmode = max(nsol, nmod)
- #endif
-
- REG: do n = region1, region2
- imr = global_lli(n)%nlon
- jmr = global_lli(n)%nlat
- lmr = levi%nlev
-
- ! name of restart file
- call Restart_FileName( n, fname, status, dir=trim(rs_read_dir) )
- IF_NOTOK_RETURN(status=1)
- write (gol,'(" read restart file: ",a)') trim(fname); call goPr
- inquire( file=fname, exist=exist )
- if ( .not. exist ) then
- write (gol,'("restart file not found : ",a)') trim(fname); call goErr
- TRACEBACK; status=1; return
- end if
- ! ** open netcdf file
- if (isRoot) then
- call MDF_Open( trim(fname), MDF_NETCDF4, MDF_READ, ncid, status )
- IF_NOTOK_RETURN(status=1)
- ! ** check for dimension compatibility
- call MDF_Inq_DimID( ncid, 'lev', dimid, status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Inquire_Dimension( ncid, dimid, status, length=lmr_restart )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Inq_DimID( ncid, 'lat', dimid, status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Inquire_Dimension( ncid, dimid, status, length=jmr_restart )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Inq_DimID( ncid, 'lon', dimid, status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Inquire_Dimension( ncid, dimid, status, length=imr_restart )
- IF_NOTOK_MDF(fid=ncid)
- need_vremap = (lmr /= lmr_restart)
- need_hremap = (jmr /= jmr_restart) .or. (imr /= imr_restart)
- need_remap = need_hremap .or. need_vremap
- endif
-
- call par_broadcast( need_remap, status)
- IF_NOTOK_RETURN(status=1)
-
- if ((istart /= 32).and.need_remap) then
- status=1
- write(gol,*)' you must use istart=32 for using a restart file at different resolution'
- call goErr
- TRACEBACK; return
- endif
- ! work arrays
- if (isRoot) then
- allocate( rmt(imr,jmr,lmr,ntracet) )
- allocate( rmx(imr,jmr,lmr,ntracet) )
- allocate( rmy(imr,jmr,lmr,ntracet) )
- allocate( rmz(imr,jmr,lmr,ntracet) )
- if ( ntrace_chem > 0 ) allocate( rms(imr,jmr,lmr,ntracet+1:ntracet+ntrace_chem) )
- #ifdef with_m7
- allocate( tmp4d(imr,jmr,lmr, mxmode) )
- #endif
- allocate( tmp3d(imr,jmr,lmr+1 ) )
- allocate( airmass(imr_restart, jmr_restart, lmr_restart) )
- if (istart==32) allocate( run_airmass(imr, jmr, lmr) )
- else
- allocate( rmt(1,1,1,1) )
- allocate( rmx(1,1,1,1) )
- allocate( rmy(1,1,1,1) )
- allocate( rmz(1,1,1,1) )
- if ( ntrace_chem > 0 ) allocate( rms(1,1,1,1) )
- #ifdef with_m7
- allocate( tmp4d(1,1,1,1) )
- #endif
- allocate( airmass(1,1,1) )
- if (istart==32) allocate( run_airmass(1,1,1) )
- allocate( tmp3d(1,1,1) )
- endif
-
- if (istart==32) then
- CALL GATHER( dgrid(n), m_dat(n)%data, run_airmass, m_dat(n)%halo, status )
- IF_NOTOK_RETURN(status=1)
- endif
- ! get extra work arrays for 1x1 dataset
- #if defined(with_online_bvoc) || defined(with_online_nox)
- if(n==region1) then
- n360 = dgrid(iglbsfc)%im_region
- n180 = dgrid(iglbsfc)%jm_region
- if (isRoot) then
- allocate( glb_sfc3d(n360, n180, max(ndays_history, n_layers, ndrydays, nhours_history ) )
- allocate( glb_sfc4d(n360, n180, n_layers, ndays_history) )
- else
- allocate( glb_sfc3d(1,1,1) )
- allocate( glb_sfc4d(1,1,1,1) )
- endif
- end if
- #endif
-
- ! prepare for remap
- if (need_remap .and. do_rm) then
- write (gol,'(" remap tracer from restart file")') ; call goPr
-
- if (isRoot) then
- allocate( sp_gbl(imr,jmr,1) )
- allocate( src_glb(imr_restart,jmr_restart,lmr_restart))
- #ifdef with_m7
- allocate(src_glb_4d(imr_restart,jmr_restart,lmr_restart,mxmode))
- #endif
- else
- allocate(sp_gbl(1,1,1))
- allocate(src_glb(1,1,1))
- #ifdef with_m7
- allocate(src_glb_4d(1,1,1,1))
- #endif
- endif
- call gather( dgrid(n), sp_dat(n)%data, sp_gbl, sp_dat(n)%halo, status)
- IF_NOTOK_RETURN(status=1)
- ! init to 0 in case of data not found in file
- rmt=0.
- rms=0.
- ! init lli_restart/levi_restart
- if (isRoot) then
- allocate(at_restart(lmr_restart+1))
- allocate(bt_restart(lmr_restart+1))
- !
- call MDF_Inq_VarID( ncid, 'at', varid_at, status )
- IF_NOTOK_MDF(fid=ncid)
- !
- call MDF_Get_Var( ncid, varid_at, at_restart(1:(lmr_restart+1)), status )
- IF_NOTOK_MDF(fid=ncid)
- !
- call MDF_Inq_VarID( ncid, 'bt', varid_bt, status )
- IF_NOTOK_MDF(fid=ncid)
- !
- call MDF_Get_Var( ncid, varid_bt, bt_restart(1:(lmr_restart+1)), status )
- IF_NOTOK_MDF(fid=ncid)
- !
- call Init( levi_restart, lmr_restart, at_restart, bt_restart, status )
- IF_NOTOK_RETURN(status=1)
- !
- deallocate(at_restart,bt_restart)
- !
- dx=360./imr_restart
- dy=180./jmr_restart
- call Init( lli_restart, -180.+0.5*dx, dx, imr_restart, &
- -90.+0.5*dy, dy, jmr_restart, status )
- IF_NOTOK_RETURN(status=1)
- endif
- endif
-
- ! ** get variables id
- if (isRoot) then
- ! surface pressure
- if ( do_sp ) call MDF_Inq_VarID( ncid, 'sp', varid_sp, status )
- IF_NOTOK_MDF(fid=ncid)
- ! half level pressure
- if ( do_ph ) call MDF_Inq_VarID( ncid, 'ph', varid_ph, status )
- IF_NOTOK_MDF(fid=ncid)
- ! air mass
- call MDF_Inq_VarID( ncid, 'm', varid_m, status )
- IF_NOTOK_MDF(fid=ncid)
- !! surface fluxes
- !if ( do_sflux ) then
- !end if
- ! tracer mass
- if ( do_rm ) then
- call MDF_Inq_VarID( ncid, 'names', varid_names, status )
- if ( status /= 0 ) then
- write (gol,'("could not find variable `names` in restart file;")'); call goErr
- write (gol,'(" using an old restart file to initialize the model ?")'); call goErr
- status=1
- end if
- IF_NOTOK_MDF(fid=ncid)
- ! get dimension of "names"
- call MDF_Inquire_Variable( ncid, varid_names, status, shp=shp )
- IF_NOTOK_MDF(fid=ncid)
- ! get number of transported tracer in restart file
- call MDF_Inq_DimID( ncid, 'trace_transp', dimid, status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Inquire_Dimension( ncid, dimid, status, length=ntracet_restart )
- IF_NOTOK_MDF(fid=ncid)
- ! tracers mass id
- call MDF_Inq_VarID( ncid, 'rm', varid_rm, status )
- IF_NOTOK_MDF(fid=ncid)
- #ifdef slopes
- call MDF_Inq_VarID( ncid, 'rxm', varid_rxm, status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Inq_VarID( ncid, 'rym', varid_rym, status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Inq_VarID( ncid, 'rzm', varid_rzm, status )
- IF_NOTOK_MDF(fid=ncid)
- #endif
- ! read non-transported tracers if any
- if ( ntrace_chem > 0 ) then
- call MDF_Inq_VarID( ncid, 'rmc', varid_rmc, status )
- IF_NOTOK_MDF(fid=ncid)
- end if
- end if
- #ifdef with_online_bvoc
- ! MEGAN/PCEEA history records; only once is ok
- if ( do_megan .and. (n==region1) ) then
- call MDF_Inq_VarID( ncid, 'skt_daily' , varid_skt_daily , status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Inq_VarID( ncid, 'skt_10d_history' , varid_skt_10d_history , status )
- IF_NOTOK_MDF(fid=ncid)
- if (megan) then
- call MDF_Inq_VarID( ncid, 'pdir_daily' , varid_pdir_daily , status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Inq_VarID( ncid, 'pdir_10d_history' , varid_pdir_10d_history , status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Inq_VarID( ncid, 'pdif_daily' , varid_pdif_daily , status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Inq_VarID( ncid, 'pdif_10d_history' , varid_pdif_10d_history , status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Inq_VarID( ncid, 'skt_hourly' , varid_skt_hourly , status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Inq_VarID( ncid, 'skt_24h_history' , varid_skt_24h_history , status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Inq_VarID( ncid, 'pdir_hourly' , varid_pdir_hourly , status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Inq_VarID( ncid, 'pdir_24h_history' , varid_pdir_24h_history , status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Inq_VarID( ncid, 'pdif_hourly' , varid_pdif_hourly , status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Inq_VarID( ncid, 'pdif_24h_history' , varid_pdif_24h_history , status )
- IF_NOTOK_MDF(fid=ncid)
- else if (pceea) then
- call MDF_Inq_VarID( ncid, 'ssr_daily' , varid_ssr_daily , status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Inq_VarID( ncid, 'ssr_10d_history' , varid_ssr_10d_history , status )
- IF_NOTOK_MDF(fid=ncid)
- endif
- end if
- #endif
-
- #ifdef with_online_nox
- ! precipitation history and pulsing parameters; only once is ok
- if ( do_pulse .and. (n==region1) ) then
- call MDF_Inq_VarID( ncid, 'cp_daily' , varid_cp_daily, status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Inq_VarID( ncid, 'lsp_daily' , varid_lsp_daily, status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Inq_VarID( ncid, 'cp_history' , varid_cp_history, status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Inq_VarID( ncid, 'lsp_history', varid_lsp_history, status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Inq_VarID( ncid, 'pulsing' , varid_pulsing, status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Inq_VarID( ncid, 'plsday' , varid_plsday, status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Inq_VarID( ncid, 'plsdurat' , varid_plsdurat, status )
- IF_NOTOK_MDF(fid=ncid)
- end if
- #endif
- #ifdef with_m7
- #ifndef without_chemistry
- if (do_rm) then
- ! M7 fields for optics
- call MDF_Inq_VarID( ncid, trim(h2o_name) , varid_h2o, status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Inq_VarID( ncid, trim(rwd_name) , varid_rwd, status )
- IF_NOTOK_MDF(fid=ncid)
- call MDF_Inq_VarID( ncid, trim(rw_name ) , varid_rw, status )
- IF_NOTOK_MDF(fid=ncid)
- end if
- #endif
- #endif
- end if
-
- ! *** READ VARIABLES ***
- if ( do_sp ) then
- write (gol,'(" restore surface pressure ...")'); call goPr
-
- if (isRoot) call MDF_Get_Var( ncid, varid_sp, tmp3d(:,:,1), status )
- IF_NOTOK_MDF(fid=ncid)
-
- call scatter( dgrid(n), sp_dat(n)%data, tmp3d(:,:,1:1), sp_dat(n)%halo, status)
- IF_NOTOK_RETURN(status=1)
-
- end if
- if ( do_ph ) then
- write (gol,'(" restore half level pressure ...")'); call goPr
-
- if (isRoot) call MDF_Get_Var( ncid, varid_ph, tmp3d, status)
- IF_NOTOK_MDF(fid=ncid)
-
- call scatter( dgrid(n), phlb_dat(n)%data, tmp3d, phlb_dat(n)%halo, status)
- IF_NOTOK_RETURN(status=1)
- end if
-
- ! get air mass in all cases
- if (isRoot) call MDF_Get_Var( ncid, varid_m, airmass, status)
- IF_NOTOK_MDF(fid=ncid)
- if ( do_m ) then
- write (gol,'(" restore air mass ...")'); call goPr
-
- call scatter( dgrid(n), m_dat(n)%data, airmass, m_dat(n)%halo, status)
- IF_NOTOK_RETURN(status=1)
- end if
- !! surface fluxes
- !if ( do_sflux ) then
- !end if
- ! tracer mass
- READRM: if ( do_rm ) then
- write (gol,'(" restore tracer mass ...")'); call goPr
- ! read list with tracer names in rcfile
- allocate( values_names(shp(2)) )
- if (isRoot) call MDF_Get_Var( ncid, varid_names, values_names, status )
- IF_NOTOK_MDF(fid=ncid)
- ! loop over all model tracers
- do itr = 1, ntrace
-
- if (isRoot) then
- ! search in list:
- call goMatchValue( names(itr), values_names, itr_file, status )
- if ( status < 0 ) then
- write(gol,'("*WARNING* Requested tracer `",a,"` not FOUND in restart file!")') trim(names(itr))
- if (istart /= 32) then
- call goErr
- IF_NOTOK_MDF(fid=ncid)
- else
- status=0
- call goPr
- if ( itr <= ntracet ) then
- rmt(:,:,:,itr) = 1.e-30
- write(gol,'("*WARNING* Requested TRANSPORTED tracer `",a,"` has been SET to a default value of 1.e-30")') trim(names(itr))
- else
- rms(:,:,:,itr) = 1.e-30
- write(gol,'("*WARNING* Requested SHORT-LIVED tracer `",a,"` has been SET to a default value of 1.e-30")') trim(names(itr))
- endif
- call goPr
- endif
- else
- ! transported or short lived tracer ?
- if ( itr <= ntracet ) then
- if ( itr_file > ntracet_restart ) then
- write (gol,'("tracer `",a,"` is transported but seems to be not-transported in restart file")') trim(names(itr)); call goErr
- status=1
- IF_NOTOK_MDF(fid=ncid)
- end if
-
- if (need_remap) then
- call MDF_Get_Var( ncid, varid_rm, src_glb, status, start=(/1,1,1,itr_file/))
- IF_NOTOK_MDF(fid=ncid)
-
- src_glb = src_glb / airmass
-
- call Fill3D( global_lli(n), levi, 'n', sp_gbl(:,:,1), rmt(:,:,:,itr), &
- lli_restart, levi_restart, src_glb, 'mass-aver', status )
- IF_NOTOK_RETURN(status=1)
-
- rmt(:,:,:,itr) = rmt(:,:,:,itr) * run_airmass
-
- else
- call MDF_Get_Var( ncid, varid_rm, rmt(:,:,:,itr), status, start=(/1,1,1,itr_file/))
- IF_NOTOK_MDF(fid=ncid)
- if (istart==32) then
- rmt(:,:,:,itr) = rmt(:,:,:,itr) * run_airmass / airmass
- endif
- endif
-
- ! Scale methane concentrations by a factor specified in the rc file
- if ( (factor_ch4 /= 1.) .and. (itr == ich4) ) then
- write(gol,*) '*WARNING*: CH4 mixing ratio and slopes from restart file'; call goPr
- write(gol,*) '*WARNING*: ... scaled by a factor: ', factor_ch4; call goPr
- rmt(:,:,:,itr) = rmt(:,:,:,itr) * factor_ch4
- endif
- #ifdef slopes
- ! read slopes
- if ((.not. need_remap) .and. (istart==33)) then
- if (isRoot) call MDF_Get_Var( ncid, varid_rxm, rmx(:,:,:,itr), status, start=(/1,1,1,itr_file/))
- IF_NOTOK_MDF(fid=ncid)
- if (isRoot) call MDF_Get_Var( ncid, varid_rym, rmy(:,:,:,itr), status, start=(/1,1,1,itr_file/))
- IF_NOTOK_MDF(fid=ncid)
- if (isRoot) call MDF_Get_Var( ncid, varid_rzm, rmz(:,:,:,itr), status, start=(/1,1,1,itr_file/))
- IF_NOTOK_MDF(fid=ncid)
-
- ! Scale methane concentration slopes by a factor specified in the rc file
- if ( (factor_ch4 /= 1.) .and. (itr == ich4) ) then
- mass_dat(n)%rxm(:,:,:,itr)= mass_dat(n)%rxm(:,:,:,itr) * factor_ch4
- mass_dat(n)%rym(:,:,:,itr)= mass_dat(n)%rym(:,:,:,itr) * factor_ch4
- mass_dat(n)%rzm(:,:,:,itr)= mass_dat(n)%rzm(:,:,:,itr) * factor_ch4
- endif
- endif
- #endif
- else ! short lived tracer:
- if ( itr_file <= ntracet_restart ) then
- write (gol,'("tracer `",a,"` is not-transported but seems to be transported in restart file")') trim(names(itr)); call goErr
- status=1
- IF_NOTOK_MDF(fid=ncid)
- end if
- itr_file = itr_file - ntracet_restart
- if (need_remap) then
- call MDF_Get_Var( ncid, varid_rmc, src_glb, status, start=(/1,1,1,itr_file/) )
- IF_NOTOK_MDF(fid=ncid)
-
- src_glb = src_glb / airmass
-
- call Fill3D( global_lli(n), levi, 'n', sp_gbl(:,:,1), rms(:,:,:,itr), &
- lli_restart, levi_restart, src_glb, 'mass-aver', status )
- IF_NOTOK_RETURN(status=1)
- rms(:,:,:,itr) = rms(:,:,:,itr) * run_airmass
-
- else
- call MDF_Get_Var( ncid, varid_rmc, rms(:,:,:,itr), status, start=(/1,1,1,itr_file/) )
- IF_NOTOK_MDF(fid=ncid)
- if (istart==32) then
- rms(:,:,:,itr) = rms(:,:,:,itr) * run_airmass / airmass
- endif
- endif
-
- end if ! transported or short-lived
- endif ! in the file
- endif ! root
- end do ! tracers
-
- ! distribute
- call scatter( dgrid(n), mass_dat(n)%rm, rmt, mass_dat(n)%halo, status)
- IF_NOTOK_RETURN(status=1)
- if ( ntrace_chem > 0 ) then
- call scatter( dgrid(n), chem_dat(n)%rm, rms, chem_dat(n)%halo, status)
- IF_NOTOK_RETURN(status=1)
- endif
-
- #ifdef slopes
- if ((.not. need_remap).and.(istart==33)) then
- call scatter( dgrid(n), mass_dat(n)%rxm, rmx, mass_dat(n)%halo, status)
- IF_NOTOK_RETURN(status=1)
- call scatter( dgrid(n), mass_dat(n)%rym, rmy, mass_dat(n)%halo, status)
- IF_NOTOK_RETURN(status=1)
- call scatter( dgrid(n), mass_dat(n)%rzm, rmz, mass_dat(n)%halo, status)
- IF_NOTOK_RETURN(status=1)
- else
- ! Ensure that slopes are initialized to "unset" values of 0.0. Wouter says that
- ! we could remap levels for rxm et al., but 0.0 will also work. The noise
- ! induced from remapping the rm array is almost certainly bigger than any issues
- ! from having this "default=0.0" slopes information. -ARJ 1 Jan 12
- mass_dat(n)%rxm = 0.0
- mass_dat(n)%rym = 0.0
- mass_dat(n)%rzm = 0.0
- endif
- #endif
- ENDIF READRM
-
- ! clean "READRM"
- deallocate(rmt)
- if ( ntrace_chem > 0 ) deallocate(rms)
- #ifdef slopes
- deallocate(rmx, rmy, rmz)
- #endif
- #ifdef with_online_bvoc
- ! MEGAN/PCEEA history records; read only once
- if ( do_megan .and. (n==region1) ) then
- if (isRoot) call MDF_Get_Var( ncid, varid_skt_daily, glb_sfc3d(:,:,1), status)
- IF_NOTOK_MDF(fid=ncid)
- call scatter( dgrid(n), skt_daily, glb_sfc3d(:,:,1), 0, status)
-
- if (isRoot) call MDF_Get_Var( ncid, varid_skt_10d_history, glb_sfc3d(:,:, 1:ndays_history), status)
- IF_NOTOK_MDF(fid=ncid)
- call scatter( dgrid(n), skt_10d_history(:,:, 1:ndays_history), glb_sfc3d(:,:, 1:ndays_history), 0, status)
- if (megan) then
- write (gol,'(" restore MEGAN history parameters ...")'); call goPr
- if (isRoot) call MDF_Get_Var( ncid, varid_pdir_daily, glb_sfc3d(:,:,1), status)
- IF_NOTOK_MDF(fid=ncid)
- call scatter( dgrid(n), pdir_daily, glb_sfc3d(:,:,1), 0, status)
- IF_NOTOK_RETURN(status=1)
-
- if (isRoot) call MDF_Get_Var( ncid, varid_pdir_10d_history, glb_sfc3d(:,:, 1:ndays_history), status)
- IF_NOTOK_MDF(fid=ncid)
- call scatter( dgrid(n), pdir_10d_history(:,:, 1:ndays_history), glb_sfc3d(:,:, 1:ndays_history), 0, status)
- IF_NOTOK_RETURN(status=1)
-
- if (isRoot) call MDF_Get_Var( ncid, varid_pdif_daily, glb_sfc3d (:,:,1:n_layers), status)
- IF_NOTOK_MDF(fid=ncid)
- call scatter( dgrid(n), pdif_daily, glb_sfc3d(:,:,1:n_layers), 0, status)
- IF_NOTOK_RETURN(status=1)
- if (isRoot) call MDF_Get_Var( ncid, varid_pdif_10d_history, glb_sfc4D, status)
- IF_NOTOK_MDF(fid=ncid)
- call scatter( dgrid(n), pdif_10d_history, glb_sfc4D, 0, status)
- IF_NOTOK_RETURN(status=1)
-
- if (isRoot) call MDF_Get_Var( ncid, varid_skt_hourly, glb_sfc3d(:,:,1), status)
- IF_NOTOK_MDF(fid=ncid)
- call scatter( dgrid(n), skt_hourly, glb_sfc3d(:,:,1), 0, status)
- IF_NOTOK_RETURN(status=1)
-
- if (isRoot) call MDF_Get_Var( ncid, varid_skt_24h_history, glb_sfc3d(:,:, 1:nhours_history), status)
- IF_NOTOK_MDF(fid=ncid)
- call scatter( dgrid(n), skt_24h_history, glb_sfc3d(:,:,1:nhours_history), 0, status)
- IF_NOTOK_RETURN(status=1)
-
- if (isRoot) call MDF_Get_Var( ncid, varid_pdir_hourly, glb_sfc3d(:,:,1), status)
- IF_NOTOK_MDF(fid=ncid)
- call scatter( dgrid(n), pdir_hourly, glb_sfc3d(:,:,1), 0, status)
- IF_NOTOK_RETURN(status=1)
-
- if (isRoot) call MDF_Get_Var( ncid, varid_pdir_24h_history, glb_sfc3d(:,:, 1:nhours_history), status)
- IF_NOTOK_MDF(fid=ncid)
- call scatter( dgrid(n), pdir_24h_history, glb_sfc3d(:,:,1:nhours_history), 0, status)
- IF_NOTOK_RETURN(status=1)
-
- if (isRoot) call MDF_Get_Var( ncid, varid_pdif_hourly, glb_sfc3d(:,:, 1:n_layers), status)
- IF_NOTOK_MDF(fid=ncid)
- call scatter( dgrid(n), pdif_hourly, glb_sfc3d(:,:,1), 0, status)
- IF_NOTOK_RETURN(status=1)
-
- if (isRoot) call MDF_Get_Var( ncid, varid_pdif_24h_history, glb_sfc4D, status)
- IF_NOTOK_MDF(fid=ncid)
- call scatter( dgrid(n), pdif_24h_history, glb_sfc4D, 0, status)
- IF_NOTOK_RETURN(status=1)
- else if (pceea) then
- write (gol,'(" restore PCEEA history parameters ...")'); call goPr
- if (isRoot) call MDF_Get_Var( ncid, varid_ssr_daily, glb_sfc3d(:,:,1), status)
- IF_NOTOK_MDF(fid=ncid)
- call scatter( dgrid(n), ssr_daily, glb_sfc3d(:,:,1), 0, status)
- IF_NOTOK_RETURN(status=1)
-
- if (isRoot) call MDF_Get_Var( ncid, varid_ssr_10d_history, ssr_10d_history(:,:, 1:ndays_history), status)
- IF_NOTOK_MDF(fid=ncid)
- call scatter( dgrid(n), ssr_10d_history(:,:, 1:ndays_history), glb_sfc3d(:,:, 1:ndays_history), 0, status)
- IF_NOTOK_RETURN(status=1)
- endif
- end if
- #endif
- #ifdef with_online_nox
- ! precipitation history and pulsing parameters; read only once
- if ( do_pulse .and. (n==region1) ) then
-
- write (gol,'(" restore precipitation history and pulsing parameters ...")'); call goPr
- if (isRoot) call MDF_Get_Var( ncid, varid_cp_daily, glb_sfc3d(:,:,1), status)
- IF_NOTOK_MDF(fid=ncid)
- call scatter( dgrid(n), cp_daily, glb_sfc3d(:,:,1), 0, status)
- IF_NOTOK_RETURN(status=1)
-
- if (isRoot) call MDF_Get_Var( ncid, varid_lsp_daily, glb_sfc3d(:,:,1), status)
- IF_NOTOK_MDF(fid=ncid)
- call scatter( dgrid(n), lsp_daily, glb_sfc3d(:,:,1), 0, status)
- IF_NOTOK_RETURN(status=1)
-
- if (isRoot) call MDF_Get_Var( ncid, varid_cp_history, glb_sfc3d(:,:, 1:ndrydays), status)
- IF_NOTOK_MDF(fid=ncid)
- call scatter( dgrid(n), cp_history(:,:, 1:ndrydays), glb_sfc3d(:,:, 1:ndrydays), 0, status)
- IF_NOTOK_RETURN(status=1)
-
- if (isRoot) call MDF_Get_Var( ncid, varid_lsp_history, glb_sfc3d(:,:, 1:ndrydays), status)
- IF_NOTOK_MDF(fid=ncid)
- call scatter( dgrid(n), lsp_history(:,:, 1:ndrydays), glb_sfc3d(:,:, 1:ndrydays), 0, status)
- IF_NOTOK_RETURN(status=1)
- if (isRoot) call MDF_Get_Var( ncid, varid_pulsing, glb_sfc3d(:,:,1), status)
- IF_NOTOK_MDF(fid=ncid)
- call scatter( dgrid(n), pulsing_field, glb_sfc3d(:,:,1), 0, status)
- IF_NOTOK_RETURN(status=1)
- if (isRoot) call MDF_Get_Var( ncid, varid_plsday, glb_sfc3d(:,:,1), status)
- IF_NOTOK_MDF(fid=ncid)
- call scatter( dgrid(n), plsday_field, glb_sfc3d(:,:,1), 0, status)
- IF_NOTOK_RETURN(status=1)
- if (isRoot) call MDF_Get_Var( ncid, varid_plsdurat, glb_sfc3d(:,:,1), status)
- IF_NOTOK_MDF(fid=ncid)
- call scatter( dgrid(n), plsdurat_field, glb_sfc3d(:,:,1), 0, status)
- IF_NOTOK_RETURN(status=1)
- end if
- #endif
- #ifdef with_m7
-
- if (do_rm) then
- write (gol,'(" restore M7 fields for optics ...")'); call goPr
- ! water: get 4d array
- if (need_remap) then
- if (isRoot) then
- call MDF_Get_Var( ncid, varid_h2o, src_glb_4d(:,:,:,1:nsol), status )
- IF_NOTOK_MDF(fid=ncid)
-
- do imode=1,nsol
- src_glb_4d(:,:,:,imode) = src_glb_4d(:,:,:,imode) / airmass
- call Fill3D( global_lli(n), levi, 'n', sp_gbl(:,:,1), tmp4d(:,:,:,imode), &
- lli_restart, levi_restart, src_glb_4d(:,:,:,imode), 'mass-aver', status )
- IF_NOTOK_RETURN(status=1)
- tmp4d(:,:,:,imode) = tmp4d(:,:,:,imode) * run_airmass
- enddo
- endif
-
- do imode=1,nsol
- call scatter( dgrid(n), h2o_mode(n,imode)%d3, tmp4d(:,:,:,imode), h2o_mode(n,imode)%halo, status)
- enddo
-
- else
- if (isRoot) call MDF_Get_Var( ncid, varid_h2o, tmp4d(:,:,:,1:nsol), status )
- IF_NOTOK_MDF(fid=ncid)
- do imode=1,nsol
-
- if ((istart==32).and.(isRoot)) then
- tmp4d(:,:,:,imode) = tmp4d(:,:,:,imode) * run_airmass / airmass
- endif
-
- call scatter( dgrid(n), h2o_mode(n,imode)%d3, tmp4d(:,:,:,imode), h2o_mode(n,imode)%halo, status)
- end do
- endif
-
- if (need_remap) then
- status=1
- write(gol,*)' remapping not fully implemented yet for M7 radii'
- call goErr
- TRACEBACK; return
- endif
-
- ! dry radii: get 4d array
- if (isRoot) call MDF_Get_Var( ncid, varid_rwd, tmp4d(:,:,:,1:nsol), status)
- IF_NOTOK_MDF(fid=ncid)
-
- do imode=1,nsol
- call scatter( dgrid(n), rwd_mode(n,imode)%d3, tmp4d(:,:,:,imode), rwd_mode(n,imode)%halo, status)
- end do
-
- ! (wet) radii: get 4d array
- if (isRoot) call MDF_Get_Var( ncid, varid_rw, tmp4d(:,:,:,1:nmod), status)
- IF_NOTOK_MDF(fid=ncid)
-
- do imode=1,nmod
- call scatter( dgrid(n), rw_mode(n,imode)%d3, tmp4d(:,:,:,imode), rw_mode(n,imode)%halo, status)
- end do
- end if
-
- #endif /* with_m7 */
- if (isRoot) call MDF_Close( ncid, status )
- IF_NOTOK_RETURN(status=1)
-
- ! free mem for next region
- if (do_rm) deallocate(values_names)
- if (need_remap) then
- deallocate(sp_gbl,src_glb)
- if (isRoot) then
- call Done( levi_restart, status )
- IF_NOTOK_RETURN(status=1)
- call Done( lli_restart, status )
- IF_NOTOK_RETURN(status=1)
- endif
- endif
- deallocate( tmp3d )
- deallocate( airmass)
- if (istart==32) deallocate(run_airmass)
- #if defined(with_online_bvoc) || defined(with_online_nox)
- deallocate(glb_sfc3D, glb_sfc4D)
- #endif
-
- #ifdef with_m7
- deallocate( tmp4d )
- if (need_remap) deallocate(src_glb_4d)
- #endif
- ENDDO REG
- status = 0
- END SUBROUTINE RESTART_READ
- !EOC
- END MODULE RESTART
|