diff --git a/cime_config/buildnml b/cime_config/buildnml index 914b9be7..f8a43852 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -103,11 +103,6 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): #---------------------------------------------------- nmlgen.init_defaults(infile, config) - if case.get_value('MEDIATOR_READ_RESTART'): - nmlgen.set_value('mediator_read_restart', value='.true.') - else: - nmlgen.set_value('mediator_read_restart', value='.false.') - #-------------------------------- # Overwrite: set brnch_retain_casename #-------------------------------- @@ -292,7 +287,7 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): # the driver restart pointer will look like a mediator is present even if it is not nmlgen.set_value("drv_restart_pointer", value="rpointer.cpl") - logger.info("Writing nuopc_runseq for components {}".format(valid_comps)) + logger.info("Writing nuopc_runconfig for components {}".format(valid_comps)) nuopc_config_file = os.path.join(confdir, "nuopc.runconfig") nmlgen.write_nuopc_config_file(nuopc_config_file, data_list_path=data_list_path) diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index ba73c96d..49bc7d0d 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -435,27 +435,6 @@ - - char - 1 - run_begin_stop_restart - env_run.xml - - Sets periodic model barriers with BARRIER_OPTION and BARRIER_DATE for synchronization - - - - - char - -999 - run_begin_stop_restart - env_run.xml - - Alternative date in yyyymmdd format - sets periodic model barriers with BARRIER_OPTION and BARRIER_N for synchronization - - - logical TRUE,FALSE @@ -841,6 +820,21 @@ machines. + + logical + TRUE,FALSE + FALSE + build_component_clm + env_build.xml + TRUE implies CLM is built with support for the PETSc + library. The Variably Saturated Flow Model (VSFM) solver in CLM + uses the PETSc library. In order to use the VSFM solver, CLM + must be built with PETSc support and linking to PETSc must occur + when building the ACME executable. This occurs if this variable + is set to TRUE. Note that is only available on a limited set of + machines/compilers. + + logical TRUE,FALSE @@ -2294,10 +2288,6 @@ standard full pathname of the cprnc executable - - - - logical TRUE,FALSE @@ -2307,38 +2297,6 @@ determine if per ice thickness category fields are passed from ice to ocean - DO NOT EDIT (set by POP build-namelist) - - - - - - char - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,nmonths,nmonth,nyears,nyear,end - never - run_drv_history - env_run.xml - Sets driver snapshot history file frequency (like REST_OPTION) - - - - integer - - -999 - run_drv_history - env_run.xml - Sets driver snapshot history file frequency (like REST_N) - - - - - integer - - -999 - run_drv_history - env_run.xml - yyyymmdd format, sets coupler snapshot history date (like REST_DATE) - - integer 0,1,2,3,4,5,6,7,8,9 @@ -2348,22 +2306,6 @@ level of debug output, 0=minimum, 1=normal, 2=more, 3=too much - - logical - TRUE,FALSE - FALSE - build_component_clm - env_build.xml - TRUE implies CLM is built with support for the PETSc - library. The Variably Saturated Flow Model (VSFM) solver in CLM - uses the PETSc library. In order to use the VSFM solver, CLM - must be built with PETSc support and linking to PETSc must occur - when building the ACME executable. This occurs if this variable - is set to TRUE. Note that is only available on a limited set of - machines/compilers. - - - @@ -2541,6 +2483,21 @@ add aoflux calculation to runseq + + + + + + + logical + TRUE,FALSE + FALSE + run_flags + env_run.xml + turns on coupler bit-for-bit reproducibility with varying pe counts + + + ========================================= Notes: diff --git a/cime_config/config_component_cesm.xml b/cime_config/config_component_cesm.xml index cf94f9ea..ba4bb69c 100644 --- a/cime_config/config_component_cesm.xml +++ b/cime_config/config_component_cesm.xml @@ -18,10 +18,14 @@ Historic transient Twentieth century transient - CMIP5 rcp 2.6 forcing - CMIP5 rcp 4.5 forcing - CMIP5 rcp 6.0 forcing - CMIP5 rcp 8.5 forcing + CMIP6 SSP1-1.9 forcing + CMIP6 SSP1-2.6 forcing + CMIP6 SSP2-4.5 forcing + CMIP6 SSP3-7.0 forcing + CMIP6 SSP4-3.4 forcing + CMIP6 SSP4-6.0 forcing + CMIP6 SSP5-3.4 forcing + CMIP6 SSP5-8.5 forcing Biogeochemistry intercomponent with diagnostic CO2 with prognostic CO2 @@ -96,29 +100,6 @@ We will not document this further in this guide. - - logical - TRUE,FALSE - FALSE - run_flags - env_run.xml - turns on coupler bit-for-bit reproducibility with varying pe counts - - - - char - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,nmonths,nmonth,nyears,nyear,date,ifdays0,end - never - - ndays - - run_begin_stop_restart - env_run.xml - - sets frequency of full model barrier (same options as STOP_OPTION) for synchronization with BARRIER_N and BARRIER_DATE - - - char none,CO2A,CO2B,CO2C @@ -191,23 +172,39 @@ 144 288 288 - 72 - 48 - - - 24 - 24 - 24 - 24 - - - - - 24 - 24 - 48 - 48 - 1 + + + + 48 + 48 + 48 + 24 + 24 + + 72 + + + + 24 + 24 + + + + + + 24 + 144 + 24 + 24 + + + + 24 + 48 + 48 + + + 96 96 96 @@ -230,13 +227,11 @@ 72 144 288 - 48 - 48 - 24 - 24 - 1 - - + + + + + 1 run_coupling env_run.xml @@ -275,16 +270,14 @@ integer $ATM_NCPL - 24 24 - 4 + 1 24 24 - - - - + 48 + 48 1 + 24 run_coupling env_run.xml @@ -332,16 +325,16 @@ integer 8 - $ATM_NCPL - $ATM_NCPL - $ATM_NCPL - $ATM_NCPL - 1 - 8 - 8 - $ATM_NCPL - 1 - $ATM_NCPL + 1 + $ATM_NCPL + $ATM_NCPL + $ATM_NCPL + 1 + 8 + 8 + $ATM_NCPL + 1 + $ATM_NCPL run_coupling env_run.xml @@ -440,6 +433,39 @@ + + + + + + char + none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,nmonths,nmonth,nyears,nyear,date,ifdays0,end + never + med_history + env_run.xml + Sets driver snapshot history file frequency (like REST_OPTION) + + + integer + + -999 + med_history + env_run.xml + Sets driver snapshot history file frequency (like REST_N) + + + integer + + -999 + med_history + env_run.xml + yyyymmdd format, sets coupler snapshot history date (like REST_DATE) + + + + + + char none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,nmonths,nmonth,nyears,nyear,date,ifdays0,end @@ -447,11 +473,10 @@ nmonths - run_drv_history + med_history env_run.xml - Sets driver average history file frequency (like REST_OPTION) + Sets mediator average history file frequency (like REST_OPTION) - char @@ -459,18 +484,17 @@ 1 - run_drv_history + med_history env_run.xml - Sets driver average history file frequency (like REST_N) + Sets mediator average history file frequency (like REST_N) - integer -999 - run_drv_history + med_history env_run.xml - yyyymmdd format, sets driver average history date (like REST_DATE) + yyyymmdd format, sets mediator average history date (like REST_DATE) diff --git a/cime_config/config_component_ufs.xml b/cime_config/config_component_ufs.xml index 1516f97b..bb32df7b 100644 --- a/cime_config/config_component_ufs.xml +++ b/cime_config/config_component_ufs.xml @@ -422,6 +422,32 @@ + + char + none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,nmonths,nmonth,nyears,nyear,date,ifdays0,end + never + run_drv_history + env_run.xml + Sets driver snapshot history file frequency (like REST_OPTION) + + + integer + + -999 + run_drv_history + env_run.xml + Sets driver snapshot history file frequency (like REST_N) + + + + integer + + -999 + run_drv_history + env_run.xml + yyyymmdd format, sets coupler snapshot history date (like REST_DATE) + + char none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,nmonths,nmonth,nyears,nyear,date,ifdays0,end @@ -433,7 +459,6 @@ env_run.xml Sets driver average history file frequency (like REST_OPTION) - char @@ -445,7 +470,6 @@ env_run.xml Sets driver average history file frequency (like REST_N) - integer diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index b964187b..e909eaf9 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -18,90 +18,24 @@ - - char - nuopc - MED_attributes - off,low,high,max - - $ESMF_VERBOSITY_LEVEL - - - - - char - nuopc - ATM_attributes - off,low,high,max - - $ESMF_VERBOSITY_LEVEL - - - - - char - nuopc - OCN_attributes - off,low,high,max - - $ESMF_VERBOSITY_LEVEL - - - - - char - nuopc - ICE_attributes - off,low,high,max - - $ESMF_VERBOSITY_LEVEL - - - - - char - nuopc - ROF_attributes - off,low,high,max - - $ESMF_VERBOSITY_LEVEL - - - - - char - nuopc - LND_attributes - off,low,high,max - - $ESMF_VERBOSITY_LEVEL - - - - - char - nuopc - GLC_attributes - off,low,high,max - - $ESMF_VERBOSITY_LEVEL - - - - + char - nuopc - off,low,high,max - WAV_attributes + cime_pes + PELAYOUT_attributes + + Determines what ESMF log files (if any) are generated when + USE_ESMF_LIB is TRUE. + ESMF_LOGKIND_SINGLE: Use a single log file, combining messages from + all of the PETs. Not supported on some platforms. + ESMF_LOGKIND_MULTI: Use multiple log files — one per PET. + ESMF_LOGKIND_NONE: Do not issue messages to a log file. + By default, no ESMF log files are generated. + - $ESMF_VERBOSITY_LEVEL + $ESMF_LOGFILE_KIND - - - - char expdef @@ -138,58 +72,6 @@ - - - - - - - - - - - - - - - real - control - DRIVER_attributes - - Wall time limit for run - default: -1.0 - - - -1.0 - - - - - char - control - DRIVER_attributes - day,month,year - - Force stop at the next month, day, etc when wall_time_limit is hit - default: month - - - month - - - - - logical - performance - DRIVER_attributes - - default: .false. - - - $COMP_RUN_BARRIERS - - - logical reprosum @@ -202,7 +84,6 @@ .false. - real reprosum @@ -215,7 +96,6 @@ -1.0e-8 - logical reprosum @@ -253,18 +133,6 @@ - - real - expdef - DRIVER_attributes - - Abort if cplstep time exceeds this value - - - 0. - - - char nuopc @@ -289,10 +157,6 @@ - - - - char wv_sat @@ -308,7 +172,6 @@ GoffGratch - real wv_sat @@ -326,7 +189,6 @@ 20.0D0 - logical wv_sat @@ -340,7 +202,6 @@ .false. - real wv_sat @@ -471,7 +332,7 @@ - + @@ -482,6 +343,18 @@ cesm + + char + mapping + ALLCOMP_attributes + + MESH for model mask (used to create masks and fractions at run time if different than model mesh) + + + $MASK_MESH + null + + char nuopc @@ -663,29 +536,6 @@ - - logical - expdef - ATM_attributes - - Perpetual flag - - - .false. - - - - integer - expdef - ATM_attributes - - Perpetual date - - - -999 - - - real single_column @@ -727,18 +577,6 @@ - - logical - expdef - ATM_attributes - - true => turn on aquaplanet mode in cam - - - .false. - - - logical flds @@ -788,7 +626,7 @@ - + @@ -804,7 +642,6 @@ 0.0 - integer control @@ -816,7 +653,6 @@ 5 - logical control @@ -835,6 +671,15 @@ + + char + nuopc + MED_attributes + off,low,high,max + + $ESMF_VERBOSITY_LEVEL + + integer control @@ -967,7 +812,6 @@ $WAV_NY - char control @@ -979,7 +823,6 @@ $COUPLING_MODE - char control @@ -1026,162 +869,50 @@ - - char - mapping - abs - ALLCOMP_attributes + + logical + control + MED_attributes - MESH for model mask (used to create masks and fractions at run time if different than model mesh) + Only used for C,G compsets: if true, compute albedos to work with daily avg SW down - $MASK_MESH - null + $CPL_ALBAV - + char mapping - abs - ATM_attributes + MED_attributes + ogrid,agrid,xgrid - MESH description of atm grid + Grid for atm ocn flux calc (untested) + default: ocn - $ATM_DOMAIN_MESH - null + ogrid - - char - mapping - abs - LND_attributes + + real + control + MED_attributes - MESH description of lnd grid + wind gustiness factor - $LND_DOMAIN_MESH - null + 0.0D0 - - char - mapping - abs - OCN_attributes + + logical + budget + MED_attributes - MESH description of ocn grid - - - $OCN_DOMAIN_MESH - null - - - - - char - mapping - abs - ICE_attributes - - MESH description of ice grid - - - $ICE_DOMAIN_MESH - null - - - - - char - mapping - abs - ROF_attributes - - MESH description of rof grid - - - $ROF_DOMAIN_MESH - null - - - - - char - mapping - abs - GLC_attributes - - MESH description of glc grid - - - $GLC_DOMAIN_MESH - null - - - - - char - mapping - abs - WAV_attributes - - MESH description of wav grid - - - $WAV_DOMAIN_MESH - null - - - - - logical - control - MED_attributes - - Only used for C,G compsets: if true, compute albedos to work with daily avg SW down - - - $CPL_ALBAV - - - - - char - mapping - MED_attributes - ogrid,agrid,xgrid - - Grid for atm ocn flux calc (untested) - default: ocn - - - ogrid - - - - - real - control - MED_attributes - - wind gustiness factor - - - 0.0D0 - - - - - logical - budget - MED_attributes - - logical that turns on diagnostic budgets, false means budgets will never be written + logical that turns on diagnostic budgets, false means budgets will never be written $BUDGETS @@ -1304,404 +1035,930 @@ - - - + + + - - logical - history - MED_attributes + + + + + + char + time + ALLCOMP_attributes + none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end - logical to write an extra initial coupler history file + mediator history snapshot option (used with history_n and history_ymd) + set by HIST_OPTION in env_run.xml. + history_option alarms are: + [none/never], turns option off + [nstep/s] , history snapshot every history_n nsteps , relative to current run start time + [nsecond/s] , history snapshot every history_n nseconds, relative to current run start time + [nminute/s] , history snapshot every history_n nminutes, relative to current run start time + [nhour/s] , history snapshot every history_n nhours , relative to current run start time + [nday/s] , history snapshot every history_n ndays , relative to current run start time + [monthly/s] , history snapshot every month , relative to current run start time + [nmonth/s] , history snapshot every history_n nmonths , relative to current run start time + [nyear/s] , history snapshot every history_n nyears , relative to current run start time + [date] , history snapshot at history_ymd value + [ifdays0] , history snapshot at history_n calendar day value and seconds equal 0 + [end] , history snapshot at end - .false. + $HIST_OPTION - - - - - - - - - - - - + + integer + time + ALLCOMP_attributes + + sets mediator snapshot history file frequency (like restart_n) + set by HIST_N in env_run.xml. + + + $HIST_N + + - - - - - - - - - - - - + + integer + time + CLOCK_attributes + + date associated with history_option date. yyyymmdd format. + set by HIST_DATE in env_run.xml. + + + $HIST_DATE + + - - - - - - - - - - - - + + + - - - - - - - - - - - - + + char + time + MED_attributes + none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + + mediator history for mediator aoflux and oceean albedoes (used with history_n and history_ymd) + + + never + + + + integer + time + MED_attributes + + sets mediator aoflux and ocean albedoes snapshot history file frequency for atm import/export fields (like restart_n) + + + -999 + + - - - - - - - - - - - - + + + - - - - - - - - - - - - + + char + time + MED_attributes + none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + + mediator history for atm import/export/fields snapshot option (used with history_n and history_ymd) + + + never + + + + integer + time + MED_attributes + + sets mediator snapshot history file frequency for atm import/export fields (like restart_n) + + + -999 + + + + char + time + MED_attributes + none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + + mediator time average history option (used with histavg_n and histavg_ymd) + + + never + + + + integer + time + MED_attributes + + Sets mediator time-average history file frequency (like restart_option) + + + -999 + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + logical + aux_hist + MED_attributes + Auxiliary mediator atm2med instantaneous history output every hour. + + .false. + + + + char + aux_hist + MED_attributes + Auxiliary mediator atm2med instantaneous history output every hour. + + Faxa_swndr:Faxa_swvdr:Faxa_swndf:Faxa_swvdf + + + + char + aux_hist + MED_attributes + history option type + + nhours + + + + char + aux_hist + MED_attributes + history option type + + 1 + + + + logical + aux_hist + MED_attributes + If true, use time average for aux file output. + + .false. + + + + char + aux_hist + MED_attributes + Auxiliary name identifier in history name + + atm.1h.inst + + + + integer + aux_hist + MED_attributes + Number of time sames per file. + + 24 + + - - - - - - - - - - - - + + + logical + aux_hist + MED_attributes + Auxiliary atm2med history output averaged over 1 hour. + + .false. + + + + char + aux_hist + MED_attributes + Auxiliary atm2med history output averaged over 1 hour. + + Sa_u:Sa_v + + + + char + aux_hist + MED_attributes + history option type + + nhours + + + + char + aux_hist + MED_attributes + history option type + + 1 + + + + logical + aux_hist + MED_attributes + If true, use time average for aux file output. + + .true. + + + + char + aux_hist + MED_attributes + Number of time sames per file. + + 24 + + + + char + aux_hist + MED_attributes + Auxiliary name identifier in history name + + atm.1h.avrg + + - - - - - - - - - - - - + + + logical + aux_hist + MED_attributes + + Auxiliary mediator atm2med precipitation history output every 3 hours + + + .false. + + + + char + aux_hist + MED_attributes + Auxiliary mediator atm2med precipitation history output every 3 hours + + Faxa_rainc:Faxa_rainl:Faxa_snowc:Faxa_snowl + + + + char + aux_hist + MED_attributes + history option type + + nhours + + + + char + aux_hist + MED_attributes + history option type + + 3 + + + + logical + aux_hist + MED_attributes + If true, use time average for aux file output. + + .true. + + + + char + aux_hist + MED_attributes + Number of time sames per file. + + 8 + + + + char + aux_hist + MED_attributes + Auxiliary name identifier in history name. + + atm.3hprec.avrg + + - - - - - - - - - - - - + + + logical + aux_hist + MED_attributes + + Auxiliary mediator a2x precipitation history output every 3 hours + + + .false. + + + + char + aux_hist + MED_attributes + + Auxiliary mediator a2x precipitation history output every 3 hours + + + Sa_z:Sa_topo:Sa_u:Sa_v:Sa_tbot:Sa_ptem:Sa_shum:Sa_dens:Sa_pbot:Sa_pslv:Faxa_lwdn:Faxa_rainc:Faxa_rainl:Faxa_snowc:Faxa_snowl:Faxa_swndr:Faxa_swvdr:Faxa_swndf:Faxa_swvdf:Sa_co2diag:Sa_co2prog + + + + char + aux_hist + MED_attributes + history option type + + nhours + + + + char + aux_hist + MED_attributes + history option type + + 3 + + + + logical + aux_hist + MED_attributes + If true, use time average for aux file output. + + .true. + + + + char + aux_hist + MED_attributes + Number of time sames per file. + + 8 + + + + char + aux_hist + MED_attributes + Auxiliary name identifier in history name. + + atm.3h.avrg + + - - - - - - - - - - - - + + + logical + aux_hist + MED_attributes + Auxiliary mediator a2x precipitation history output every 3 hours + + .false. + + + + char + aux_hist + MED_attributes + Auxiliary mediator a2x precipitation history output every 3 hours + + Faxa_bcph:Faxa_ocph:Faxa_dstwet:Faxa_dstdry:Sa_co2prog:Sa_co2diag + + + + char + aux_hist + MED_attributes + history option type + + ndays + + + + char + aux_hist + MED_attributes + history option type + + 1 + + + + logical + aux_hist + MED_attributes + If true, use time average for aux file output. + + .true. + + + + char + aux_hist + MED_attributes + Number of time sames per file. + + 1 + + + + char + aux_hist + MED_attributes + Auxiliary name identifier in history name + + atm.24h.avrg + + - - - - - - - - - - - - + + + - - - - - - - - - - - - + + char + time + MED_attributes + none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + + mediator history for ice import/export/fields snapshot option (used with history_n and history_ymd) + + + never + + + + integer + time + MED_attributes + + sets mediator snapshot history file frequency for ice import/export fields (like restart_n) + + + -999 + + + + char + time + MED_attributes + none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + + mediator time average history option (used with histavg_n and histavg_ymd) + + + never + + + + integer + time + MED_attributes + + Sets mediator time-average history file frequency (like restart_option) + + + -999 + + - - - - - - - - - - - - + + + - - - - - - - - - - - - + + char + time + MED_attributes + none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + + mediator history for glc import/export/fields snapshot option (used with history_n and history_ymd) + + + never + + + + integer + time + MED_attributes + + sets mediator snapshot history file frequency for glc import/export fields (like restart_n) + + + -999 + + + + char + time + MED_attributes + none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + + mediator time average history option (used with histavg_n and histavg_ymd) + + + never + + + + integer + time + MED_attributes + + Sets mediator time-average history file frequency (like restart_option) + + + -999 + + - - - - - - - - - - - + + + - - - - - - - - - - - + + char + time + MED_attributes + none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + + mediator history for lnd import/export/fields snapshot option (used with history_n and history_ymd) + + + never + + + + integer + time + MED_attributes + + sets mediator snapshot history file frequency for lnd import/export fields (like restart_n) + + + -999 + + + + char + time + MED_attributes + none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + + mediator time average history option (used with histavg_n and histavg_ymd) + + + never + + + + integer + time + MED_attributes + + Sets mediator time-average history file frequency (like restart_option) + + + -999 + + - - - - - - - - - - - + + + logical + aux_hist + MED_attributes + Auxiliary mediator l2x fields every lnd coupling interval + + .false. + + + + char + aux_hist + MED_attributes + Auxiliary mediator lnd2med output every lnd coupling interval + + all + + + + char + aux_hist + MED_attributes + history option type + + nsteps + + + + char + aux_hist + MED_attributes + history option type + + 1 + + + + logical + aux_hist + MED_attributes + If true, use time average for aux file output. + + .false. + + + + char + aux_hist + MED_attributes + Number of time sames per file. + + 1 + + + + char + aux_hist + MED_attributes + Auxiliary name identifier in history name + + lnd.ncpl.inst + + - - - - - - - - - - - + + + + + logical + aux_hist + ALLCOMP_attributes + Auxiliary mediator lnd2med fields every year + + .false. + + - - - - - - - - - - - + + + - - - - - - - - - - - + + char + time + MED_attributes + none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + + mediator history for ocn import/export/fields snapshot option (used with history_n and history_ymd) + + + never + + + + integer + time + MED_attributes + + sets mediator snapshot history file frequency for ocn import/export fields (like restart_n) + + + -999 + + + + char + time + MED_attributes + none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + + mediator time average history option (used with histavg_n and histavg_ymd) + + + never + + + + integer + time + MED_attributes + + Sets mediator time-average history file frequency (like restart_option) + + + -999 + + - - - + + + - + char - expdef - ALLCOMP_attributes + time + MED_attributes + none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end - name of the coupling field with scalar information + mediator history for rof import/export/fields snapshot option (used with history_n and history_ymd) - cpl_scalars + never - - + integer - expdef - ALLCOMP_attributes + time + MED_attributes - total number of scalars in the scalar coupling field + sets mediator snapshot history file frequency for rof import/export fields (like restart_n) - 4 + -999 - - + + char + time + MED_attributes + none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + + mediator time average history option (used with histavg_n and histavg_ymd) + + + never + + + integer - expdef - ALLCOMP_attributes + time + MED_attributes - index of scalar containing global grid cell count in X dimension + Sets mediator time-average history file frequency (like restart_option) + + -999 + + + + + + logical + aux_hist + MED_attributes + Auxiliary mediator rof2med precipitation history output every 3 hours + + .false. + + + + char + aux_hist + MED_attributes + Auxiliary mediator rof2med precipitation history output. + + all + + + + char + aux_hist + MED_attributes + history option type + + ndays + + + + char + aux_hist + MED_attributes + history option type + + 1 + + + + char + aux_hist + MED_attributes + If true, use time average for aux file output. + + .true. + + + + char + aux_hist + MED_attributes + Number of time sames per file. 1 + + char + aux_hist + MED_attributes + Auxiliary name identifier in history name + + rof.24h.avrg + + - - integer - expdef - ALLCOMP_attributes + + + + + + char + time + MED_attributes + none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end - index of scalar containing global grid cell count in Y dimension + mediator history for wav import/export/fields snapshot option (used with history_n and history_ymd) - 2 + never - - + integer - expdef - ALLCOMP_attributes + time + MED_attributes - index of scalar containing calendar day of nextsw computation from atm + sets mediator snapshot history file frequency for wav import/export fields (like restart_n) - 3 + -999 - - - integer - expdef - ALLCOMP_attributes + + char + time + MED_attributes + none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end - index of scalar containing epbal precipitation factor from ocn (only for POP) + mediator time average history option (used with histavg_n and histavg_ymd) - 4 - 0 + never - - + integer - expdef - ALLCOMP_attributes + time + MED_attributes - number of glc ice sheets + Sets mediator time-average history file frequency (like restart_option) - 1 + -999 + + + + logical mapping @@ -1916,6 +2173,95 @@ + + + + + + char + expdef + ALLCOMP_attributes + + name of the coupling field with scalar information + + + cpl_scalars + + + + + integer + expdef + ALLCOMP_attributes + + total number of scalars in the scalar coupling field + + + 4 + + + + + integer + expdef + ALLCOMP_attributes + + index of scalar containing global grid cell count in X dimension + + + 1 + + + + + integer + expdef + ALLCOMP_attributes + + index of scalar containing global grid cell count in Y dimension + + + 2 + + + + + integer + expdef + ALLCOMP_attributes + + index of scalar containing calendar day of nextsw computation from atm + + + 3 + + + + + integer + expdef + ALLCOMP_attributes + + index of scalar containing epbal precipitation factor from ocn (only for POP) + + + 4 + 0 + + + + + integer + expdef + ALLCOMP_attributes + + number of glc ice sheets + + + 1 + + + logical flds @@ -2351,152 +2697,6 @@ - - char - time - CLOCK_attributes - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end - - coupler history snapshot option (used with history_n and history_ymd) - set by HIST_OPTION in env_run.xml. - history_option alarms are: - [none/never], turns option off - [nstep/s] , history snapshot every history_n nsteps , relative to current run start time - [nsecond/s] , history snapshot every history_n nseconds, relative to current run start time - [nminute/s] , history snapshot every history_n nminutes, relative to current run start time - [nhour/s] , history snapshot every history_n nhours , relative to current run start time - [nday/s] , history snapshot every history_n ndays , relative to current run start time - [monthly/s] , history snapshot every month , relative to current run start time - [nmonth/s] , history snapshot every history_n nmonths , relative to current run start time - [nyear/s] , history snapshot every history_n nyears , relative to current run start time - [date] , history snapshot at history_ymd value - [ifdays0] , history snapshot at history_n calendar day value and seconds equal 0 - [end] , history snapshot at end - - - $HIST_OPTION - - - - - integer - time - CLOCK_attributes - - sets coupler snapshot history file frequency (like restart_n) - set by HIST_N in env_run.xml. - - - $HIST_N - - - - - integer - time - CLOCK_attributes - - date associated with history_option date. yyyymmdd format. - set by HIST_DATE in env_run.xml. - - - $HIST_DATE - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - char - time - CLOCK_attributes - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,nmonths,monthly,nmonth,nyears,nyear,date,ifdays0,end - - sets the driver barrier frequency to sync models across all tasks with barrier_n and barrier_ymd - barrier_option alarms are like restart_option - default: never - - - $BARRIER_OPTION - - - - - integer - time - CLOCK_attributes - - Sets model barriers with barrier_option and barrier_ymd (same options as stop_n) - default: 1 - - - $BARRIER_N - - - - - integer - time - CLOCK_attributes - - Date in yyyymmdd format, sets model barriers date with barrier_option and barrier_n - - - $BARRIER_DATE - - - char time @@ -2679,7 +2879,7 @@ - + @@ -2693,7 +2893,6 @@ $NINST - integer cime_pes @@ -2706,7 +2905,6 @@ $NTASKS_ATM - integer cime_pes @@ -2719,7 +2917,6 @@ $NTHRDS_ATM - integer cime_pes @@ -2732,7 +2929,6 @@ $ROOTPE_ATM - integer cime_pes @@ -2745,7 +2941,6 @@ $PSTRID_ATM - integer cime_pes @@ -2758,7 +2953,6 @@ $NTASKS_LND - integer cime_pes @@ -2771,7 +2965,6 @@ $NTHRDS_LND - integer cime_pes @@ -2784,7 +2977,6 @@ $ROOTPE_LND - integer cime_pes @@ -2797,7 +2989,6 @@ $PSTRID_LND - integer cime_pes @@ -2810,7 +3001,6 @@ $NTASKS_ICE - integer cime_pes @@ -2823,7 +3013,6 @@ $NTHRDS_ICE - integer cime_pes @@ -2836,7 +3025,6 @@ $ROOTPE_ICE - integer cime_pes @@ -2849,7 +3037,6 @@ $PSTRID_ICE - integer cime_pes @@ -2862,7 +3049,6 @@ $NTASKS_OCN - integer cime_pes @@ -2875,7 +3061,6 @@ $NTHRDS_OCN - integer cime_pes @@ -2888,7 +3073,6 @@ $ROOTPE_OCN - integer cime_pes @@ -2901,7 +3085,6 @@ $PSTRID_OCN - integer cime_pes @@ -2914,7 +3097,6 @@ $NTASKS_GLC - integer cime_pes @@ -2927,7 +3109,6 @@ $NTHRDS_GLC - integer cime_pes @@ -2940,7 +3121,6 @@ $ROOTPE_GLC - integer cime_pes @@ -2953,7 +3133,6 @@ $PSTRID_GLC - integer cime_pes @@ -2966,7 +3145,6 @@ $NTASKS_WAV - integer cime_pes @@ -2979,7 +3157,6 @@ $NTHRDS_WAV - integer cime_pes @@ -2992,7 +3169,6 @@ $ROOTPE_WAV - integer cime_pes @@ -3005,7 +3181,6 @@ $PSTRID_WAV - integer cime_pes @@ -3018,7 +3193,6 @@ $NTASKS_ROF - integer cime_pes @@ -3031,7 +3205,6 @@ $NTHRDS_ROF - integer cime_pes @@ -3044,7 +3217,6 @@ $ROOTPE_ROF - integer cime_pes @@ -3057,7 +3229,6 @@ $PSTRID_ROF - integer cime_pes @@ -3070,7 +3241,6 @@ $NTASKS_ESP - integer cime_pes @@ -3083,7 +3253,6 @@ $NTHRDS_ESP - integer cime_pes @@ -3096,7 +3265,6 @@ $ROOTPE_ESP - integer cime_pes @@ -3109,7 +3277,6 @@ $PSTRID_ESP - integer cime_pes @@ -3122,7 +3289,6 @@ $NTASKS_CPL - integer cime_pes @@ -3135,7 +3301,6 @@ $NTHRDS_CPL - integer cime_pes @@ -3148,7 +3313,6 @@ $ROOTPE_CPL - integer cime_pes @@ -3162,28 +3326,10 @@ - - char - cime_pes - PELAYOUT_attributes - - Determines what ESMF log files (if any) are generated when - USE_ESMF_LIB is TRUE. - ESMF_LOGKIND_SINGLE: Use a single log file, combining messages from - all of the PETs. Not supported on some platforms. - ESMF_LOGKIND_MULTI: Use multiple log files — one per PET. - ESMF_LOGKIND_NONE: Do not issue messages to a log file. - By default, no ESMF log files are generated. - - - $ESMF_LOGFILE_KIND - - - - - - - + + + + logical @@ -3211,7 +3357,6 @@ .true. - logical performance @@ -3222,7 +3367,6 @@ .false. - logical performance @@ -3234,7 +3378,6 @@ .true. - logical performance @@ -3245,7 +3388,6 @@ .false. - integer performance @@ -3256,7 +3398,6 @@ $TIMER_LEVEL - integer performance @@ -3267,7 +3408,6 @@ 0 - integer performance @@ -3278,7 +3418,6 @@ $TIMER_DETAIL - integer performance @@ -3292,7 +3431,6 @@ 3 - logical performance @@ -3304,7 +3442,6 @@ .false. - logical performance @@ -3316,7 +3453,6 @@ .false. - integer performance @@ -3328,7 +3464,6 @@ 1 - logical performance @@ -3341,10 +3476,10 @@ - - - - + + + + char @@ -3357,7 +3492,6 @@ PAPI_FP_OPS - char performance @@ -3369,7 +3503,6 @@ PAPI_NO_CTR - char performance @@ -3381,7 +3514,6 @@ PAPI_NO_CTR - char performance @@ -3394,9 +3526,9 @@ - - - + + + logical @@ -3662,4 +3794,219 @@ + + + + + + char + nuopc + ATM_attributes + off,low,high,max + + $ESMF_VERBOSITY_LEVEL + + + + char + mapping + ATM_attributes + + MESH description of atm grid + + + $ATM_DOMAIN_MESH + null + + + + logical + expdef + ATM_attributes + + Perpetual flag + + + .false. + + + + integer + expdef + ATM_attributes + + Perpetual date + + + -999 + + + + logical + expdef + ATM_attributes + + true => turn on aquaplanet mode in cam + + + .false. + + + + + + + + + char + nuopc + ICE_attributes + off,low,high,max + + $ESMF_VERBOSITY_LEVEL + + + + char + mapping + ICE_attributes + + MESH description of ice grid + + + $ICE_DOMAIN_MESH + null + + + + + + + + + char + nuopc + GLC_attributes + off,low,high,max + + $ESMF_VERBOSITY_LEVEL + + + + char + mapping + GLC_attributes + + MESH description of glc grid + + + $GLC_DOMAIN_MESH + null + + + + + + + + + char + nuopc + LND_attributes + off,low,high,max + + $ESMF_VERBOSITY_LEVEL + + + + char + mapping + LND_attributes + + MESH description of lnd grid + + + $LND_DOMAIN_MESH + null + + + + + + + + + char + nuopc + OCN_attributes + off,low,high,max + + $ESMF_VERBOSITY_LEVEL + + + + char + mapping + OCN_attributes + + MESH description of ocn grid + + + $OCN_DOMAIN_MESH + null + + + + + + + + + char + nuopc + ROF_attributes + off,low,high,max + + $ESMF_VERBOSITY_LEVEL + + + + char + mapping + ROF_attributes + + MESH description of rof grid + + + $ROF_DOMAIN_MESH + null + + + + + + + + + char + nuopc + off,low,high,max + WAV_attributes + + $ESMF_VERBOSITY_LEVEL + + + + char + mapping + WAV_attributes + + MESH description of wav grid + + + $WAV_DOMAIN_MESH + null + + + diff --git a/cime_config/runseq/driver_config.py b/cime_config/runseq/driver_config.py index c2b5556b..e5fe2715 100644 --- a/cime_config/runseq/driver_config.py +++ b/cime_config/runseq/driver_config.py @@ -46,10 +46,8 @@ def __compute_glc(self, case, coupling_times): ############################################### # In the mediator the glc_avg_period will be set as an alarm - # on the mediator clock - when this alarm rings - the - # averaging will be done AND an attribute will be set on set - # on the glc export state from the mediator saying that the - # data coming to glc is valid + # on the on the prep_glc_clock. When this alarm rings - the + # averaging will be done. comp_glc = case.get_value("COMP_GLC") @@ -71,7 +69,9 @@ def __compute_glc(self, case, coupling_times): if not case.get_value("CISM_EVOLVE"): stop_option = case.get_value('STOP_OPTION') stop_n = case.get_value('STOP_N') - if stop_option == 'nsteps': + if stop_option == 'nyears': + glc_coupling_time = coupling_times["glc_cpl_dt"] + elif stop_option == 'nsteps': glc_coupling_time = stop_n * coupling_times["glc_cpl_dt"] elif stop_option == 'ndays': glc_coupling_time = stop_n * 86400 diff --git a/cime_config/testdefs/testlist_drv.xml b/cime_config/testdefs/testlist_drv.xml index 730f4d3a..7368a1fd 100644 --- a/cime_config/testdefs/testlist_drv.xml +++ b/cime_config/testdefs/testlist_drv.xml @@ -5,15 +5,6 @@ - - - - - - - - - @@ -23,7 +14,7 @@ - + @@ -179,7 +170,7 @@ - + @@ -196,7 +187,7 @@ - + diff --git a/drivers/cime/esm.F90 b/drivers/cime/esm.F90 index e1a18f13..d28ddacb 100644 --- a/drivers/cime/esm.F90 +++ b/drivers/cime/esm.F90 @@ -429,7 +429,6 @@ subroutine InitAttributes(driver, rc) real(R8) :: reprosum_diffmax ! setup reprosum, set rel_diff_max logical :: reprosum_recompute ! setup reprosum, recompute if tolerance exceeded character(LEN=CS) :: tfreeze_option ! Freezing point calculation - real(R8) :: wall_time_limit ! wall time limit in hours integer :: glc_nec ! number of elevation classes in the land component for lnd->glc character(LEN=CS) :: wv_sat_scheme real(R8) :: wv_sat_transition_start @@ -639,7 +638,6 @@ subroutine AddAttributes(gcomp, driver, config, compid, compname, inst_suffix, n character(len=CS) :: attribute integer :: componentCount character(len=*), parameter :: subname = "(esm.F90:AddAttributes)" - logical :: lvalue = .false. !------------------------------------------- rc = ESMF_Success @@ -655,18 +653,13 @@ subroutine AddAttributes(gcomp, driver, config, compid, compname, inst_suffix, n if (chkerr(rc,__LINE__,u_FILE_u)) return !------ - ! Add restart flag a to gcomp attributes + ! Add driver restart flag a to gcomp attributes !------ attribute = 'read_restart' - call NUOPC_CompAttributeAdd(gcomp, (/trim(attribute)/), rc=rc) + call NUOPC_CompAttributeGet(driver, name=trim(attribute), value=cvalue, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(driver, name="mediator_read_restart", value=cvalue, rc=rc) + call NUOPC_CompAttributeAdd(gcomp, (/trim(attribute)/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) lvalue - if (.not. lvalue) then - call NUOPC_CompAttributeGet(driver, name=trim(attribute), value=cvalue, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end if call NUOPC_CompAttributeSet(gcomp, name=trim(attribute), value=trim(cvalue), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -675,13 +668,10 @@ subroutine AddAttributes(gcomp, driver, config, compid, compname, inst_suffix, n !------ call ReadAttributes(gcomp, config, trim(compname)//"_attributes::", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ReadAttributes(gcomp, config, "ALLCOMP_attributes::", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ReadAttributes(gcomp, config, trim(compname)//"_modelio"//trim(inst_suffix)//"::", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ReadAttributes(gcomp, config, "CLOCK_attributes::", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -723,7 +713,6 @@ subroutine AddAttributes(gcomp, driver, config, compid, compname, inst_suffix, n !------ ! Add single column and single point attributes !------ - call esm_set_single_column_attributes(compname, gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return diff --git a/mediator/esmFlds.F90 b/mediator/esmFlds.F90 index a2bf9f98..86a3449e 100644 --- a/mediator/esmFlds.F90 +++ b/mediator/esmFlds.F90 @@ -36,6 +36,7 @@ module esmflds integer, public :: num_icesheets ! obtained from attribute logical, public :: ocn2glc_coupling ! obtained from attribute logical, public :: lnd2glc_coupling ! obtained in med.F90 + logical, public :: accum_lnd2glc ! obtained in med.F90 (this can be true even if lnd2glc_coupling is false) logical, public :: dststatus_print = .false. diff --git a/mediator/med.F90 b/mediator/med.F90 index 8c3f0006..01296577 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -1,8 +1,23 @@ module MED !----------------------------------------------------------------------------- - ! Mediator Component. + ! Mediator Initialization + ! + ! Note on time management: + ! Each time loop has its own associated clock object. NUOPC manages + ! these clock objects, i.e. their creation and destruction, as well as + ! startTime, endTime, timeStep adjustments during the execution. The + ! outer most time loop of the run sequence is a special case. It uses + ! the driver clock itself. If a single outer most loop is defined in + ! the run sequence provided by freeFormat, this loop becomes the driver + ! loop level directly. Therefore, setting the timeStep or runDuration + ! for the outer most time loop results in modifying the driver clock + ! itself. However, for cases with cocnatenated loops on the upper level + ! of the run sequence in freeFormat, a single outer loop is added + ! automatically during ingestion, and the driver clock is used for this + ! loop instead. !----------------------------------------------------------------------------- + use ESMF , only : ESMF_VMLogMemInfo use NUOPC_Model , only : SetVM use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 @@ -24,8 +39,8 @@ module MED use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose use med_methods_mod , only : FB_getFieldN => med_methods_FB_getFieldN use med_methods_mod , only : clock_timeprint => med_methods_clock_timeprint - use med_time_mod , only : alarmInit => med_time_alarmInit use med_utils_mod , only : memcheck => med_memcheck + use med_time_mod , only : med_time_alarmInit use med_internalstate_mod , only : InternalState use med_internalstate_mod , only : med_coupling_allowed, logunit, mastertask use med_phases_profile_mod , only : med_phases_profile_finalize @@ -33,7 +48,8 @@ module MED use esmFlds , only : fldListFr, fldListTo, med_fldList_Realize use esmFlds , only : ncomps, compname, ncomps use esmFlds , only : compmed, compatm, compocn, compice, complnd, comprof, compwav ! not arrays - use esmFlds , only : num_icesheets, max_icesheets, compglc, ocn2glc_coupling, lnd2glc_coupling ! compglc is an array + use esmFlds , only : num_icesheets, max_icesheets, compglc ! compglc is an array + use esmFlds , only : ocn2glc_coupling, lnd2glc_coupling, accum_lnd2glc use esmFlds , only : fldListMed_ocnalb use esmFlds , only : med_fldList_GetNumFlds, med_fldList_GetFldNames, med_fldList_GetFldInfo use esmFlds , only : med_fldList_Document_Mapping, med_fldList_Document_Merging @@ -190,7 +206,7 @@ subroutine SetServices(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ - ! setup mediator history phase + ! setup mediator history phases for all output variables !------------------ call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & @@ -199,9 +215,6 @@ subroutine SetServices(gcomp, rc) call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & specPhaseLabel="med_phases_history_write", specRoutine=med_phases_history_write, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_TimestampExport, & - specPhaselabel="med_phases_history_write", specRoutine=NUOPC_NoOp, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ ! setup mediator restart phase @@ -276,9 +289,6 @@ subroutine SetServices(gcomp, rc) call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & specPhaseLabel="med_phases_post_ocn", specRoutine=med_phases_post_ocn, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_TimestampExport, & - specPhaselabel="med_phases_post_ocn", specRoutine=NUOPC_NoOp, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ ! prep and post routines for ice @@ -298,12 +308,9 @@ subroutine SetServices(gcomp, rc) call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & specPhaseLabel="med_phases_post_ice", specRoutine=med_phases_post_ice, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_TimestampExport, & - specPhaselabel="med_phases_post_ice", specRoutine=NUOPC_NoOp, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ - ! prep routines for lnd + ! prep/post routines for lnd !------------------ call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & @@ -319,12 +326,9 @@ subroutine SetServices(gcomp, rc) call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & specPhaseLabel="med_phases_post_lnd", specRoutine=med_phases_post_lnd, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_TimestampExport, & - specPhaselabel="med_phases_post_lnd", specRoutine=NUOPC_NoOp, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ - ! prep and post routines for rof + ! prep/post routines for rof !------------------ call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & @@ -341,12 +345,9 @@ subroutine SetServices(gcomp, rc) call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & specPhaseLabel="med_phases_post_rof", specRoutine=med_phases_post_rof, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_TimestampExport, & - specPhaselabel="med_phases_post_rof", specRoutine=NUOPC_NoOp, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ - ! prep and post routines for wav + ! prep/post routines for wav !------------------ call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & @@ -362,12 +363,9 @@ subroutine SetServices(gcomp, rc) call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & specPhaseLabel="med_phases_post_wav", specRoutine=med_phases_post_wav, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_TimestampExport, & - specPhaselabel="med_phases_post_wav", specRoutine=NUOPC_NoOp, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ - ! prep and post routines for glc + ! prep/post routines for glc !------------------ call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & @@ -384,9 +382,6 @@ subroutine SetServices(gcomp, rc) call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & specPhaseLabel="med_phases_post_glc", specRoutine=med_phases_post_glc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_TimestampExport, & - specPhaselabel="med_phases_post_glc", specRoutine=NUOPC_NoOp, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ ! phase routine for ocean albedo computation @@ -398,9 +393,6 @@ subroutine SetServices(gcomp, rc) call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & specPhaseLabel="med_phases_ocnalb_run", specRoutine=med_phases_ocnalb_run, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_TimestampExport, & - specPhaselabel="med_phases_ocnalb_run", specRoutine=NUOPC_NoOp, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ ! phase routine for ocn/atm flux computation @@ -412,9 +404,6 @@ subroutine SetServices(gcomp, rc) call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & specPhaseLabel="med_phases_aofluxes_run", specRoutine=med_phases_aofluxes_run, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_TimestampExport, & - specPhaselabel="med_phases_aofluxes_run", specRoutine=NUOPC_NoOp, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ ! phase routine for updating fractions @@ -529,6 +518,7 @@ subroutine SetServices(gcomp, rc) ! attach specializing method(s) ! -> NUOPC specializes by default --->>> first need to remove the default !------------------ + ! This is called every time you enter a mediator phase call ESMF_MethodRemove(gcomp, mediator_label_SetRunClock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -962,7 +952,8 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) else transferOffer = 'cannot provide' end if - call NUOPC_Advertise(is_local%wrap%NStateImp(ncomp), standardName=stdname, shortname=shortname, name=shortname, & + call NUOPC_Advertise(is_local%wrap%NStateImp(ncomp), & + standardName=stdname, shortname=shortname, name=shortname, & TransferOfferGeomObject=transferOffer, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(subname//':Fr_'//trim(compname(ncomp))//': '//trim(shortname), ESMF_LOGMSG_INFO) @@ -980,7 +971,8 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) else transferOffer = 'cannot provide' end if - call NUOPC_Advertise(is_local%wrap%NStateExp(ncomp), standardName=stdname, shortname=shortname, name=shortname, & + call NUOPC_Advertise(is_local%wrap%NStateExp(ncomp), & + standardName=stdname, shortname=shortname, name=shortname, & TransferOfferGeomObject=transferOffer, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(subname//':To_'//trim(compname(ncomp))//': '//trim(shortname), ESMF_LOGMSG_INFO) @@ -1632,13 +1624,13 @@ subroutine DataInitialize(gcomp, rc) use med_phases_prep_atm_mod , only : med_phases_prep_atm use med_phases_post_atm_mod , only : med_phases_post_atm use med_phases_post_ice_mod , only : med_phases_post_ice - use med_phases_post_lnd_mod , only : med_phases_post_lnd_init + use med_phases_post_lnd_mod , only : med_phases_post_lnd use med_phases_post_glc_mod , only : med_phases_post_glc use med_phases_post_ocn_mod , only : med_phases_post_ocn use med_phases_post_rof_mod , only : med_phases_post_rof use med_phases_post_wav_mod , only : med_phases_post_wav use med_phases_ocnalb_mod , only : med_phases_ocnalb_run - use med_phases_aofluxes_mod , only : med_phases_aofluxes_run, med_phases_aofluxes_init_fldbuns + use med_phases_aofluxes_mod , only : med_phases_aofluxes_init_fldbuns use med_phases_profile_mod , only : med_phases_profile use med_diag_mod , only : med_diag_zero, med_diag_init use med_map_mod , only : med_map_routehandles_init, med_map_packed_field_create @@ -1668,6 +1660,7 @@ subroutine DataInitialize(gcomp, rc) character(CL) :: cname character(CL) :: start_type logical :: read_restart + logical :: isPresent, isSet logical :: allDone = .false. logical,save :: compDone(ncomps) logical,save :: first_call = .true. @@ -2076,7 +2069,21 @@ subroutine DataInitialize(gcomp, rc) exit end if end do - if (lnd2glc_coupling .or. ocn2glc_coupling) then + if (lnd2glc_coupling) then + accum_lnd2glc = .true. + else + ! Determine if will create auxiliary history file that contains + ! lnd2glc data averaged over the year + call NUOPC_CompAttributeGet(gcomp, name="histaux_l2x1yrg", value=cvalue, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) accum_lnd2glc + else + accum_lnd2glc = .false. + end if + end if + if (lnd2glc_coupling .or. ocn2glc_coupling .or. accum_lnd2glc) then call med_phases_prep_glc_init(gcomp, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -2213,7 +2220,7 @@ subroutine DataInitialize(gcomp, rc) if (.not. compDone(compatm)) then ! atmdone is not true if (trim(lnd_present) == 'true') then ! map initial lnd->atm - call med_phases_post_lnd_init(gcomp, rc) + call med_phases_post_lnd(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if ! do the merge to the atmospheric component @@ -2289,8 +2296,8 @@ subroutine DataInitialize(gcomp, rc) end if do n1 = 1,ncomps if (mastertask) then - write(logunit,*) - write(logunit,'(a)') trim(subname)//" "//trim(compname(n1)) + write(logunit,*) + write(logunit,'(a)') trim(subname)//" "//trim(compname(n1)) end if if (is_local%wrap%comp_present(n1) .and. ESMF_StateIsCreated(is_local%wrap%NStateImp(n1),rc=rc)) then call State_GetScalar(scalar_value=real_nx, & @@ -2309,7 +2316,7 @@ subroutine DataInitialize(gcomp, rc) is_local%wrap%ny(n1) = nint(real_ny) write(msgString,'(2i8,2l4)') is_local%wrap%nx(n1), is_local%wrap%ny(n1) if (mastertask) then - write(logunit,*) 'global nx,ny sizes for '//trim(compname(n1))//":"//trim(msgString) + write(logunit,'(a)') 'global nx,ny sizes for '//trim(compname(n1))//":"//trim(msgString) end if call ESMF_LogWrite(trim(subname)//":"//trim(compname(n1))//":"//trim(msgString), ESMF_LOGMSG_INFO) end if @@ -2328,7 +2335,6 @@ subroutine DataInitialize(gcomp, rc) call med_diag_init(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call med_diag_zero(mode='all', rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return !--------------------------------------- @@ -2366,7 +2372,7 @@ subroutine DataInitialize(gcomp, rc) end if if (trim(lnd_present) == 'true') then ! map initial lnd->atm - call med_phases_post_lnd_init(gcomp, rc) + call med_phases_post_lnd(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if if (trim(ocn_present) == 'true') then @@ -2402,7 +2408,6 @@ subroutine DataInitialize(gcomp, rc) end subroutine DataInitialize !----------------------------------------------------------------------------- - subroutine SetRunClock(gcomp, rc) use ESMF , only : ESMF_GridComp, ESMF_CLOCK, ESMF_Time, ESMF_TimeInterval @@ -2419,7 +2424,8 @@ subroutine SetRunClock(gcomp, rc) integer, intent(out) :: rc ! local variables - type(ESMF_Clock) :: mediatorClock, driverClock + type(ESMF_Clock) :: mClock ! mediator clock + type(ESMF_CLock) :: dClock ! driver clock type(ESMF_Time) :: currTime type(ESMF_TimeInterval) :: timeStep type(ESMF_Alarm) :: stop_alarm @@ -2440,27 +2446,27 @@ subroutine SetRunClock(gcomp, rc) endif ! query the Mediator for clocks - call NUOPC_MediatorGet(gcomp, mediatorClock=mediatorClock, driverClock=driverClock, rc=rc) + call NUOPC_MediatorGet(gcomp, mediatorClock=mClock, driverClock=dClock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 1) then - call Clock_TimePrint(driverClock ,trim(subname)//'driver clock1',rc) - call Clock_TimePrint(mediatorClock,trim(subname)//'mediat clock1',rc) + call Clock_TimePrint(dClock, trim(subname)//'driver clock1',rc) + call Clock_TimePrint(mClock, trim(subname)//'mediat clock1',rc) endif ! set the mediatorClock to have the current start time as the driverClock - call ESMF_ClockGet(driverClock, currTime=currTime, timeStep=timeStep, rc=rc) + call ESMF_ClockGet(dClock, currTime=currTime, timeStep=timeStep, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockSet(mediatorClock, currTime=currTime, timeStep=timeStep, rc=rc) + call ESMF_ClockSet(mClock, currTime=currTime, timeStep=timeStep, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 1) then - call Clock_TimePrint(driverClock ,trim(subname)//'driver clock2',rc) - call Clock_TimePrint(mediatorClock,trim(subname)//'mediat clock2',rc) + call Clock_TimePrint(dClock, trim(subname)//'driver clock2',rc) + call Clock_TimePrint(mClock, trim(subname)//'mediat clock2',rc) endif ! check and set the component clock against the driver clock - call NUOPC_CompCheckSetClock(gcomp, driverClock, checkTimeStep=.false., rc=rc) + call NUOPC_CompCheckSetClock(gcomp, dClock, checkTimeStep=.false., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (.not. stopalarmcreated) then @@ -2472,20 +2478,16 @@ subroutine SetRunClock(gcomp, rc) call NUOPC_CompAttributeGet(gcomp, name="stop_ymd", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) stop_ymd - call alarmInit(mediatorclock, stop_alarm, stop_option, opt_n=stop_n, opt_ymd=stop_ymd, & + call med_time_alarmInit(mclock, stop_alarm, stop_option, opt_n=stop_n, opt_ymd=stop_ymd, & alarmname='alarm_stop', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return stopalarmcreated = .true. end if - !-------------------------------- ! Advance med clock to trigger alarms then reset model clock back to currtime - !-------------------------------- - - call ESMF_ClockAdvance(mediatorClock,rc=rc) + call ESMF_ClockAdvance(mClock,rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_ClockSet(mediatorClock, currTime=currtime, timeStep=timestep, rc=rc) + call ESMF_ClockSet(mClock, currTime=currtime, timeStep=timestep, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 5) then @@ -2612,43 +2614,33 @@ subroutine med_grid_write(grid, fileName, rc) call ESMF_GridGetCoord(grid, staggerLoc=ESMF_STAGGERLOC_CENTER, & isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (isPresent) then call ESMF_GridGetCoord(grid, coordDim=1, & staggerLoc=ESMF_STAGGERLOC_CENTER, array=array, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_ArraySet(array, name="lon_center", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_ArrayBundleAdd(arrayBundle, (/array/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_GridGetCoord(grid, coordDim=2, & staggerLoc=ESMF_STAGGERLOC_CENTER, array=array, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_ArraySet(array, name="lat_center", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_ArrayBundleAdd(arrayBundle, (/array/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return endif - ! Mask call ESMF_GridGetItem(grid, itemflag=ESMF_GRIDITEM_MASK, & staggerLoc=ESMF_STAGGERLOC_CENTER, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (isPresent) then call ESMF_GridGetItem(grid, staggerLoc=ESMF_STAGGERLOC_CENTER, & itemflag=ESMF_GRIDITEM_MASK, array=array, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_ArraySet(array, name="mask_center", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_ArrayBundleAdd(arrayBundle, (/array/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return endif @@ -2657,15 +2649,12 @@ subroutine med_grid_write(grid, fileName, rc) call ESMF_GridGetItem(grid, itemflag=ESMF_GRIDITEM_AREA, & staggerLoc=ESMF_STAGGERLOC_CENTER, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (isPresent) then call ESMF_GridGetItem(grid, staggerLoc=ESMF_STAGGERLOC_CENTER, & itemflag=ESMF_GRIDITEM_AREA, array=array, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_ArraySet(array, name="area_center", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_ArrayBundleAdd(arrayBundle, (/array/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return endif @@ -2680,20 +2669,15 @@ subroutine med_grid_write(grid, fileName, rc) call ESMF_GridGetCoord(grid, coordDim=1, & staggerLoc=ESMF_STAGGERLOC_CORNER, array=array, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_ArraySet(array, name="lon_corner", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_ArrayBundleAdd(arrayBundle, (/array/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_GridGetCoord(grid, coordDim=2, & staggerLoc=ESMF_STAGGERLOC_CORNER, array=array, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_ArraySet(array, name="lat_corner", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_ArrayBundleAdd(arrayBundle, (/array/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return endif @@ -2702,15 +2686,12 @@ subroutine med_grid_write(grid, fileName, rc) call ESMF_GridGetItem(grid, itemflag=ESMF_GRIDITEM_MASK, & staggerLoc=ESMF_STAGGERLOC_CORNER, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (isPresent) then call ESMF_GridGetItem(grid, staggerLoc=ESMF_STAGGERLOC_CORNER, & itemflag=ESMF_GRIDITEM_MASK, array=array, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_ArraySet(array, name="mask_corner", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_ArrayBundleAdd(arrayBundle, (/array/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return endif @@ -2719,15 +2700,12 @@ subroutine med_grid_write(grid, fileName, rc) call ESMF_GridGetItem(grid, itemflag=ESMF_GRIDITEM_AREA, & staggerLoc=ESMF_STAGGERLOC_CORNER, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (isPresent) then call ESMF_GridGetItem(grid, staggerLoc=ESMF_STAGGERLOC_CORNER, & itemflag=ESMF_GRIDITEM_AREA, array=array, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_ArraySet(array, name="area_corner", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_ArrayBundleAdd(arrayBundle, (/array/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return endif diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index b64c8bbf..0d717c96 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -31,7 +31,6 @@ module med_diag_mod use med_methods_mod , only : fldbun_getdata2d => med_methods_FB_getdata2d use med_methods_mod , only : fldbun_getdata1d => med_methods_FB_getdata1d use med_methods_mod , only : fldbun_fldChk => med_methods_FB_FldChk - use med_time_mod , only : alarmInit => med_time_alarmInit use med_utils_mod , only : chkerr => med_utils_ChkErr use perf_mod , only : t_startf, t_stopf diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index e8899e80..e26748b8 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -7,9 +7,9 @@ module med_io_mod use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, I8=>SHR_KIND_I8, R8=>SHR_KIND_R8 use med_kind_mod , only : R4=>SHR_KIND_R4 use shr_const_mod , only : fillvalue => SHR_CONST_SPVAL - use ESMF , only : ESMF_VM, ESMF_LogWrite, ESMF_LOGMSG_INFO - use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE - use ESMF , only : ESMF_VMGetCurrent, ESMF_VMGet, ESMF_VMBroadCast, ESMF_GridComp + use ESMF , only : ESMF_VM, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LogFoundError + use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE, ESMF_END_ABORT, ESMF_LOGERR_PASSTHRU + use ESMF , only : ESMF_VMGetCurrent, ESMF_VMGet, ESMF_VMBroadCast, ESMF_Finalize use NUOPC , only : NUOPC_FieldDictionaryGetEntry use NUOPC , only : NUOPC_FieldDictionaryHasEntry use pio , only : file_desc_t, iosystem_desc_t @@ -30,6 +30,8 @@ module med_io_mod public :: med_io_enddef public :: med_io_sec2hms public :: med_io_read + public :: med_io_define_time + public :: med_io_write_time public :: med_io_write public :: med_io_init public :: med_io_date2yyyymmdd @@ -55,7 +57,6 @@ module med_io_mod module procedure med_io_write_r8 module procedure med_io_write_r81d module procedure med_io_write_char - module procedure med_io_write_time end interface med_io_write interface med_io_date2ymd module procedure med_io_date2ymd_int @@ -70,16 +71,13 @@ module med_io_mod module procedure med_io_ymd2date_long end interface med_io_ymd2date - !------------------------------------------------------------------------------- ! module data - !------------------------------------------------------------------------------- - character(*),parameter :: prefix = "med_io_" character(*),parameter :: modName = "(med_io_mod) " character(*),parameter :: version = "cmeps0" + integer , parameter :: number_strlen = 8 integer , parameter :: file_desc_t_cnt = 20 ! Note - this is hard-wired for now - integer , parameter :: number_strlen = 2 - character(CL) :: wfilename = '' + character(CL) :: wfilename(0:file_desc_t_cnt) = '' type(file_desc_t) :: io_file(0:file_desc_t_cnt) integer :: pio_iotype integer :: pio_ioformat @@ -91,7 +89,7 @@ module med_io_mod contains !================================================================================= - logical function med_io_file_exists(vm, iam, filename) + logical function med_io_file_exists(vm, filename) !--------------- ! inquire if i/o file exists @@ -99,19 +97,24 @@ logical function med_io_file_exists(vm, iam, filename) ! input/output variables type(ESMF_VM) :: vm - integer, intent(in) :: iam character(len=*), intent(in) :: filename ! local variables integer :: tmp(1) + integer :: iam integer :: rc !------------------------------------------------------------------------------- tmp(1) = 0 - med_io_file_exists = .false. - if (iam==0) inquire(file=trim(filename),exist=med_io_file_exists) - if (med_io_file_exists) tmp(1) = 1 + call ESMF_VMGet(vm, localPet=iam, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + med_io_file_exists = .false. + if (iam==0) then + inquire(file=trim(filename),exist=med_io_file_exists) + if (med_io_file_exists) tmp(1) = 1 + end if call ESMF_VMBroadCast(vm, tmp, 1, 0, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -126,6 +129,7 @@ subroutine med_io_init(gcomp, rc) ! initialize pio !--------------- + use ESMF , only : ESMF_GridComp, ESMF_UtilStringUpperCase #ifdef CESMCOUPLED use shr_pio_mod , only : shr_pio_getiosys, shr_pio_getiotype, shr_pio_getioformat #else @@ -136,13 +140,12 @@ subroutine med_io_init(gcomp, rc) use pio , only : PIO_REARR_COMM_P2P, PIO_REARR_COMM_COLL use pio , only : PIO_REARR_COMM_FC_2D_ENABLE, PIO_REARR_COMM_FC_2D_DISABLE use pio , only : PIO_REARR_COMM_FC_1D_COMP2IO, PIO_REARR_COMM_FC_1D_IO2COMP - use ESMF , only : ESMF_GridComp, ESMF_UtilStringUpperCase use NUOPC, only : NUOPC_CompAttributeGet #endif ! input/output arguments - type(ESMF_GridComp), intent(in) :: gcomp - integer , intent(out) :: rc + type(ESMF_GridComp), intent(in) :: gcomp + integer , intent(out) :: rc #ifndef CESMCOUPLED ! local variables @@ -495,7 +498,7 @@ subroutine med_io_init(gcomp, rc) end subroutine med_io_init !=============================================================================== - subroutine med_io_wopen(filename, vm, iam, clobber, file_ind, model_doi_url) + subroutine med_io_wopen(filename, vm, clobber, file_ind, model_doi_url) !--------------- ! open netcdf file @@ -509,7 +512,6 @@ subroutine med_io_wopen(filename, vm, iam, clobber, file_ind, model_doi_url) ! input/output arguments character(*), intent(in) :: filename type(ESMF_VM) :: vm - integer, intent(in) :: iam logical, optional, intent(in) :: clobber integer, optional, intent(in) :: file_ind character(CL), optional, intent(in) :: model_doi_url @@ -520,6 +522,7 @@ subroutine med_io_wopen(filename, vm, iam, clobber, file_ind, model_doi_url) integer :: nmode integer :: lfile_ind integer :: rc + integer :: iam character(CL) :: lversion character(CL) :: lmodel_doi_url character(*),parameter :: subName = '(med_io_wopen) ' @@ -538,10 +541,13 @@ subroutine med_io_wopen(filename, vm, iam, clobber, file_ind, model_doi_url) if (.not. pio_file_is_open(io_file(lfile_ind))) then + call ESMF_VMGet(vm, localPet=iam, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! filename not open - wfilename = filename + wfilename(lfile_ind) = trim(filename) - if (med_io_file_exists(vm, iam, filename)) then + if (med_io_file_exists(vm, filename)) then if (lclobber) then nmode = pio_clobber ! only applies to classic NETCDF files. @@ -549,14 +555,12 @@ subroutine med_io_wopen(filename, vm, iam, clobber, file_ind, model_doi_url) nmode = ior(nmode,pio_ioformat) endif rcode = pio_createfile(io_subsystem, io_file(lfile_ind), pio_iotype, trim(filename), nmode) - if(iam==0) write(logunit,*) subname,' create file ',trim(filename) + if(iam==0) write(logunit,'(a)') trim(subname)//' creating file '//trim(filename) rcode = pio_put_att(io_file(lfile_ind),pio_global,"file_version",version) rcode = pio_put_att(io_file(lfile_ind),pio_global,"model_doi_url",lmodel_doi_url) else rcode = pio_openfile(io_subsystem, io_file(lfile_ind), pio_iotype, trim(filename), pio_write) - if (iam==0) then - write(logunit,*) subname,' open file ',trim(filename) - end if + if (iam==0) write(logunit,'(a)') trim(subname)//' opening file '//trim(filename) call pio_seterrorhandling(io_file(lfile_ind),PIO_BCAST_ERROR) rcode = pio_get_att(io_file(lfile_ind),pio_global,"file_version",lversion) call pio_seterrorhandling(io_file(lfile_ind),PIO_INTERNAL_ERROR) @@ -573,19 +577,21 @@ subroutine med_io_wopen(filename, vm, iam, clobber, file_ind, model_doi_url) nmode = ior(nmode,pio_ioformat) endif rcode = pio_createfile(io_subsystem, io_file(lfile_ind), pio_iotype, trim(filename), nmode) - if (iam==0) then - write(logunit,*) subname,' create file ',trim(filename) - end if + if (iam==0) write(logunit,'(a)') trim(subname) //' creating file '// trim(filename) rcode = pio_put_att(io_file(lfile_ind),pio_global,"file_version",version) rcode = pio_put_att(io_file(lfile_ind),pio_global,"model_doi_url",lmodel_doi_url) endif - elseif (trim(wfilename) /= trim(filename)) then + + elseif (trim(wfilename(lfile_ind)) /= trim(filename)) then ! filename is open, better match open filename - if(iam==0) write(logunit,*) subname,' different filename currently open ',trim(filename) - if(iam==0) write(logunit,*) subname,' different wfilename currently open ',trim(wfilename) - call ESMF_LogWrite(subname//'different file currently open '//trim(filename), ESMF_LOGMSG_INFO) + if (iam==0) then + write(logunit,'(a)') trim(subname)//' different filename currently open '//trim(filename) + write(logunit,'(a)') trim(subname)//' different wfilename currently open '//trim(wfilename(lfile_ind)) + end if + call ESMF_LogWrite(trim(subname)//'different file currently open '//trim(filename), ESMF_LOGMSG_INFO) rc = ESMF_FAILURE return + else ! filename is already open, just return endif @@ -593,7 +599,7 @@ subroutine med_io_wopen(filename, vm, iam, clobber, file_ind, model_doi_url) end subroutine med_io_wopen !=============================================================================== - subroutine med_io_close(filename, iam, file_ind, rc) + subroutine med_io_close(filename, vm, file_ind, rc) !--------------- ! close netcdf file @@ -602,13 +608,14 @@ subroutine med_io_close(filename, iam, file_ind, rc) use pio, only: pio_file_is_open, pio_closefile ! input/output variables - character(*), intent(in) :: filename - integer, intent(in) :: iam - integer,optional, intent(in) :: file_ind - integer , intent(out) :: rc + character(*) , intent(in) :: filename + type(ESMF_VM) , intent(in) :: vm + integer,optional , intent(in) :: file_ind + integer , intent(out) :: rc ! local variables integer :: lfile_ind + integer :: iam character(*),parameter :: subName = '(med_io_close) ' !------------------------------------------------------------------------------- @@ -619,18 +626,28 @@ subroutine med_io_close(filename, iam, file_ind, rc) if (.not. pio_file_is_open(io_file(lfile_ind))) then ! filename not open, just return - elseif (trim(wfilename) == trim(filename)) then + elseif (trim(wfilename(lfile_ind)) == trim(filename)) then ! filename matches, close it call pio_closefile(io_file(lfile_ind)) + !wfilename(lfile_ind) = '' else + call ESMF_VMGet(vm, localPet=iam, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! different filename is open, abort - if (iam==0) write(logunit,*) subname,' different filename currently open, aborting ',trim(filename) - if (iam==0) write(logunit,*) subname,' different wfilename currently open, aborting ',trim(wfilename) + if (iam==0) then + write(logunit,*) subname,' different wfilename and filename currently open, aborting ' + write(logunit,'(a)') 'filename = ',trim(filename) + write(logunit,'(a)') 'wfilename = ',trim(wfilename(lfile_ind)) + write(logunit,'(i6)')'lfile_ind = ',lfile_ind + end if call ESMF_LogWrite(subname//'different file currently open, aborting '//trim(filename), ESMF_LOGMSG_INFO) rc = ESMF_FAILURE - return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) then + call ESMF_Finalize(endflag=ESMF_END_ABORT) + end if endif - wfilename = '' + end subroutine med_io_close !=============================================================================== @@ -669,8 +686,8 @@ subroutine med_io_enddef(filename,file_ind) lfile_ind = 0 if (present(file_ind)) lfile_ind=file_ind - rcode = pio_enddef(io_file(lfile_ind)) + end subroutine med_io_enddef !=============================================================================== @@ -728,8 +745,8 @@ character(len=8) function med_io_sec2hms (seconds, rc) end function med_io_sec2hms !=============================================================================== - subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & - fillval, pre, tavg, use_float, file_ind, rc) + subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & + fillval, pre, flds, tavg, use_float, file_ind, rc) !--------------- ! Write FB to netcdf file @@ -745,20 +762,20 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & use pio , only : pio_syncfile ! input/output variables - character(len=*), intent(in) :: filename ! file - integer, intent(in) :: iam ! local pet - type(ESMF_FieldBundle), intent(in) :: FB ! data to be written - logical, optional, intent(in) :: whead ! write header - logical, optional, intent(in) :: wdata ! write data - integer , optional, intent(in) :: nx ! 2d grid size if available - integer , optional, intent(in) :: ny ! 2d grid size if available - integer , optional, intent(in) :: nt ! time sample - real(r8), optional, intent(in) :: fillval ! fill value - character(len=*), optional, intent(in) :: pre ! prefix to variable name - logical, optional, intent(in) :: tavg ! is this a tavg - logical, optional, intent(in) :: use_float ! write output as float rather than double - integer, optional, intent(in) :: file_ind - integer, intent(out):: rc + character(len=*) , intent(in) :: filename ! file + type(ESMF_FieldBundle) , intent(in) :: FB ! data to be written + logical , intent(in) :: whead ! write header + logical , intent(in) :: wdata ! write data + integer , intent(in) :: nx ! 2d grid size if available + integer , intent(in) :: ny ! 2d grid size if available + integer , optional , intent(in) :: nt ! time sample + real(r8), optional , intent(in) :: fillval ! fill value + character(len=*), optional , intent(in) :: pre ! prefix to variable name + character(len=*), optional , intent(in) :: flds(:) ! specific fields to write out + logical, optional , intent(in) :: tavg ! is this a tavg + logical, optional , intent(in) :: use_float ! write output as float rather than double + integer, optional , intent(in) :: file_ind + integer , intent(out):: rc ! local variables type(ESMF_Field) :: field @@ -782,9 +799,8 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & character(CL) :: lname ! long name character(CL) :: sname ! standard name character(CL) :: lpre ! local prefix - logical :: lwhead, lwdata - logical :: luse_float integer :: lnx,lny + logical :: luse_float real(r8) :: lfillvalue integer, pointer :: minIndexPTile(:,:) integer, pointer :: maxIndexPTile(:,:) @@ -801,57 +817,24 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & integer :: ungriddedUBound(1) ! currently the size must equal 1 for rank 2 fields integer :: gridToFieldMap(1) ! currently the size must equal 1 for rank 2 fields logical :: isPresent + character(CL), allocatable :: fieldNameList(:) character(*),parameter :: subName = '(med_io_write_FB) ' !------------------------------------------------------------------------------- - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) - endif rc = ESMF_Success lfillvalue = fillvalue - if (present(fillval)) then - lfillvalue = fillval - endif - + if (present(fillval)) lfillvalue = fillval lpre = ' ' - if (present(pre)) then - lpre = trim(pre) - endif - - if (.not. ESMF_FieldBundleIsCreated(FB, rc=rc)) then - call ESMF_LogWrite(trim(subname)//" FB "//trim(lpre)//" not created", ESMF_LOGMSG_INFO) - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) - endif - rc = ESMF_Success - return - endif - - lwhead = .true. - lwdata = .true. - if (present(whead)) lwhead = whead - if (present(wdata)) lwdata = wdata - - if (.not.lwhead .and. .not.lwdata) then - ! should we write a warning? - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) - endif - return - endif - + if (present(pre)) lpre = trim(pre) luse_float = .false. if (present(use_float)) luse_float = use_float - lfile_ind = 0 if (present(file_ind)) lfile_ind=file_ind - call ESMF_FieldBundleGet(FB, fieldCount=nf, rc=rc) - write(tmpstr,*) subname//' field count = '//trim(lpre),nf - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) - if (nf < 1) then - call ESMF_LogWrite(trim(subname)//" FB "//trim(lpre)//" empty", ESMF_LOGMSG_INFO) + ! Error check + if (.not. ESMF_FieldBundleIsCreated(FB, rc=rc)) then + call ESMF_LogWrite(trim(subname)//" FB "//trim(lpre)//" not created", ESMF_LOGMSG_INFO) if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif @@ -859,43 +842,60 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & return endif + ! Get number of fields + if (present(flds)) then + nf = size(flds) + else + call ESMF_FieldBundleGet(FB, fieldCount=nf, rc=rc) + write(tmpstr,*) subname//' field count = '//trim(lpre), nf + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + if (nf < 1) then + call ESMF_LogWrite(trim(subname)//" FB "//trim(lpre)//" empty", ESMF_LOGMSG_INFO) + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + rc = ESMF_Success + return + endif + allocate(fieldNameList(nf)) + call ESMF_FieldBundleGet(FB, fieldNameList=fieldNameList, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + + ! Get field bundle mesh from first field call FB_getFieldN(FB, 1, field, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, mesh=mesh, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Get mesh distgrid and number of elements call ESMF_MeshGet(mesh, elementDistgrid=distgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_MeshGet(mesh, spatialDim=ndims, numOwnedElements=nelements, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - write(tmpstr,*) subname, 'ndims, nelements = ', ndims, nelements call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + ! Set element coordinates if (.not. allocated(ownedElemCoords) .and. ndims > 0 .and. nelements > 0) then allocate(ownedElemCoords(ndims*nelements)) allocate(ownedElemCoords_x(ndims*nelements/2)) allocate(ownedElemCoords_y(ndims*nelements/2)) - call ESMF_MeshGet(mesh, ownedElemCoords=ownedElemCoords, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ownedElemCoords_x = ownedElemCoords(1::2) ownedElemCoords_y = ownedElemCoords(2::2) end if + ! Get tile info call ESMF_DistGridGet(distgrid, dimCount=dimCount, tileCount=tileCount, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - allocate(minIndexPTile(dimCount, tileCount), maxIndexPTile(dimCount, tileCount)) call ESMF_DistGridGet(distgrid, minIndexPTile=minIndexPTile, maxIndexPTile=maxIndexPTile, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! write(tmpstr,*) subname,' counts = ',dimcount,tilecount,minindexptile,maxindexptile ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) - ! TODO: this is not getting the global size correct for a FB coming in that does not have ! all the global grid values in the distgrid - e.g. CTSM @@ -903,44 +903,40 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & lnx = ng lny = 1 deallocate(minIndexPTile, maxIndexPTile) - - frame = -1 - if (present(nt)) then - frame = nt - endif - if (present(nx)) then - if (nx > 0) lnx = nx - endif - if (present(ny)) then - if (ny > 0) lny = ny - endif + if (nx > 0) lnx = nx + if (ny > 0) lny = ny if (lnx*lny /= ng) then - write(tmpstr,*) subname,' ERROR: grid2d size not consistent ',ng,lnx,lny + write(tmpstr,*) subname,' WARNING: grid2d size not consistent ',ng,lnx,lny call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) - - !TODO: this should not be an error for say CTSM which does not send a global grid - !rc = ESMF_FAILURE - !return endif - if (lwhead) then - rcode = pio_def_dim(io_file(lfile_ind),trim(lpre)//'_nx',lnx,dimid2(1)) - rcode = pio_def_dim(io_file(lfile_ind),trim(lpre)//'_ny',lny,dimid2(2)) + if (present(nt)) then + frame = nt + else + frame = -1 + end if + ! Write header + if (whead) then + rcode = pio_def_dim(io_file(lfile_ind), trim(lpre)//'_nx', lnx, dimid2(1)) + rcode = pio_def_dim(io_file(lfile_ind), trim(lpre)//'_ny', lny, dimid2(2)) if (present(nt)) then dimid3(1:2) = dimid2 - rcode = pio_inq_dimid(io_file(lfile_ind),'time',dimid3(3)) + rcode = pio_inq_dimid(io_file(lfile_ind), 'time', dimid3(3)) dimid => dimid3 else dimid => dimid2 endif - write(tmpstr,*) subname,' dimid = ',dimid call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) do k = 1,nf - call FB_getNameN(FB, k, itemc, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Determine field name + if (present(flds)) then + itemc = trim(flds(k)) + else + itemc = trim(fieldNameList(k)) + end if ! Determine rank of field with name itemc call ESMF_FieldBundleGet(FB, itemc, field=lfield, rc=rc) @@ -1028,14 +1024,9 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & rcode = pio_put_att(io_file(lfile_ind), varid, "long_name", "latitude") rcode = pio_put_att(io_file(lfile_ind), varid, "units", "degrees_north") rcode = pio_put_att(io_file(lfile_ind), varid, "standard_name", "latitude") - - ! Finish define mode - if (lwdata) call med_io_enddef(filename, file_ind=lfile_ind) - end if - if (lwdata) then - + if (wdata) then ! use distgrid extracted from field 1 above call ESMF_DistGridGet(distgrid, localDE=0, elementCount=ns, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -1043,16 +1034,17 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & call ESMF_DistGridGet(distgrid, localDE=0, seqIndexList=dof, rc=rc) write(tmpstr,*) subname,' dof = ',ns,size(dof),dof(1),dof(ns) !,minval(dof),maxval(dof) call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) - call pio_initdecomp(io_subsystem, pio_double, (/lnx,lny/), dof, iodesc) - ! call pio_writedof(lpre, (/lnx,lny/), int(dof,kind=PIO_OFFSET_KIND), mpicom) - deallocate(dof) do k = 1,nf - call FB_getNameN(FB, k, itemc, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Determine field name + if (present(flds)) then + itemc = trim(flds(k)) + else + itemc = trim(fieldNameList(k)) + end if call FB_getFldPtr(FB, itemc, & fldptr1=fldptr1, fldptr2=fldptr2, rank=rank, rc=rc) @@ -1091,7 +1083,7 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & end if ! end if not "hgt" end do ! end loop over fields in FB - ! Fill coordinate variables + ! Fill coordinate variables - why is this being done each time? name1 = trim(lpre)//'_lon' rcode = pio_inq_varid(io_file(lfile_ind), trim(name1), varid) call pio_setframe(io_file(lfile_ind),varid,frame) @@ -1113,7 +1105,7 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & end subroutine med_io_write_FB !=============================================================================== - subroutine med_io_write_int(filename, iam, idata, dname, whead, wdata, file_ind, rc) + subroutine med_io_write_int(filename, idata, dname, whead, wdata, file_ind, rc) use pio, only : var_desc_t, pio_def_var, pio_put_att, pio_int, pio_inq_varid, pio_put_var @@ -1123,11 +1115,10 @@ subroutine med_io_write_int(filename, iam, idata, dname, whead, wdata, file_ind, ! intput/output variables character(len=*) ,intent(in) :: filename ! file - integer ,intent(in) :: iam ! local pet integer ,intent(in) :: idata ! data to be written character(len=*) ,intent(in) :: dname ! name of data - logical,optional ,intent(in) :: whead ! write header - logical,optional ,intent(in) :: wdata ! write data + logical ,intent(in) :: whead ! write header + logical ,intent(in) :: wdata ! write data integer,optional ,intent(in) :: file_ind integer ,intent(out):: rc @@ -1135,27 +1126,16 @@ subroutine med_io_write_int(filename, iam, idata, dname, whead, wdata, file_ind, integer :: rcode type(var_desc_t) :: varid character(CL) :: cunit ! var units - logical :: lwhead, lwdata integer :: lfile_ind character(*),parameter :: subName = '(med_io_write_int) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - lwhead = .true. - lwdata = .true. - if (present(whead)) lwhead = whead - if (present(wdata)) lwdata = wdata - - if (.not.lwhead .and. .not.lwdata) then - ! should we write a warning? - return - endif - lfile_ind = 0 if (present(file_ind)) lfile_ind=file_ind - if (lwhead) then + if (whead) then if (NUOPC_FieldDictionaryHasEntry(trim(dname))) then call NUOPC_FieldDictionaryGetEntry(dname, canonicalUnits=cunit, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -1163,19 +1143,16 @@ subroutine med_io_write_int(filename, iam, idata, dname, whead, wdata, file_ind, end if rcode = pio_def_var(io_file(lfile_ind),trim(dname),PIO_INT,varid) rcode = pio_put_att(io_file(lfile_ind),varid,"standard_name",trim(dname)) - if (lwdata) call med_io_enddef(filename, file_ind=lfile_ind) endif - - if (lwdata) then + if (wdata) then rcode = pio_inq_varid(io_file(lfile_ind),trim(dname),varid) rcode = pio_put_var(io_file(lfile_ind),varid,idata) - ! write(logunit,*) subname,' wrote AV ',trim(dname),lwhead,lwdata endif end subroutine med_io_write_int !=============================================================================== - subroutine med_io_write_int1d(filename, iam, idata, dname, whead, wdata, file_ind, rc) + subroutine med_io_write_int1d(filename, idata, dname, whead, wdata, file_ind, rc) !--------------- ! Write 1d integer array to netcdf file @@ -1186,14 +1163,13 @@ subroutine med_io_write_int1d(filename, iam, idata, dname, whead, wdata, file_in use pio , only : pio_int, pio_def_var ! input/output arguments - character(len=*),intent(in) :: filename ! file - integer ,intent(in) :: iam ! local pet - integer ,intent(in) :: idata(:) ! data to be written - character(len=*),intent(in) :: dname ! name of data - logical,optional,intent(in) :: whead ! write header - logical,optional,intent(in) :: wdata ! write data - integer,optional,intent(in) :: file_ind - integer , intent(out) :: rc + character(len=*) ,intent(in) :: filename ! file + integer ,intent(in) :: idata(:) ! data to be written + character(len=*) ,intent(in) :: dname ! name of data + logical ,intent(in) :: whead ! write header + logical ,intent(in) :: wdata ! write data + integer,optional ,intent(in) :: file_ind + integer , intent(out):: rc ! local variables integer :: rcode @@ -1203,27 +1179,16 @@ subroutine med_io_write_int1d(filename, iam, idata, dname, whead, wdata, file_in character(CL) :: lname ! long name character(CL) :: sname ! standard name integer :: lnx - logical :: lwhead, lwdata integer :: lfile_ind character(*),parameter :: subName = '(med_io_write_int1d) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - lwhead = .true. - lwdata = .true. - if (present(whead)) lwhead = whead - if (present(wdata)) lwdata = wdata - - if (.not.lwhead .and. .not.lwdata) then - ! should we write a warning? - return - endif - lfile_ind = 0 if (present(file_ind)) lfile_ind=file_ind - if (lwhead) then + if (whead) then if (NUOPC_FieldDictionaryHasEntry(trim(dname))) then call NUOPC_FieldDictionaryGetEntry(dname, canonicalUnits=cunit, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -1233,20 +1198,15 @@ subroutine med_io_write_int1d(filename, iam, idata, dname, whead, wdata, file_in rcode = pio_def_dim(io_file(lfile_ind),trim(dname),lnx,dimid(1)) rcode = pio_def_var(io_file(lfile_ind),trim(dname),PIO_INT,dimid,varid) rcode = pio_put_att(io_file(lfile_ind),varid,"standard_name",trim(dname)) - if (lwdata) call med_io_enddef(filename, file_ind=lfile_ind) - endif - - if (lwdata) then + else if (wdata) then rcode = pio_inq_varid(io_file(lfile_ind),trim(dname),varid) rcode = pio_put_var(io_file(lfile_ind),varid,idata) endif - ! write(logunit,*) subname,' wrote AV ',trim(dname),lwhead,lwdata - end subroutine med_io_write_int1d !=============================================================================== - subroutine med_io_write_r8(filename, iam, rdata, dname, whead, wdata, file_ind, rc) + subroutine med_io_write_r8(filename, rdata, dname, whead, wdata, file_ind, rc) !--------------- ! Write scalar double to netcdf file @@ -1256,39 +1216,25 @@ subroutine med_io_write_r8(filename, iam, rdata, dname, whead, wdata, file_ind, use pio , only : pio_double, pio_noerr, pio_inq_varid, pio_put_var ! input/output arguments - character(len=*),intent(in) :: filename ! file - integer ,intent(in) :: iam ! local pet - real(r8) ,intent(in) :: rdata ! data to be written - character(len=*),intent(in) :: dname ! name of data - logical,optional,intent(in) :: whead ! write header - logical,optional,intent(in) :: wdata ! write data - integer,optional,intent(in) :: file_ind - integer ,intent(out):: rc + character(len=*) ,intent(in) :: filename ! file + real(r8) ,intent(in) :: rdata ! data to be written + character(len=*) ,intent(in) :: dname ! name of data + logical ,intent(in) :: whead ! write header + logical ,intent(in) :: wdata ! write data + integer,optional ,intent(in) :: file_ind + integer ,intent(out):: rc ! local variables integer :: rcode type(var_desc_t) :: varid character(CL) :: cunit ! var units - logical :: lwhead, lwdata integer :: lfile_ind character(*),parameter :: subName = '(med_io_write_r8) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - lwhead = .true. - if (present(whead)) lwhead = whead - lwdata = .true. - if (present(wdata)) lwdata = wdata - lfile_ind = 0 - if (present(file_ind)) lfile_ind=file_ind - - if (.not.lwhead .and. .not.lwdata) then - ! should we write a warning? - return - endif - - if (lwhead) then + if (whead) then rcode = pio_def_var(io_file(lfile_ind),trim(dname),PIO_DOUBLE,varid) if (rcode==PIO_NOERR) then if (NUOPC_FieldDictionaryHasEntry(trim(dname))) then @@ -1297,11 +1243,8 @@ subroutine med_io_write_r8(filename, iam, rdata, dname, whead, wdata, file_ind, rcode = pio_put_att(io_file(lfile_ind),varid,"units",trim(cunit)) end if rcode = pio_put_att(io_file(lfile_ind),varid,"standard_name",trim(dname)) - if (lwdata) call med_io_enddef(filename, file_ind=lfile_ind) end if - endif - - if (lwdata) then + else if (wdata) then rcode = pio_inq_varid(io_file(lfile_ind),trim(dname),varid) rcode = pio_put_var(io_file(lfile_ind),varid,rdata) endif @@ -1309,7 +1252,7 @@ subroutine med_io_write_r8(filename, iam, rdata, dname, whead, wdata, file_ind, end subroutine med_io_write_r8 !=============================================================================== - subroutine med_io_write_r81d(filename, iam, rdata, dname, whead, wdata, file_ind, rc) + subroutine med_io_write_r81d(filename, rdata, dname, whead, wdata, file_ind, rc) !--------------- ! Write 1d double array to netcdf file @@ -1319,14 +1262,13 @@ subroutine med_io_write_r81d(filename, iam, rdata, dname, whead, wdata, file_ind use pio , only : pio_inq_varid, pio_put_var, pio_double, pio_put_att ! !INPUT/OUTPUT PARAMETERS: - character(len=*),intent(in) :: filename ! file - integer ,intent(in) :: iam - real(r8) ,intent(in) :: rdata(:) ! data to be written - character(len=*),intent(in) :: dname ! name of data - logical,optional,intent(in) :: whead ! write header - logical,optional,intent(in) :: wdata ! write data - integer,optional,intent(in) :: file_ind - integer ,intent(out):: rc + character(len=*) ,intent(in) :: filename ! file + real(r8) ,intent(in) :: rdata(:) ! data to be written + character(len=*) ,intent(in) :: dname ! name of data + logical ,intent(in) :: whead ! write header + logical ,intent(in) :: wdata ! write data + integer,optional ,intent(in) :: file_ind + integer ,intent(out):: rc ! local variables integer :: rcode @@ -1334,26 +1276,13 @@ subroutine med_io_write_r81d(filename, iam, rdata, dname, whead, wdata, file_ind type(var_desc_t) :: varid character(CL) :: cunit ! var units integer :: lnx - logical :: lwhead, lwdata integer :: lfile_ind character(*),parameter :: subName = '(med_io_write_r81d) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - lwhead = .true. - if (present(whead)) lwhead = whead - lwdata = .true. - if (present(wdata)) lwdata = wdata - lfile_ind = 0 - if (present(file_ind)) lfile_ind=file_ind - - if (.not.lwhead .and. .not.lwdata) then - ! should we write a warning? - return - endif - - if (lwhead) then + if (whead) then lnx = size(rdata) rcode = pio_def_dim(io_file(lfile_ind),trim(dname)//'_nx',lnx,dimid(1)) rcode = pio_def_var(io_file(lfile_ind),trim(dname),PIO_DOUBLE,dimid,varid) @@ -1363,10 +1292,9 @@ subroutine med_io_write_r81d(filename, iam, rdata, dname, whead, wdata, file_ind rcode = pio_put_att(io_file(lfile_ind),varid,"units",trim(cunit)) end if rcode = pio_put_att(io_file(lfile_ind),varid,"standard_name",trim(dname)) - if (lwdata) call med_io_enddef(filename, file_ind=lfile_ind) endif - if (lwdata) then + if (wdata) then rcode = pio_inq_varid(io_file(lfile_ind),trim(dname),varid) rcode = pio_put_var(io_file(lfile_ind),varid,rdata) endif @@ -1374,7 +1302,7 @@ subroutine med_io_write_r81d(filename, iam, rdata, dname, whead, wdata, file_ind end subroutine med_io_write_r81d !=============================================================================== - subroutine med_io_write_char(filename, iam, rdata, dname, whead, wdata, file_ind, rc) + subroutine med_io_write_char(filename, rdata, dname, whead, wdata, file_ind, rc) !--------------- ! Write char string to netcdf file @@ -1384,14 +1312,13 @@ subroutine med_io_write_char(filename, iam, rdata, dname, whead, wdata, file_ind use pio , only : pio_char, pio_put_var ! input/output arguments - character(len=*),intent(in) :: filename ! file - integer ,intent(in) :: iam ! local pet - character(len=*),intent(in) :: rdata ! data to be written - character(len=*),intent(in) :: dname ! name of data - logical,optional,intent(in) :: whead ! write header - logical,optional,intent(in) :: wdata ! write data - integer,optional,intent(in) :: file_ind - integer ,intent(out):: rc + character(len=*) ,intent(in) :: filename ! file + character(len=*) ,intent(in) :: rdata ! data to be written + character(len=*) ,intent(in) :: dname ! name of data + logical ,intent(in) :: whead ! write header + logical ,intent(in) :: wdata ! write data + integer,optional ,intent(in) :: file_ind + integer ,intent(out):: rc ! local variables integer :: rcode @@ -1401,7 +1328,6 @@ subroutine med_io_write_char(filename, iam, rdata, dname, whead, wdata, file_ind character(CL) :: lname ! long name character(CL) :: sname ! standard name integer :: lnx - logical :: lwhead, lwdata integer :: lfile_ind character(CL) :: charvar ! buffer for string read/write character(*),parameter :: subName = '(med_io_write_char) ' @@ -1409,18 +1335,7 @@ subroutine med_io_write_char(filename, iam, rdata, dname, whead, wdata, file_ind rc = ESMF_SUCCESS - lwhead = .true. - if (present(whead)) lwhead = whead - lwdata = .true. - if (present(wdata)) lwdata = wdata - lfile_ind = 0 - if (present(file_ind)) lfile_ind=file_ind - if (.not.lwhead .and. .not.lwdata) then - ! should we write a warning? - return - endif - - if (lwhead) then + if (whead) then lnx = len(charvar) rcode = pio_def_dim(io_file(lfile_ind),trim(dname)//'_len',lnx,dimid(1)) rcode = pio_def_var(io_file(lfile_ind),trim(dname),PIO_CHAR,dimid,varid) @@ -1429,9 +1344,7 @@ subroutine med_io_write_char(filename, iam, rdata, dname, whead, wdata, file_ind if (chkerr(rc,__LINE__,u_FILE_u)) return end if rcode = pio_put_att(io_file(lfile_ind),varid,"standard_name",trim(dname)) - if (lwdata) call med_io_enddef(filename, file_ind=lfile_ind) - endif - if (lwdata) then + else if (wdata) then charvar = '' charvar = trim(rdata) rcode = pio_inq_varid(io_file(lfile_ind),trim(dname),varid) @@ -1441,119 +1354,119 @@ subroutine med_io_write_char(filename, iam, rdata, dname, whead, wdata, file_ind end subroutine med_io_write_char !=============================================================================== - subroutine med_io_write_time(filename, iam, time_units, calendar, time_val, nt,& - whead, wdata, tbnds, file_ind, rc) + subroutine med_io_define_time(time_units, calendar, file_ind, rc) - !--------------- - ! Write time variable to netcdf file - !--------------- - - use ESMF, only : operator(==) - use ESMF, only : ESMF_Calendar + use ESMF, only : operator(==), operator(/=) + use ESMF, only : ESMF_Calendar, ESMF_CalendarIsCreated use ESMF, only : ESMF_CALKIND_360DAY, ESMF_CALKIND_GREGORIAN use ESMF, only : ESMF_CALKIND_JULIAN, ESMF_CALKIND_JULIANDAY, ESMF_CALKIND_MODJULIANDAY use ESMF, only : ESMF_CALKIND_NOCALENDAR, ESMF_CALKIND_NOLEAP + use ESMF, only : ESMF_LOGMSG_ERROR, ESMF_FAILURE use pio , only : var_desc_t, PIO_UNLIMITED use pio , only : pio_double, pio_def_dim, pio_def_var, pio_put_att use pio , only : pio_inq_varid, pio_put_var ! input/output variables - character(len=*) , intent(in) :: filename ! file - integer , intent(in) :: iam ! local pet - character(len=*) , intent(in) :: time_units ! units of time - type(ESMF_Calendar) , intent(in) :: calendar ! calendar - real(r8) , intent(in) :: time_val ! data to be written - integer , optional, intent(in) :: nt - logical , optional, intent(in) :: whead ! write header - logical , optional, intent(in) :: wdata ! write data - real(r8) , optional, intent(in) :: tbnds(2) ! time bounds - integer , optional, intent(in) :: file_ind - integer , intent(out):: rc + character(len=*) , intent(in) :: time_units ! units of time + type(ESMF_Calendar) , intent(in) :: calendar ! calendar + integer, optional , intent(in) :: file_ind + integer , intent(out):: rc ! local variables integer :: rcode integer :: dimid(1) integer :: dimid2(2) type(var_desc_t) :: varid - logical :: lwhead, lwdata - integer :: start(4),count(4) - real(r8) :: time_val_1d(1) integer :: lfile_ind character(CL) :: calname ! calendar name - character(*),parameter :: subName = '(med_io_write_time) ' + character(*),parameter :: subName = '(med_io_define_time) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - lwhead = .true. - if (present(whead)) lwhead = whead - lwdata = .true. - if (present(wdata)) lwdata = wdata lfile_ind = 0 if (present(file_ind)) lfile_ind=file_ind - if (.not.lwhead .and. .not.lwdata) then - ! should we write a warning? + + if (.not. ESMF_CalendarIsCreated(calendar)) then + call ESMF_LogWrite(trim(subname)//' ERROR: calendar is not created ', & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE return - endif + end if - ! Write out header - if (lwhead) then - rcode = pio_def_dim(io_file(lfile_ind),'time',PIO_UNLIMITED,dimid(1)) - rcode = pio_def_var(io_file(lfile_ind),'time',PIO_DOUBLE,dimid,varid) - rcode = pio_put_att(io_file(lfile_ind),varid,'units',trim(time_units)) - - if (calendar == ESMF_CALKIND_360DAY) then - calname = '360_day' - else if (calendar == ESMF_CALKIND_GREGORIAN) then - calname = 'gregorian' - else if (calendar == ESMF_CALKIND_JULIAN) then - calname = 'julian' - else if (calendar == ESMF_CALKIND_JULIANDAY) then - calname = 'ESMF_CALKIND_JULIANDAY' - else if (calendar == ESMF_CALKIND_MODJULIANDAY) then - calname = 'ESMF_CALKIND_MODJULIANDAY' - else if (calendar == ESMF_CALKIND_NOCALENDAR) then - calname = 'none' - else if (calendar == ESMF_CALKIND_NOLEAP) then - calname = 'noleap' - end if - rcode = pio_put_att(io_file(lfile_ind),varid,'calendar',trim(calname)) + ! define time and add calendar attribute + rcode = pio_def_dim(io_file(lfile_ind), 'time', PIO_UNLIMITED, dimid(1)) + rcode = pio_def_var(io_file(lfile_ind), 'time', PIO_DOUBLE, dimid, varid) + rcode = pio_put_att(io_file(lfile_ind), varid, 'units', trim(time_units)) + if (calendar == ESMF_CALKIND_360DAY) then + calname = '360_day' + else if (calendar == ESMF_CALKIND_GREGORIAN) then + calname = 'gregorian' + else if (calendar == ESMF_CALKIND_JULIAN) then + calname = 'julian' + else if (calendar == ESMF_CALKIND_JULIANDAY) then + calname = 'ESMF_CALKIND_JULIANDAY' + else if (calendar == ESMF_CALKIND_MODJULIANDAY) then + calname = 'ESMF_CALKIND_MODJULIANDAY' + else if (calendar == ESMF_CALKIND_NOCALENDAR) then + calname = 'none' + else if (calendar == ESMF_CALKIND_NOLEAP) then + calname = 'noleap' + end if + rcode = pio_put_att(io_file(lfile_ind), varid, 'calendar', trim(calname)) - if (present(tbnds)) then - dimid2(2) = dimid(1) - rcode = pio_put_att(io_file(lfile_ind),varid,'bounds','time_bnds') - rcode = pio_def_dim(io_file(lfile_ind),'ntb',2,dimid2(1)) - rcode = pio_def_var(io_file(lfile_ind),'time_bnds',PIO_DOUBLE,dimid2,varid) - endif - if (lwdata) call med_io_enddef(filename, file_ind=lfile_ind) - endif + ! define time bounds + dimid2(2) = dimid(1) + rcode = pio_def_dim(io_file(lfile_ind), 'ntb', 2, dimid2(1)) + rcode = pio_def_var(io_file(lfile_ind), 'time_bnds', PIO_DOUBLE, dimid2, varid) + rcode = pio_put_att(io_file(lfile_ind), varid, 'bounds', 'time_bnds') - ! Write out data - if (lwdata) then - start = 1 - count = 1 - if (present(nt)) then - start(1) = nt - endif - time_val_1d(1) = time_val - rcode = pio_inq_varid(io_file(lfile_ind),'time',varid) - rcode = pio_put_var(io_file(lfile_ind),varid,start,count,time_val_1d) - if (present(tbnds)) then - rcode = pio_inq_varid(io_file(lfile_ind),'time_bnds',varid) - start = 1 - count = 1 - if (present(nt)) then - start(2) = nt - endif - count(1) = 2 - rcode = pio_put_var(io_file(lfile_ind),varid,start,count,tbnds) - endif - endif + end subroutine med_io_define_time + + !=============================================================================== + subroutine med_io_write_time(time_val, tbnds, nt, file_ind, rc) + + !--------------- + ! Write time variable to netcdf file + !--------------- + + use pio, only : pio_put_att, pio_inq_varid, pio_put_var + + ! input/output variables + real(r8) , intent(in) :: time_val ! data to be written + real(r8) , intent(in) :: tbnds(2) ! time bounds + integer , intent(in) :: nt + integer , optional, intent(in) :: file_ind + integer , intent(out):: rc + + ! local variables + integer :: rcode + integer :: lfile_ind + integer :: varid + integer :: start(2),count(2) + character(*),parameter :: subName = '(med_io_write_time) ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + lfile_ind = 0 + if (present(file_ind)) lfile_ind=file_ind + + ! write time + count = 1; start = nt + rcode = pio_inq_varid(io_file(lfile_ind), 'time', varid) + rcode = pio_put_var(io_file(lfile_ind), varid, start(1:1), count(1:1), (/time_val/)) + + ! write time bounds + rcode = pio_inq_varid(io_file(lfile_ind), 'time_bnds', varid) + start(1) = 1; start(2) = nt + count(1) = 2; count(2) = 1 + rcode = pio_put_var(io_file(lfile_ind), varid, start(1:2), count(1:2), tbnds) end subroutine med_io_write_time !=============================================================================== - subroutine med_io_read_FB(filename, vm, iam, FB, pre, frame, rc) + subroutine med_io_read_FB(filename, vm, FB, pre, frame, rc) !--------------- ! Read FB from netcdf file @@ -1573,7 +1486,6 @@ subroutine med_io_read_FB(filename, vm, iam, FB, pre, frame, rc) ! input/output arguments character(len=*) ,intent(in) :: filename ! file type(ESMF_VM) ,intent(in) :: vm - integer ,intent(in) :: iam type(ESMF_FieldBundle) ,intent(in) :: FB ! data to be read character(len=*) ,optional ,intent(in) :: pre ! prefix to variable name integer(kind=PIO_OFFSET_KIND) ,optional ,intent(in) :: frame @@ -1640,13 +1552,13 @@ subroutine med_io_read_FB(filename, vm, iam, FB, pre, frame, rc) return endif - if (med_io_file_exists(vm, iam, trim(filename))) then + if (med_io_file_exists(vm, trim(filename))) then rcode = pio_openfile(io_subsystem, pioid, pio_iotype, trim(filename),pio_nowrite) call ESMF_LogWrite(trim(subname)//' open file '//trim(filename), ESMF_LOGMSG_INFO) if (chkerr(rc,__LINE__,u_FILE_u)) return else call ESMF_LogWrite(trim(subname)//' ERROR: file invalid '//trim(filename), & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) rc = ESMF_FAILURE return endif @@ -1826,16 +1738,12 @@ subroutine med_io_read_init_iodesc(FB, name1, pioid, iodesc, rc) write(tmpstr,*) trim(subname),' lny = ',lny call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) ng = lnx * lny - call FB_getFieldN(FB, 1, field, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, mesh=mesh, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_MeshGet(mesh, elementDistgrid=distgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_DistGridGet(distgrid, dimCount=dimCount, tileCount=tileCount, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -1843,8 +1751,6 @@ subroutine med_io_read_init_iodesc(FB, name1, pioid, iodesc, rc) call ESMF_DistGridGet(distgrid, minIndexPTile=minIndexPTile, & maxIndexPTile=maxIndexPTile, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - !write(tmpstr,*) subname,' counts = ',dimcount,tilecount,minindexptile,maxindexptile - !call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) if (ng > maxval(maxIndexPTile)) then write(tmpstr,*) subname,' WARNING: dimensions do not match', lnx, lny, maxval(maxIndexPTile) @@ -1872,7 +1778,7 @@ subroutine med_io_read_init_iodesc(FB, name1, pioid, iodesc, rc) end subroutine med_io_read_init_iodesc !=============================================================================== - subroutine med_io_read_int(filename, vm, iam, idata, dname, rc) + subroutine med_io_read_int(filename, vm, idata, dname, rc) !--------------- ! Read scalar integer from netcdf file @@ -1881,7 +1787,6 @@ subroutine med_io_read_int(filename, vm, iam, idata, dname, rc) ! input/output arguments character(len=*) , intent(in) :: filename ! file type(ESMF_VM) :: vm - integer , intent(in) :: iam integer , intent(inout) :: idata ! integer data character(len=*) , intent(in) :: dname ! name of data integer , intent(out) :: rc @@ -1892,14 +1797,14 @@ subroutine med_io_read_int(filename, vm, iam, idata, dname, rc) !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call med_io_read_int1d(filename, vm, iam, i1d, dname, rc) + call med_io_read_int1d(filename, vm, i1d, dname, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return idata = i1d(1) end subroutine med_io_read_int !=============================================================================== - subroutine med_io_read_int1d(filename, vm, iam, idata, dname, rc) + subroutine med_io_read_int1d(filename, vm, idata, dname, rc) !--------------- ! Read 1d integer array from netcdf file @@ -1913,7 +1818,6 @@ subroutine med_io_read_int1d(filename, vm, iam, idata, dname, rc) ! input/output arguments character(len=*), intent(in) :: filename ! file type(ESMF_VM) :: vm - integer, intent(in) :: iam integer , intent(inout) :: idata(:) ! integer data character(len=*), intent(in) :: dname ! name of data integer , intent(out) :: rc @@ -1924,6 +1828,7 @@ subroutine med_io_read_int1d(filename, vm, iam, idata, dname, rc) type(var_desc_t) :: varid character(CL) :: lversion character(CL) :: name1 + integer :: iam character(*),parameter :: subName = '(med_io_read_int1d) ' !------------------------------------------------------------------------------- @@ -1931,7 +1836,10 @@ subroutine med_io_read_int1d(filename, vm, iam, idata, dname, rc) lversion=trim(version) - if (med_io_file_exists(vm, iam, filename)) then + call ESMF_VMGet(vm, localPet=iam, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (med_io_file_exists(vm, filename)) then rcode = pio_openfile(io_subsystem, pioid, pio_iotype, trim(filename),pio_nowrite) call pio_seterrorhandling(pioid,PIO_BCAST_ERROR) rcode = pio_get_att(pioid,pio_global,"file_version",lversion) @@ -1955,7 +1863,7 @@ subroutine med_io_read_int1d(filename, vm, iam, idata, dname, rc) end subroutine med_io_read_int1d !=============================================================================== - subroutine med_io_read_r8(filename, vm, iam, rdata, dname, rc) + subroutine med_io_read_r8(filename, vm, rdata, dname, rc) !--------------- ! Read scalar double from netcdf file @@ -1964,7 +1872,6 @@ subroutine med_io_read_r8(filename, vm, iam, rdata, dname, rc) ! input/output arguments character(len=*) , intent(in) :: filename ! file type(ESMF_VM) :: vm - integer , intent(in) :: iam real(r8) , intent(inout) :: rdata ! real data character(len=*) , intent(in) :: dname ! name of data integer , intent(out) :: rc @@ -1975,7 +1882,7 @@ subroutine med_io_read_r8(filename, vm, iam, rdata, dname, rc) !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call med_io_read_r81d(filename, vm, iam, r1d,dname, rc) + call med_io_read_r81d(filename, vm, r1d,dname, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return rdata = r1d(1) @@ -1983,7 +1890,7 @@ subroutine med_io_read_r8(filename, vm, iam, rdata, dname, rc) end subroutine med_io_read_r8 !=============================================================================== - subroutine med_io_read_r81d(filename, vm, iam, rdata, dname, rc) + subroutine med_io_read_r81d(filename, vm, rdata, dname, rc) !--------------- ! Read 1d double array from netcdf file @@ -1996,7 +1903,6 @@ subroutine med_io_read_r81d(filename, vm, iam, rdata, dname, rc) ! input/output arguments character(len=*), intent(in) :: filename ! file type(ESMF_VM) :: vm - integer , intent(in) :: iam real(r8) , intent(inout) :: rdata(:) ! real data character(len=*), intent(in) :: dname ! name of data integer , intent(out) :: rc @@ -2007,6 +1913,7 @@ subroutine med_io_read_r81d(filename, vm, iam, rdata, dname, rc) type(var_desc_t) :: varid character(CL) :: lversion character(CL) :: name1 + integer :: iam character(*),parameter :: subName = '(med_io_read_r81d) ' !------------------------------------------------------------------------------- @@ -2014,7 +1921,10 @@ subroutine med_io_read_r81d(filename, vm, iam, rdata, dname, rc) lversion=trim(version) - if (med_io_file_exists(vm, iam, filename)) then + call ESMF_VMGet(vm, localPet=iam, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (med_io_file_exists(vm, filename)) then rcode = pio_openfile(io_subsystem, pioid, pio_iotype, trim(filename),pio_nowrite) call pio_seterrorhandling(pioid,PIO_BCAST_ERROR) rcode = pio_get_att(pioid,pio_global,"file_version",lversion) @@ -2038,7 +1948,7 @@ subroutine med_io_read_r81d(filename, vm, iam, rdata, dname, rc) end subroutine med_io_read_r81d !=============================================================================== - subroutine med_io_read_char(filename, vm, iam, rdata, dname, rc) + subroutine med_io_read_char(filename, vm, rdata, dname, rc) !--------------- ! Read char string from netcdf file @@ -2051,7 +1961,6 @@ subroutine med_io_read_char(filename, vm, iam, rdata, dname, rc) ! input/output arguments character(len=*), intent(in) :: filename ! file type(ESMF_VM) :: vm - integer, intent(in) :: iam character(len=*), intent(inout) :: rdata ! character data character(len=*), intent(in) :: dname ! name of data integer , intent(out) :: rc @@ -2062,6 +1971,7 @@ subroutine med_io_read_char(filename, vm, iam, rdata, dname, rc) type(var_desc_t) :: varid character(CL) :: lversion character(CL) :: name1 + integer :: iam character(CL) :: charvar ! buffer for string read/write character(*),parameter :: subName = '(med_io_read_char) ' !------------------------------------------------------------------------------- @@ -2070,7 +1980,10 @@ subroutine med_io_read_char(filename, vm, iam, rdata, dname, rc) lversion=trim(version) - if (med_io_file_exists(vm, iam, filename)) then + call ESMF_VMGet(vm, localPet=iam, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (med_io_file_exists(vm, filename)) then rcode = pio_openfile(io_subsystem, pioid, pio_iotype, trim(filename),pio_nowrite) ! write(logunit,*) subname,' open file ',trim(filename) call pio_seterrorhandling(pioid,PIO_BCAST_ERROR) diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index cc8e7718..b556eafa 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -47,7 +47,7 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun !--------------------------------------------- ! Initialize route handles in the mediator and also - ! nitialize unity normalization fields and do the mapping for + ! initialize unity normalization fields and do the mapping for ! unity normalization up front ! ! Assumptions: diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index 3da64e41..42382d3d 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -236,6 +236,7 @@ subroutine med_phases_aofluxes_run(gcomp, rc) use NUOPC , only : NUOPC_CompAttributeGet use ESMF , only : ESMF_FieldBundleIsCreated use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose + use med_phases_history_mod, only : med_phases_history_write_med ! input/output variables type(ESMF_GridComp) :: gcomp @@ -287,6 +288,10 @@ subroutine med_phases_aofluxes_run(gcomp, rc) call med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Write mediator aofluxes + call med_phases_history_write_med(gcomp, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 1) then call FB_diagnose(is_local%wrap%FBMed_aoflux_o, & string=trim(subname) //' FBAMed_aoflux_o' , rc=rc) diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 75ecc63f..e47fbf60 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -2,46 +2,121 @@ module med_phases_history_mod !----------------------------------------------------------------------------- ! Mediator History control - ! - ! Each time loop has its own associated clock object. NUOPC manages - ! these clock objects, i.e. their creation and destruction, as well as - ! startTime, endTime, timeStep adjustments during the execution. The - ! outer most time loop of the run sequence is a special case. It uses - ! the driver clock itself. If a single outer most loop is defined in - ! the run sequence provided by freeFormat, this loop becomes the driver - ! loop level directly. Therefore, setting the timeStep or runDuration - ! for the outer most time loop results modifiying the driver clock - ! itself. However, for cases with concatenated loops on the upper level - ! of the run sequence in freeFormat, a single outer loop is added - ! automatically during ingestion, and the driver clock is used for this - ! loop instead. !----------------------------------------------------------------------------- use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 - use ESMF , only : ESMF_Alarm - use med_constants_mod , only : dbug_flag => med_constants_dbug_flag - use med_constants_mod , only : SecPerDay => med_constants_SecPerDay - use med_utils_mod , only : chkerr => med_utils_ChkErr - use med_methods_mod , only : FB_reset => med_methods_FB_reset - use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose - use med_methods_mod , only : State_GetScalar => med_methods_State_GetScalar + use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_VM + use ESMF , only : ESMF_Clock, ESMF_ClockGet, ESMF_ClockSet, ESMF_ClockAdvance + use ESMF , only : ESMF_ClockGetNextTime, ESMF_ClockGetAlarm, ESMF_ClockIsCreated + use ESMF , only : ESMF_Calendar, ESMF_Time, ESMF_TimeGet + use ESMF , only : ESMF_TimeInterval, ESMF_TimeIntervalGet, ESMF_TimeIntervalSet + use ESMF , only : ESMF_Alarm, ESMF_AlarmIsRinging, ESMF_AlarmRingerOff, ESMF_AlarmGet + use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LOGMSG_ERROR, ESMF_LogFoundError + use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE, ESMF_MAXSTR, ESMF_LOGERR_PASSTHRU, ESMF_END_ABORT + use ESMF , only : ESMF_Finalize + use ESMF , only : operator(-), operator(+) + use NUOPC , only : NUOPC_CompAttributeGet + use NUOPC_Model , only : NUOPC_ModelGet + use esmFlds , only : ncomps, compname + use med_utils_mod , only : chkerr => med_utils_ChkErr use med_internalstate_mod , only : InternalState, mastertask, logunit use med_time_mod , only : med_time_alarmInit - use med_io_mod , only : med_io_write, med_io_wopen, med_io_enddef - use med_io_mod , only : med_io_close, med_io_date2yyyymmdd, med_io_sec2hms - use med_io_mod , only : med_io_ymd2date + use med_io_mod , only : med_io_write, med_io_wopen, med_io_enddef, med_io_close use perf_mod , only : t_startf, t_stopf - use esmFlds , only : ncomps implicit none private - public :: med_phases_history_alarm_init - public :: med_phases_history_write - - ! type(ESMF_Alarm) :: alarm_hist_inst - ! type(ESMF_Alarm) :: alarm_hist_avg - + ! Public routine called from the run sequence + public :: med_phases_history_write ! inst only - for all variables + + ! Public routines called from post phases + public :: med_phases_history_write_comp ! inst, avg, aux for component + public :: med_phases_history_write_med ! inst only, med aoflux and ocn albedoes + public :: med_phases_history_write_lnd2glc ! inst only, yearly average of lnd->glc data on lnd grid + + ! Private routines + private :: med_phases_history_write_comp_inst ! write instantaneous file for a given component + private :: med_phases_history_write_comp_avg ! write averaged file for a given component + private :: med_phases_history_write_comp_aux ! write auxiliary file for a given component + private :: med_phases_history_init_histclock + private :: med_phases_history_query_ifwrite + private :: med_phases_history_set_timeinfo + private :: med_phases_history_fldbun_accum + private :: med_phases_history_fldbun_average + + ! ---------------------------- + ! Instantaneous history files datatypes/variables + ! ---------------------------- + type, public :: instfile_type + logical :: write_inst + character(CS) :: hist_option + integer :: hist_n + type(ESMF_Clock) :: clock + type(ESMF_Alarm) :: alarm + character(CS) :: alarmname + logical :: is_clockset = .false. + logical :: is_active = .false. + end type instfile_type + type(instfile_type) , public :: instfiles(ncomps) + + ! ---------------------------- + ! Time averaging history files + ! ---------------------------- + type, public :: avgfile_type + logical :: write_avg + type(ESMF_FieldBundle) :: FBaccum_import ! field bundle for time averaging + integer :: accumcnt_import ! field bundle accumulation counter + type(ESMF_FieldBundle) :: FBaccum_export ! field bundle for time averaging + integer :: accumcnt_export ! field bundle accumulation counter + character(CS) :: hist_option + integer :: hist_n + type(ESMF_Clock) :: clock + type(ESMF_Alarm) :: alarm + character(CS) :: alarmname + logical :: is_clockset = .false. + logical :: is_active = .false. + end type avgfile_type + type(avgfile_type) :: avgfiles(ncomps) + + ! ---------------------------- + ! Auxiliary history files + ! ---------------------------- + type, public :: auxfile_type + character(CS), allocatable :: flds(:) ! array of aux field names + character(CS) :: auxname ! name for history file creation + character(CL) :: histfile = '' ! current history file name + integer :: ntperfile ! maximum number of time samples per file + integer :: nt = 0 ! time in file + logical :: doavg ! if true, time average, otherwise instantaneous + type(ESMF_FieldBundle) :: FBaccum ! field bundle for time averaging + integer :: accumcnt ! field bundle accumulation counter + type(ESMF_Clock) :: clock ! auxiliary history clock + type(ESMF_Alarm) :: alarm ! auxfile alarm + character(CS) :: alarmname ! name of write alarm + end type auxfile_type + + integer, parameter :: max_auxfiles = 10 + type, public :: auxcomp_type + type(auxfile_type) :: files(max_auxfiles) + integer :: num_auxfiles = 0 ! actual number of auxiliary files + logical :: init_auxfiles = .false. ! if auxfile initial has occured + end type auxcomp_type + type(auxcomp_type) , public :: auxcomp(ncomps) + + !logical :: init_auxfiles(ncomps) = .false. ! if true, auxfiles has been initialized for the component + + ! ---------------------------- + ! Other private module variables + ! ---------------------------- + + logical :: whead(2) = (/.true. , .false./) + logical :: wdata(2) = (/.false., .true. /) + + character(CL) :: case_name = 'unset' ! case name + character(CS) :: inst_tag = 'unset' ! instance tag + logical :: debug_alarms = .true. character(*), parameter :: u_FILE_u = & __FILE__ @@ -49,429 +124,1641 @@ module med_phases_history_mod contains !=============================================================================== - subroutine med_phases_history_alarm_init(gcomp, rc) + subroutine med_phases_history_write(gcomp, rc) ! -------------------------------------- - ! Initialize mediator history file alarms (module variables) + ! Write instantaneous mediator history file for all variables ! -------------------------------------- - use ESMF , only : ESMF_GridComp, ESMF_GridCompGet - use ESMF , only : ESMF_Clock, ESMF_ClockGet, ESMF_ClockAdvance, ESMF_ClockSet - use ESMF , only : ESMF_Time - use ESMF , only : ESMF_TimeInterval, ESMF_TimeIntervalGet - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LOGMSG_ERROR - use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE - use ESMF , only : operator(==), operator(-) - use ESMF , only : ESMF_ALARMLIST_ALL, ESMF_Alarm, ESMF_AlarmSet - use NUOPC , only : NUOPC_CompAttributeGet - use NUOPC_Model, only : NUOPC_ModelGet + use med_io_mod, only : med_io_write_time, med_io_define_time + use ESMF , only : ESMF_Alarm, ESMF_AlarmSet + use ESMF , only : ESMF_FieldBundleIsCreated + use esmflds , only : compocn, compatm ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc ! local variables + type(InternalState) :: is_local + type(ESMF_Clock) :: mclock type(ESMF_Alarm) :: alarm - type(ESMF_Clock) :: mclock, dclock - type(ESMF_TimeInterval) :: mtimestep, dtimestep - type(ESMF_Time) :: mCurrTime - type(ESMF_Time) :: mStartTime - type(ESMF_TimeInterval) :: timestep - integer :: alarmcount - integer :: timestep_length - character(CL) :: cvalue ! attribute string - character(CL) :: histinst_option ! freq_option setting (ndays, nsteps, etc) - character(CL) :: histavg_option ! freq_option setting (ndays, nsteps, etc) - integer :: histinst_n ! freq_n setting relative to freq_option - integer :: histavg_n ! freq_n setting relative to freq_option - character(len=*), parameter :: subname='(med_phases_history_alarm_init)' + character(CS) :: alarmname + character(CL) :: hist_option ! freq_option setting (ndays, nsteps, etc) + integer :: hist_n ! freq_n setting relative to freq_option + character(CL) :: cvalue ! attribute string + logical :: isPresent + logical :: isSet + type(ESMF_VM) :: vm + type(ESMF_Calendar) :: calendar ! calendar type + integer :: i,m,n ! indices + integer :: nx,ny ! global grid size + character(CL) :: time_units ! units of time variable + character(CL) :: hist_file ! history file name + real(r8) :: time_val ! time coordinate output + real(r8) :: time_bnds(2) ! time bounds output + logical :: write_now ! true => write to history type + real(r8) :: tbnds(2) ! CF1.0 time bounds + type(ESMF_Time) :: starttime + type(ESMF_Time) :: currtime + type(ESMF_Time) :: nexttime + character(len=CS) :: currtimestr + character(len=CS) :: nexttimestr + integer :: yr,mon,day,sec ! time units + type(ESMF_TimeInterval) :: ringInterval + integer :: ringInterval_length + logical :: first_time = .true. + character(len=*), parameter :: subname='(med_phases_history_write)' !--------------------------------------- rc = ESMF_SUCCESS + call t_startf('MED:'//subname) - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) - endif + ! Get the internal state + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! ----------------------------- - ! Get model clock - ! ----------------------------- + alarmname='alarm_history_inst_all' - call NUOPC_ModelGet(gcomp, modelClock=mclock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (first_time) then + call NUOPC_CompAttributeGet(gcomp, name='history_option', isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + call NUOPC_CompAttributeGet(gcomp, name='history_option', value=hist_option, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(gcomp, name='history_n', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) hist_n + else + ! If attribute is not present - don't write history output + hist_option = 'none' + hist_n = -999 + end if - ! get start time - call ESMF_ClockGet(mclock, startTime=mStartTime, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Set alarm name and initialize clock and alarm for instantaneous history output + ! The alarm for the full history write is set on the mediator clock not as a separate alarm + if (hist_option /= 'none' .and. hist_option /= 'never') then + + ! Initialize alarm on mediator clock for instantaneous mediator history output for all variables + call NUOPC_ModelGet(gcomp, modelClock=mclock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockGet(mclock, startTime=starttime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_time_alarmInit(mclock, alarm, option=hist_option, opt_n=hist_n, & + reftime=starttime, alarmname=alarmname, rc=rc) + call ESMF_AlarmSet(alarm, clock=mclock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Advance model clock to trigger alarms then reset model clock back to currtime + call ESMF_ClockGet(mclock, currTime=CurrTime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockAdvance(mclock,rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockSet(mclock, currTime=currtime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Write diagnostic info + if (mastertask) then + write(logunit,'(a,2x,i8)') trim(subname) // " initialized history alarm "//& + trim(alarmname)//" with option "//trim(hist_option)//" and frequency ",hist_n + end if + end if + first_time = .false. + end if - ! ----------------------------- - ! Set alarm for instantaneous mediator history output - ! ----------------------------- + write_now = .false. + if (hist_option /= 'none' .and. hist_option /= 'never') then + call NUOPC_ModelGet(gcomp, modelClock=mclock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockGetAlarm(mclock, alarmname=trim(alarmname), alarm=alarm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(gcomp, name='history_option', value=histinst_option, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(gcomp, name='history_n', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) histinst_n + if (ESMF_AlarmIsRinging(alarm, rc=rc)) then + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Set write flag to .true. and turn ringer off + write_now = .true. + call ESMF_AlarmRingerOff( alarm, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_time_alarmInit(mclock, alarm, option=histinst_option, opt_n=histinst_n, & - reftime=mStartTime, alarmname='alarm_history_inst', rc=rc) + ! Write diagnostic info if appropriate + if (mastertask .and. debug_alarms) then + call ESMF_AlarmGet(alarm, ringInterval=ringInterval, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeIntervalGet(ringInterval, s=ringinterval_length, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_AlarmSet(alarm, clock=mclock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockGet(mclock, currtime=currtime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeGet(currtime,yy=yr, mm=mon, dd=day, s=sec, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(currtimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec - ! ----------------------------- - ! Set alarm for averaged mediator history output - ! ----------------------------- + call ESMF_ClockGetNextTime(mclock, nextTime=nexttime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeGet(nexttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(nexttimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + + if (mastertask) then + write(logunit,*) + write(logunit,'(a,i8)') trim(subname)//" : history alarmname "//trim(alarmname)//& + ' is ringing, interval length is ', ringInterval_length + write(logunit,'(a)') trim(subname)//" : mclock currtime = "//trim(currtimestr)//& + " mclock nexttime = "//trim(nexttimestr) + end if + end if + end if - !TODO: add isSet and isPresent flags to reading these and other config attributes - !call NUOPC_CompAttributeGet(gcomp, name='histavg_option', value=histavg_option, rc=rc) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return - !call NUOPC_CompAttributeGet(gcomp, name='histavg_n', value=cvalue, rc=rc) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return - !read(cvalue,*) histavg_n + ! If write now flag is true + if (write_now) then - !call med_time_alarmInit(mclock, alarm, option=histavg_option, opt_n=histavg_n, & - ! reftime=mStartTime, alarmname='alarm_history_avg', rc=rc) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Determine time_val and tbnds data for history as well as history file name + call med_phases_history_set_timeinfo(gcomp, mclock, alarmname, & + time_val, time_bnds, time_units, hist_file, doavg=.false., compname='all', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - !call ESMF_AlarmSet(alarm, clock=mclock, rc=rc) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Create history file + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_io_wopen(hist_file, vm, clobber=.true.) - !-------------------------------- - ! Advance model clock to trigger alarms then reset model clock back to currtime - !-------------------------------- + ! Loop over whead/wdata phases + do m = 1,2 + if (m == 2) then + call med_io_enddef(hist_file) + end if - call ESMF_ClockGet(mclock, currTime=mCurrTime, timeStep=mtimestep, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeIntervalGet(mtimestep, s=timestep_length, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Write time values + if (whead(m)) then + call ESMF_ClockGet(mclock, calendar=calendar, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_io_define_time(time_units, calendar, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call med_io_write_time(time_val, time_bnds, nt=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if - call ESMF_ClockAdvance(mclock,rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + do n = 2,ncomps ! skip the mediator here + ! Write import and export field bundles + if (is_local%wrap%comp_present(n)) then + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(n,n),rc=rc)) then + call med_io_write(hist_file, is_local%wrap%FBimp(n,n), whead(m), wdata(m), & + is_local%wrap%nx(n), is_local%wrap%ny(n), nt=1, pre=trim(compname(n))//'Imp', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(n),rc=rc)) then + call med_io_write(hist_file, is_local%wrap%FBexp(n), whead(m), wdata(m), & + is_local%wrap%nx(n), is_local%wrap%ny(n), nt=1, pre=trim(compname(n))//'Exp', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + end if + ! Write mediator fraction field bundles + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBFrac(n),rc=rc)) then + call med_io_write(hist_file, is_local%wrap%FBFrac(n), whead(m), wdata(m), & + is_local%wrap%nx(n), is_local%wrap%ny(n), nt=1, pre='Med_frac_'//trim(compname(n)), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + ! Write component mediator area field bundles + call med_io_write(hist_file, is_local%wrap%FBArea(n), whead(m), wdata(m), & + is_local%wrap%nx(n), is_local%wrap%ny(n), nt=1, pre='MED_'//trim(compname(n)), rc=rc) + end do + + ! Write atm/ocn fluxes and ocean albedoes if field bundles are created + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o,rc=rc)) then + call med_io_write(hist_file, is_local%wrap%FBMed_ocnalb_o, whead(m), wdata(m), & + is_local%wrap%nx(compocn), is_local%wrap%ny(compocn), nt=1, pre='Med_alb_ocn', rc=rc) + end if + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_o,rc=rc)) then + call med_io_write(hist_file, is_local%wrap%FBMed_aoflux_o, whead(m), wdata(m), & + is_local%wrap%nx(compocn), is_local%wrap%ny(compocn), nt=1, pre='Med_aoflux_ocn', rc=rc) + end if + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_a,rc=rc)) then + call med_io_write(hist_file, is_local%wrap%FBMed_ocnalb_a, whead(m), wdata(m), & + is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_alb_atm', rc=rc) + end if + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a,rc=rc)) then + call med_io_write(hist_file, is_local%wrap%FBMed_aoflux_a, whead(m), wdata(m), & + is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_aoflux_atm', rc=rc) + end if - call ESMF_ClockSet(mclock, currTime=mcurrtime, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do ! end of loop over whead/wdata m index phases - ! ----------------------------- - ! Write mediator diagnostic output - ! ----------------------------- + ! Close file + call med_io_close(hist_file, vm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (mastertask) then - write(logunit,*) - write(logunit,100) trim(subname)//" history clock timestep = ",timestep_length - write(logunit,100) trim(subname)//" set instantaneous mediator history alarm with option "//& - trim(histinst_option)//" and frequency ",histinst_n - !write(logunit,100) trim(subname)//" set averaged mediator history alarm with option "//& - ! trim(histavg_option)//" and frequency ",histavg_n -100 format(a,2x,i8) - write(logunit,*) + end if ! end of write_now if-block end if - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": exited", ESMF_LOGMSG_INFO) - endif + call t_stopf('MED:'//subname) - end subroutine med_phases_history_alarm_init + end subroutine med_phases_history_write !=============================================================================== + subroutine med_phases_history_write_med(gcomp, rc) - subroutine med_phases_history_write(gcomp, rc) + ! Write mediator history file for med variables - only instantaneous files are written + ! This writes out ocean albedoes and atm/ocean fluxes computed by the mediator + ! along with the fractions computed by the mediator - ! -------------------------------------- - ! Write mediator history file - ! -------------------------------------- - - use ESMF , only : ESMF_GridComp, ESMF_GridCompGet - use ESMF , only : ESMF_VM, ESMF_VMGet - use ESMF , only : ESMF_Clock, ESMF_ClockGet, ESMF_ClockGetNextTime, ESMF_ClockGetAlarm - use ESMF , only : ESMF_Calendar - use ESMF , only : ESMF_Time, ESMF_TimeGet - use ESMF , only : ESMF_TimeInterval, ESMF_TimeIntervalGet - use ESMF , only : ESMF_Alarm, ESMF_AlarmIsRinging, ESMF_AlarmRingerOff, ESMF_AlarmGet - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LOGMSG_ERROR - use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE - use ESMF , only : ESMF_FieldBundleIsCreated, ESMF_MAXSTR, ESMF_ClockPrint, ESMF_AlarmIsCreated - use ESMF , only : operator(==), operator(-) - use ESMF , only : ESMF_ALARMLIST_ALL, ESMF_ClockGetAlarmList - use NUOPC , only : NUOPC_CompAttributeGet - use esmFlds , only : compatm, compocn, ncomps, compname - use esmFlds , only : fldListFr, fldListTo - use NUOPC_Model, only : NUOPC_ModelGet + use ESMF , only : ESMF_FieldBundleIsCreated + use med_io_mod, only : med_io_write_time, med_io_define_time + use esmFlds , only : compmed, compocn, compatm ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc ! local variables - type(ESMF_Clock) :: mclock, dclock - type(ESMF_TimeInterval) :: mtimestep, dtimestep - integer :: timestep_length - type(ESMF_Alarm) :: alarm - integer :: alarmCount + type(InternalState) :: is_local + type(ESMF_VM) :: vm + type(ESMF_Calendar) :: calendar ! calendar type + integer :: i,m,n ! indices + integer :: nx,ny ! global grid size + character(CL) :: time_units ! units of time variable + character(CL) :: hist_file ! history file name + real(r8) :: time_val ! time coordinate output + real(r8) :: time_bnds(2) ! time bounds output + logical :: write_now ! true => write to history type + character(CL) :: cvalue ! attribute string + character(CL) :: hist_option ! freq_option setting (ndays, nsteps, etc) + integer :: hist_n ! freq_n setting relative to freq_option + character(CL) :: hist_option_in + character(CL) :: hist_n_in + logical :: isPresent + logical :: isSet + character(len=*), parameter :: subname='(med_phases_history_write_med)' + !--------------------------------------- + rc = ESMF_SUCCESS + + ! Get the internal state + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! alarm is not set determine hist_option and hist_n + if (.not. instfiles(compmed)%is_clockset) then + ! Determine attribute prefix + write(hist_option_in,'(a)') 'history_option_med_inst' + write(hist_n_in,'(a)') 'history_n_med_inst' + + ! Determine instantaneous mediator output frequency and type + call NUOPC_CompAttributeGet(gcomp, name=trim(hist_option_in), isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + call NUOPC_CompAttributeGet(gcomp, name=trim(hist_option_in), value=hist_option, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(gcomp, name=trim(hist_n_in), value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) hist_n + else + ! If attribute is not present - don't write history output + hist_option = 'none' + hist_n = -999 + end if + + ! Set alarm name and initialize clock and alarm for instantaneous history output + if (hist_option /= 'none' .and. hist_option /= 'never') then + instfiles(compmed)%alarmname = 'alarm_history_inst_med' + call med_phases_history_init_histclock(gcomp, instfiles(compmed)%clock, & + instfiles(compmed)%alarm, instfiles(compmed)%alarmname, hist_option, hist_n, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + instfiles(compmed)%is_active = .true. + instfiles(compmed)%is_clockset = .true. + else + instfiles(compmed)%is_active = .false. + ! this is set to true here even if history file is not active + instfiles(compmed)%is_clockset = .true. + end if + end if + + ! if history file is active and history clock is initialized - process history file + if (instfiles(compmed)%is_active .and. instfiles(compmed)%is_clockset) then + + ! Determine if will write to history file + call med_phases_history_query_ifwrite(gcomp, instfiles(compmed)%clock, instfiles(compmed)%alarmname, & + write_now, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! If write now flag is true + if (write_now) then + + ! Determine time_val and tbnds data for history as well as history file name + call med_phases_history_set_timeinfo(gcomp, instfiles(compmed)%clock, instfiles(compmed)%alarmname, & + time_val, time_bnds, time_units, hist_file, doavg=.false., compname='med', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Create history file + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_io_wopen(hist_file, vm, clobber=.true.) + do m = 1,2 + ! Write time values + if (whead(m)) then + call ESMF_ClockGet(instfiles(compmed)%clock, calendar=calendar, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_io_define_time(time_units, calendar, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call med_io_enddef(hist_file) + call med_io_write_time(time_val, time_bnds, nt=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + ! Write aoflux fields computed in mediator + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_o,rc=rc)) then + call med_io_write(hist_file, is_local%wrap%FBMed_aoflux_o, whead(m), wdata(m), & + is_local%wrap%nx(compocn), is_local%wrap%ny(compocn), nt=1, pre='Med_aoflux_ocn', rc=rc) + end if + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a,rc=rc)) then + call med_io_write(hist_file, is_local%wrap%FBMed_aoflux_a, whead(m), wdata(m), & + is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_aoflux_atm', rc=rc) + end if + + ! If appropriate - write ocn albedos computed in mediator + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o,rc=rc)) then + call med_io_write(hist_file, is_local%wrap%FBMed_ocnalb_o, whead(m), wdata(m), & + is_local%wrap%nx(compocn), is_local%wrap%ny(compocn), nt=1, pre='Med_alb_ocn', rc=rc) + end if + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_a,rc=rc)) then + call med_io_write(hist_file, is_local%wrap%FBMed_ocnalb_a, whead(m), wdata(m), & + is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_alb_atm', rc=rc) + end if + end do ! end of loop over m + + ! Close file + call med_io_close(hist_file, vm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + end if ! end of if-write_now block + end if ! end of if-active block + + end subroutine med_phases_history_write_med + + !=============================================================================== + subroutine med_phases_history_write_lnd2glc(gcomp, fldbun, rc) + + ! Write yearly average of lnd -> glc fields + + use esmFlds , only : complnd + use med_constants_mod , only : SecPerDay => med_constants_SecPerDay + use med_io_mod , only : med_io_write_time, med_io_define_time + use med_io_mod , only : med_io_date2yyyymmdd, med_io_sec2hms, med_io_ymd2date + + ! input/output variables + type(ESMF_GridComp) , intent(in) :: gcomp + type(ESMF_FieldBundle) , intent(in) :: fldbun + integer , intent(out) :: rc + + ! local variables + type(InternalState) :: is_local type(ESMF_VM) :: vm - type(ESMF_Time) :: currtime + type(ESMF_Clock) :: clock type(ESMF_Time) :: starttime + type(ESMF_Time) :: currtime type(ESMF_Time) :: nexttime - type(ESMF_TimeInterval) :: timediff ! Used to calculate curr_time - type(ESMF_Calendar) :: calendar ! calendar type - character(len=64) :: currtimestr - character(len=64) :: nexttimestr - type(InternalState) :: is_local - character(CS) :: histavg_option ! Histavg option units - integer :: i,j,m,n,n1,ncnt - integer :: start_ymd ! Starting date YYYYMMDD - integer :: start_tod ! Starting time-of-day (s) - integer :: nx,ny ! global grid size - integer :: yr,mon,day,sec ! time units - real(r8) :: rval ! real tmp value - real(r8) :: dayssince ! Time interval since reference time - integer :: fk ! index - character(CL) :: time_units ! units of time variable - character(CL) :: case_name ! case name - character(CL) :: hist_file ! Local path to history filename - character(CS) :: cpl_inst_tag ! instance tag - character(CL) :: cvalue ! attribute string - real(r8) :: tbnds(2) ! CF1.0 time bounds - logical :: whead,wdata ! for writing restart/history cdf files - integer :: iam - logical :: isPresent - type(ESMF_TimeInterval) :: RingInterval - integer :: ringInterval_length - logical :: first_time = .true. - character(len=*), parameter :: subname='(med_phases_history_write)' + type(ESMF_Calendar) :: calendar ! calendar type + type(ESMF_TimeInterval) :: timediff(2) ! time bounds upper and lower relative to start + character(len=CS) :: nexttime_str + integer :: yr,mon,day,sec + integer :: start_ymd ! starting date YYYYMMDD + character(CL) :: time_units ! units of time variable + real(r8) :: time_val ! time coordinate output + real(r8) :: time_bnds(2) ! time bounds output + character(len=CL) :: hist_str + character(len=CL) :: hist_file + integer :: m + logical :: isPresent, isSet + character(len=*), parameter :: subname='(med_phases_history_write_lnd2glc)' !--------------------------------------- - call t_startf('MED:'//subname) - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) - endif rc = ESMF_SUCCESS - !--------------------------------------- - ! --- Get the communicator and localpet - !--------------------------------------- + ! Get the internal state + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + ! Get the model clock + call NUOPC_ModelGet(gcomp, modelClock=clock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMGet(vm, localPet=iam, rc=rc) + + ! Determine starttime, currtime and nexttime + call ESMF_ClockGet(clock, currtime=currtime, starttime=starttime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockGetNextTime(clock, nextTime=nexttime, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - !--------------------------------------- - ! --- Get the internal state - !--------------------------------------- + ! Determine time units + call ESMF_TimeGet(starttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_io_ymd2date(yr,mon,day,start_ymd) + time_units = 'days since ' // trim(med_io_date2yyyymmdd(start_ymd)) // ' ' // med_io_sec2hms(sec, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - nullify(is_local%wrap) - call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + ! Set time bounds and time coord + timediff(1) = nexttime - starttime + call ESMF_TimeIntervalGet(timediff(1), d=day, s=sec, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(gcomp, name='case_name', value=case_name, rc=rc) + time_val = day + sec/real(SecPerDay,R8) + time_bnds(1) = time_val + time_bnds(2) = time_val + + ! Determine history file name + if (trim(case_name) == 'unset') then + call NUOPC_CompAttributeGet(gcomp, name='case_name', value=case_name, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(gcomp, name='inst_suffix', isPresent=isPresent, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if(isPresent) then + call NUOPC_CompAttributeGet(gcomp, name='inst_suffix', value=inst_tag, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + inst_tag = "" + endif + end if + call ESMF_TimeGet(nexttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(nexttime_str,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + write(hist_file, "(6a)") trim(case_name),'.cpl',trim(inst_tag),'.hx.1yr2glc.',trim(nexttime_str),'.nc' - call NUOPC_CompAttributeGet(gcomp, name='inst_suffix', isPresent=isPresent, rc=rc) + ! Create history file + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if(isPresent) then - call NUOPC_CompAttributeGet(gcomp, name='inst_suffix', value=cpl_inst_tag, rc=rc) + call med_io_wopen(hist_file, vm, clobber=.true.) + + ! Write data to history file + do m = 1,2 + if (whead(m)) then + call ESMF_ClockGet(clock, calendar=calendar, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_io_define_time(time_units, calendar, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call med_io_enddef(hist_file) + call med_io_write_time(time_val, time_bnds, nt=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + call med_io_write(hist_file, fldbun, whead(m), wdata(m), is_local%wrap%nx(complnd), is_local%wrap%ny(complnd), & + nt=1, pre=trim(compname(complnd))//'Imp', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - cpl_inst_tag = "" - endif + end do ! end of loop over m - call NUOPC_ModelGet(gcomp, modelClock=mclock, rc=rc) + ! Close history file + call med_io_close(hist_file, vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (first_time) then - call med_phases_history_alarm_init(gcomp, rc) - end if + end subroutine med_phases_history_write_lnd2glc + + !=============================================================================== + subroutine med_phases_history_write_comp(gcomp, compid, rc) + + ! Write mediator history file for atm variables + + ! input/output variables + type(ESMF_GridComp), intent(inout) :: gcomp + integer , intent(in) :: compid + integer , intent(out) :: rc !--------------------------------------- - ! Check if history alarm is ringing - and if so write the mediator history file + rc = ESMF_SUCCESS + + call med_phases_history_write_comp_inst(gcomp, compid, instfiles(compid), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_phases_history_write_comp_avg(gcomp, compid, avgfiles(compid), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_phases_history_write_comp_aux(gcomp, compid, auxcomp(compid), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine med_phases_history_write_comp + + !=============================================================================== + subroutine med_phases_history_write_comp_inst(gcomp, compid, instfile, rc) + + ! Write instantaneous mediator history file for component compid + + use med_io_mod, only : med_io_write_time, med_io_define_time + use ESMF , only : ESMF_FieldBundleIsCreated + + ! input/output variables + type(ESMF_GridComp) , intent(inout) :: gcomp + integer , intent(in) :: compid + type(instfile_type) , intent(inout) :: instfile + integer , intent(out) :: rc + + ! local variables + type(InternalState) :: is_local + character(CL) :: cvalue ! attribute string + character(CL) :: hist_option ! freq_option setting (ndays, nsteps, etc) + integer :: hist_n ! freq_n setting relative to freq_option + character(CL) :: hist_option_in + character(CL) :: hist_n_in + logical :: isPresent + logical :: isSet + type(ESMF_VM) :: vm + type(ESMF_Calendar) :: calendar ! calendar type + integer :: i,m,n ! indices + integer :: nx,ny ! global grid size + character(CL) :: time_units ! units of time variable + character(CL) :: hist_file ! history file name + real(r8) :: time_val ! time coordinate output + real(r8) :: time_bnds(2) ! time bounds output + logical :: write_now ! true => write to history type + real(r8) :: tbnds(2) ! CF1.0 time bounds + character(len=*), parameter :: subname='(med_phases_history_write_inst_comp)' !--------------------------------------- - ! TODO: Add history averaging functionality and Determine if history average alarm is on - ! if (ESMF_AlarmIsRinging(AlarmHistAvg, rc=rc)) then - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! alarmIsOn = .true. - ! call ESMF_AlarmRingerOff( AlarmHist, rc=rc ) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! else - ! alarmisOn = .false. - ! endif + rc = ESMF_SUCCESS + call t_startf('MED:'//subname) - call ESMF_ClockGetAlarm(mclock, alarmname='alarm_history_inst', alarm=alarm, rc=rc) + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (dbug_flag > 2) then - call ESMF_AlarmGet(alarm, ringInterval=ringInterval, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeIntervalGet(ringInterval, s=ringinterval_length, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockGet(mclock, currtime=currtime, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeGet(currtime,yy=yr, mm=mon, dd=day, s=sec, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - write(currtimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec - call ESMF_ClockGetNextTime(mclock, nextTime=nexttime, rc=rc) + ! alarm is not set determine hist_option and hist_n + if (.not. instfile%is_clockset) then + + ! Determine attribute prefix + write(hist_option_in,'(a)') 'history_option_'//trim(compname(compid))//'_inst' + write(hist_n_in,'(a)') 'history_n_'//trim(compname(compid))//'_inst' + + ! Determine instantaneous mediator output frequency and type + call NUOPC_CompAttributeGet(gcomp, name=trim(hist_option_in), isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeGet(nexttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) + if (isPresent .and. isSet) then + call NUOPC_CompAttributeGet(gcomp, name=trim(hist_option_in), value=hist_option, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(gcomp, name=trim(hist_n_in), value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) hist_n + else + ! If attribute is not present - don't write history output + hist_option = 'none' + hist_n = -999 + end if + + ! Set alarm name and initialize clock and alarm for instantaneous history output + if (hist_option /= 'none' .and. hist_option /= 'never') then + instfile%alarmname = 'alarm_history_inst_'//trim(compname(compid)) + call med_phases_history_init_histclock(gcomp, instfile%clock, & + instfile%alarm, instfile%alarmname, hist_option, hist_n, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + instfile%is_active = .true. + instfile%is_clockset = .true. + else + instfile%is_active = .false. + ! this is set to true here even if history file is not active + instfile%is_clockset = .true. + end if + end if ! end of if-clock set if block + + ! if history file is active and history clock is initialized - process history file + if (instfile%is_active .and. instfile%is_clockset) then + + ! Determine if should write to history file + call med_phases_history_query_ifwrite(gcomp, instfile%clock, instfile%alarmname, write_now, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (mastertask) then - write(nexttimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec - write(logunit,*) - write(logunit,*) trim(subname)//": history alarm ringinterval = ", ringInterval_length - write(logunit,' (a)') trim(subname)//": currtime = "//trim(currtimestr)//" nexttime = "//trim(nexttimestr) - write(logunit,*) trim(subname) //' history alarm is ringing = ', ESMF_AlarmIsRinging(alarm) + + ! If write now flag is true + if (write_now) then + ! Determine time_val and tbnds data for history as well as history file name + call med_phases_history_set_timeinfo(gcomp, instfile%clock, instfile%alarmname, & + time_val, time_bnds, time_units, hist_file, doavg=.false., compname=compname(compid), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Create history file + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_io_wopen(hist_file, vm, clobber=.true.) + do m = 1,2 + ! Write time values + if (whead(m)) then + call ESMF_ClockGet(instfile%clock, calendar=calendar, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_io_define_time(time_units, calendar, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call med_io_enddef(hist_file) + call med_io_write_time(time_val, time_bnds, nt=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + nx = is_local%wrap%nx(compid) + ny = is_local%wrap%ny(compid) + ! Define/write import field bundle + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(compid,compid),rc=rc)) then + call med_io_write(hist_file, is_local%wrap%FBimp(compid,compid), whead(m), wdata(m), nx, ny, & + nt=1, pre=trim(compname(compid))//'Imp', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + ! Define/write import export bundle + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(compid),rc=rc)) then + call med_io_write(hist_file, is_local%wrap%FBexp(compid), whead(m), wdata(m), nx, ny, & + nt=1, pre=trim(compname(compid))//'Exp', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + ! Define/Write mediator fractions + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBFrac(compid),rc=rc)) then + call med_io_write(hist_file, is_local%wrap%FBFrac(compid), whead(m), wdata(m), nx, ny, & + nt=1, pre='Med_frac_'//trim(compname(compid)), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + end do ! end of loop over m + + ! Close file + call med_io_close(hist_file, vm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if end if - if (ESMF_AlarmIsRinging(alarm, rc=rc)) then - if (ChkErr(rc,__LINE__,u_FILE_u)) return + call t_stopf('MED:'//subname) - ! Turn ringer off - call ESMF_AlarmRingerOff( alarm, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + end subroutine med_phases_history_write_comp_inst - ! Get time info for history file - call ESMF_GridCompGet(gcomp, clock=mclock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + !=============================================================================== + subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) - call ESMF_ClockGet(mclock, currtime=currtime, starttime=starttime, calendar=calendar, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Write mediator average history file variables for component compid - call ESMF_ClockGetNextTime(mclock, nextTime=nexttime, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + use ESMF , only : ESMF_FieldBundleIsCreated + use med_constants_mod , only : czero => med_constants_czero + use med_methods_mod , only : med_methods_FB_init, med_methods_FB_reset + use med_io_mod , only : med_io_write_time, med_io_define_time - call ESMF_TimeGet(currtime,yy=yr, mm=mon, dd=day, s=sec, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - write(currtimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + ! input/output variables + type(ESMF_GridComp) , intent(inout) :: gcomp + integer , intent(in) :: compid + type(avgfile_type) , intent(inout) :: avgfile + integer , intent(out) :: rc - call ESMF_TimeGet(nexttime,yy=yr, mm=mon, dd=day, s=sec, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - write(nexttimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec - timediff = nexttime - starttime - call ESMF_TimeIntervalGet(timediff, d=day, s=sec, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - dayssince = day + sec/real(SecPerDay,R8) + ! local variables + type(InternalState) :: is_local + character(CL) :: cvalue ! attribute string + character(CL) :: hist_option ! freq_option setting (ndays, nsteps, etc) + integer :: hist_n ! freq_n setting relative to freq_option + character(CL) :: hist_option_in + character(CL) :: hist_n_in + logical :: isPresent + logical :: isSet + type(ESMF_VM) :: vm + type(ESMF_Calendar) :: calendar ! calendar type + integer :: i,m,n ! indices + integer :: nx,ny ! global grid size + character(CL) :: time_units ! units of time variable + character(CL) :: hist_file ! history file name + real(r8) :: time_val ! time coordinate output + real(r8) :: time_bnds(2) ! time bounds output + logical :: write_now ! true => write to history type + real(r8) :: tbnds(2) ! CF1.0 time bounds + character(CS) :: scalar_name + character(len=*), parameter :: subname='(med_phases_history_write_comp_avg)' + !--------------------------------------- - call ESMF_TimeGet(starttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_ymd2date(yr,mon,day,start_ymd) - start_tod = sec - time_units = 'days since ' // trim(med_io_date2yyyymmdd(start_ymd)) // ' ' // med_io_sec2hms(start_tod, rc) + rc = ESMF_SUCCESS + + call t_startf('MED:'//subname) + + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! alarm is not set determine hist_option and hist_n + if (.not. avgfile%is_clockset) then + + ! Determine attribute prefix + write(hist_option_in,'(a)') 'history_option_'//trim(compname(compid))//'_avg' + write(hist_n_in,'(a)') 'history_n_'//trim(compname(compid))//'_avg' + + ! Determine time average mediator output frequency and type + call NUOPC_CompAttributeGet(gcomp, name=trim(hist_option_in), isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + call NUOPC_CompAttributeGet(gcomp, name=trim(hist_option_in), value=hist_option, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(gcomp, name=trim(hist_n_in), value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) hist_n + else + hist_option = 'none' + hist_n = -999 + end if + if (hist_option /= 'never' .and. hist_option /= 'none') then + + ! Set alarm name, initialize clock and alarm for average history output and + avgfile%alarmname = 'alarm_history_avg_'//trim(compname(compid)) + call med_phases_history_init_histclock(gcomp, avgfile%clock, & + avgfile%alarm, avgfile%alarmname, hist_option, hist_n, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + avgfile%is_active = .true. + avgfile%is_clockset = .true. + + ! Initialize accumulation import/export field bundles + scalar_name = trim(is_local%wrap%flds_scalar_name) + if ( ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(compid,compid)) .and. .not. & + ESMF_FieldBundleIsCreated(avgfile%FBaccum_import)) then + call med_methods_FB_init(avgfile%FBaccum_import, scalar_name, & + FBgeom=is_local%wrap%FBImp(compid,compid), FBflds=is_local%wrap%FBimp(compid,compid), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call med_methods_FB_reset(avgfile%FBaccum_import, czero, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + avgfile%accumcnt_import = 0 + end if + if ( ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(compid)) .and. .not. & + ESMF_FieldBundleIsCreated(avgfile%FBaccum_export)) then + call med_methods_FB_init(avgfile%FBaccum_export, scalar_name, & + FBgeom=is_local%wrap%FBExp(compid), FBflds=is_local%wrap%FBexp(compid), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call med_methods_FB_reset(avgfile%FBaccum_export, czero, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + avgfile%accumcnt_export = 0 + end if + + else - ! Use nexttimestr rather than currtimestr here since that is the time at the end of - ! the timestep and is preferred for history file names - write(hist_file,"(6a)") trim(case_name), '.cpl',trim(cpl_inst_tag),'.hi.', trim(nexttimestr),'.nc' + avgfile%is_active = .false. + ! this is set to true here even if history file is not active + avgfile%is_clockset = .true. - if (mastertask) then - write(logunit,*) - write(logunit,' (a)') trim(subname)//": writing mediator history file "//trim(hist_file) - write(logunit,' (a)') trim(subname)//": currtime = "//trim(currtimestr) - write(logunit,' (a)') trim(subname)//": nexttime = "//trim(nexttimestr) end if + end if ! end of if-clock set if block - call med_io_wopen(hist_file, vm, iam, clobber=.true.) - do m = 1,2 - whead=.false. - wdata=.false. - if (m == 1) then - whead=.true. - elseif (m == 2) then - wdata=.true. - call med_io_enddef(hist_file) - endif + ! if history file is active and history clock is initialized - process history file + if (avgfile%is_active .and. avgfile%is_clockset) then - tbnds = dayssince + ! Determine if will write to history file + call med_phases_history_query_ifwrite(gcomp, avgfile%clock, avgfile%alarmname, write_now, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (tbnds(1) >= tbnds(2)) then - call med_io_write(hist_file, iam, time_units=time_units, calendar=calendar, time_val=dayssince, & - whead=whead, wdata=wdata, rc=rc) + ! Accumulate and then average if write_now flag is true + if (ESMF_FieldBundleIsCreated(avgfile%FBaccum_import)) then + call med_phases_history_fldbun_accum(is_local%wrap%FBImp(compid,compid), & + avgfile%FBaccum_import, avgfile%accumcnt_import, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (write_now) then + call med_phases_history_fldbun_average(avgfile%FBaccum_import, avgfile%accumcnt_import, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - call med_io_write(hist_file, iam, time_units=time_units, calendar=calendar, time_val=dayssince, & - whead=whead, wdata=wdata, tbnds=tbnds, rc=rc) + end if + end if + if (ESMF_FieldBundleIsCreated(avgfile%FBaccum_export)) then + call med_phases_history_fldbun_accum(is_local%wrap%FBExp(compid), & + avgfile%FBaccum_export, avgfile%accumcnt_export, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (write_now) then + call med_phases_history_fldbun_average(avgfile%FBaccum_export, avgfile%accumcnt_export, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - endif + end if + end if + + ! If write now flag is true + if (write_now) then + + ! Determine time_val and tbnds data for history as well as history file name + call med_phases_history_set_timeinfo(gcomp, avgfile%clock, avgfile%alarmname, & + time_val, time_bnds, time_units, hist_file, doavg=.true., compname=trim(compname(compid)), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Create history file + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_io_wopen(hist_file, vm, clobber=.true.) + do m = 1,2 + ! Write time values + if (whead(m)) then + call ESMF_ClockGet(avgfile%clock, calendar=calendar, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_io_define_time(time_units, calendar, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call med_io_enddef(hist_file) + call med_io_write_time(time_val, time_bnds, nt=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if - do n = 1,ncomps - if (is_local%wrap%comp_present(n)) then - if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(n,n),rc=rc)) then - nx = is_local%wrap%nx(n) - ny = is_local%wrap%ny(n) - call med_io_write(hist_file, iam, is_local%wrap%FBimp(n,n), & - nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre=trim(compname(n))//'Imp', rc=rc) + ! Write import and export field bundles + if (is_local%wrap%comp_present(compid)) then + nx = is_local%wrap%nx(compid) + ny = is_local%wrap%ny(compid) + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(compid,compid),rc=rc)) then + call med_io_write(hist_file, avgfile%FBaccum_import, whead(m), wdata(m), nx, ny, & + nt=1, pre=trim(compname(compid))//'Imp', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (wdata(m)) then + call med_methods_FB_reset(avgfile%FBAccum_import, czero, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if endif - if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(n),rc=rc)) then - nx = is_local%wrap%nx(n) - ny = is_local%wrap%ny(n) - call med_io_write(hist_file, iam, is_local%wrap%FBexp(n), & - nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre=trim(compname(n))//'Exp', rc=rc) + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(compid),rc=rc)) then + call med_io_write(hist_file, avgfile%FBaccum_export, whead(m), wdata(m), nx, ny, & + nt=1, pre=trim(compname(compid))//'Exp', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (wdata(m)) then + call med_methods_FB_reset(avgfile%FBAccum_export, czero, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if endif - ! write component mediator fractions - if (ESMF_FieldBundleIsCreated(is_local%wrap%FBFrac(n),rc=rc)) then - nx = is_local%wrap%nx(n) - ny = is_local%wrap%ny(n) - call med_io_write(hist_file, iam, is_local%wrap%FBFrac(n), & - nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre='Med_frac_'//trim(compname(n)), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end do ! end of loop over m + + ! Close file + call med_io_close(hist_file, vm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + end if ! end of write_now if-block + end if ! end of clock created if-block + + call t_stopf('MED:'//subname) + + end subroutine med_phases_history_write_comp_avg + + !=============================================================================== + subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc) + + ! ----------------------------- + ! Write mediator auxiliary history file for auxcomp component + ! Initialize auxiliary history file + ! Each time this routine is called the routine SetRunClock in med.F90 is called + ! at the beginning and the mediator clock current time and time step is set to the + ! driver current time and time step + ! ----------------------------- + + use ESMF , only : ESMF_FieldBundleIsCreated, ESMF_FieldBundleRemove + use med_constants_mod, only : czero => med_constants_czero + use med_io_mod , only : med_io_write_time, med_io_define_time + use med_methods_mod , only : med_methods_FB_init + use med_methods_mod , only : med_methods_FB_reset + use med_methods_mod , only : med_methods_FB_fldchk + + ! input/output variables + type(ESMF_GridComp) , intent(inout) :: gcomp + integer , intent(in) :: compid + type(auxcomp_type) , intent(inout) :: auxcomp + integer , intent(out) :: rc + + ! local variables + type(InternalState) :: is_local + type(ESMF_VM) :: vm + type(ESMF_Calendar) :: calendar ! calendar type + logical :: isPresent ! is attribute present + logical :: isSet ! is attribute set + character(CL) :: hist_option ! freq_option setting (ndays, nsteps, etc) + integer :: hist_n ! freq_n setting relative to freq_option + integer :: nfcnt + integer :: nfile + integer :: nfld + integer :: n,n1,nf + character(CL) :: prefix + character(CL) :: cvalue + character(CL) :: auxflds + integer :: fieldCount + logical :: found + logical :: enable_auxfile + character(CS) :: timestr ! yr-mon-day-sec string + character(CL) :: time_units ! units of time variable + integer :: nx,ny ! global grid size + logical :: write_now ! if true, write time sample to file + integer :: yr,mon,day,sec ! time units + real(r8) :: time_val ! time coordinate output + real(r8) :: time_bnds(2) ! time bounds output + character(CS), allocatable :: fieldNameList(:) + character(len=*), parameter :: subname='(med_phases_history_write_comp_aux)' + !--------------------------------------- + + rc = ESMF_SUCCESS + call t_startf('MED:'//subname) + + ! Get the internal state + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (.not. auxcomp%init_auxfiles) then + + ! Initialize number of aux files for this component to zero + nfcnt = 0 + do nfile = 1,max_auxfiles + ! Determine attribute prefix + write(prefix,'(a,i0)') 'histaux_'//trim(compname(compid))//'2med_file',nfile + + ! Determine if will write the file + call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_enabled', isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_enabled', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,'(l)') enable_auxfile + else + enable_auxfile = .false. + end if + + ! If file will be written - then initialize auxcomp%files(nfcnt) + if (enable_auxfile) then + ! Increment nfcnt + nfcnt = nfcnt + 1 + + ! Determine number of time samples per file + call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_ntperfile', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) auxcomp%files(nfcnt)%ntperfile + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Determine if will do time average for aux file + call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_doavg', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) auxcomp%files(nfcnt)%doavg + + ! Determine the colon delimited field names for this file + call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_flds', value=auxflds, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Determine fields that will be output to auxhist files + if (trim(auxflds) == 'all') then + + ! Output all fields sent to the mediator from ncomp to the auxhist files + call ESMF_FieldBundleGet(is_local%wrap%FBImp(compid,compid), fieldCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(auxcomp%files(nfcnt)%flds(fieldcount)) + call ESMF_FieldBundleGet(is_local%wrap%FBImp(compid,compid), fieldNameList=auxcomp%files(nfcnt)%flds, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + else + + ! Translate the colon deliminted string (auxflds) into a character array (fieldnamelist) + ! Note that the following call allocates the memory for fieldnamelist + call get_auxflds(auxflds, fieldnamelist, rc) + + ! TODO: print warning statement if remove field + ! TODO: if request field that is NOT in the field definition file - then quit + ! Remove all fields from fieldnamelist that are not in FBImp(compid,compid) + fieldCount = size(fieldnamelist) + do n = 1,fieldcount + if (.not. med_methods_FB_fldchk(is_local%wrap%FBImp(compid,compid), trim(fieldnamelist(n)), rc)) then + do n1 = n, fieldCount-1 + fieldnamelist(n1) = fieldnamelist(n1+1) + end do + fieldCount = fieldCount - 1 + end if + end do + + ! Create auxcomp%files(nfcnt)%flds array + allocate(auxcomp%files(nfcnt)%flds(fieldcount)) + do n = 1,fieldcount + auxcomp%files(nfcnt)%flds(n) = trim(fieldnamelist(n)) + end do + + ! Deallocate memory from fieldnamelist + deallocate(fieldnamelist) ! this was allocated in med_phases_history_get_auxflds + + end if ! end of if auxflds is set to 'all' + + if (mastertask) then + write(logunit,*) + write(logunit,'(a,i4,a)') trim(subname) // ' Writing the following fields to auxfile ',nfcnt,& + ' for component '//trim(compname(compid)) + do nfld = 1,size(auxcomp%files(nfcnt)%flds) + write(logunit,'(8x,a)') trim(auxcomp%files(nfcnt)%flds(nfld)) + end do + end if + + ! Create FBaccum if averaging is on + if (auxcomp%files(nfcnt)%doavg) then + + ! First duplicate all fields in FBImp(compid,compid) + call ESMF_LogWrite(trim(subname)// ": initializing FBaccum(compid)", ESMF_LOGMSG_INFO) + if ( ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compid,compid)) .and. .not. & + ESMF_FieldBundleIsCreated(auxcomp%files(nfcnt)%FBaccum)) then + call med_methods_FB_init(auxcomp%files(nfcnt)%FBaccum, is_local%wrap%flds_scalar_name, & + FBgeom=is_local%wrap%FBImp(compid,compid), FBflds=is_local%wrap%FBImp(compid,compid), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call med_methods_FB_reset(auxcomp%files(nfcnt)%FBaccum, czero, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + auxcomp%files(nfcnt)%accumcnt = 0 + end if + + ! Now remove all fields from FBAccum that are not in the input flds list + call ESMF_FieldBundleGet(is_local%wrap%FBImp(compid,compid), fieldCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(fieldNameList(fieldCount)) + call ESMF_FieldBundleGet(is_local%wrap%FBImp(compid,compid), fieldNameList=fieldNameList, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + do n = 1,size(fieldnamelist) + found = .false. + do n1 = 1,size(auxcomp%files(nfcnt)%flds) + if (trim(fieldnamelist(n)) == trim(auxcomp%files(nfcnt)%flds(n1))) then + found = .true. + exit + end if + end do + if (.not. found) then + call ESMF_FieldBundleRemove(auxcomp%files(nfcnt)%FBaccum, fieldnamelist(n:n), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + end do + deallocate(fieldnameList) + + ! Check that FBAccum has at least one field left - if not exit + call ESMF_FieldBundleGet(auxcomp%files(nfcnt)%FBAccum, fieldCount=nfld, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (nfld == 0) then + call ESMF_LogWrite(subname//'FBAccum is zero for '//trim(auxcomp%files(nfcnt)%auxname), & + ESMF_LOGMSG_ERROR) + rc = ESMF_FAILURE + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) then + call ESMF_Finalize(endflag=ESMF_END_ABORT) + end if end if - ! write component mediator areas - nx = is_local%wrap%nx(n) - ny = is_local%wrap%ny(n) - call med_io_write(hist_file, iam, is_local%wrap%FBArea(n), & - nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre='MED_'//trim(compname(n)), rc=rc) + end if - enddo - if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o,rc=rc)) then - nx = is_local%wrap%nx(compocn) - ny = is_local%wrap%ny(compocn) - call med_io_write(hist_file, iam, is_local%wrap%FBMed_ocnalb_o, & - nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre='Med_alb_ocn', rc=rc) + + ! Determine auxiliary file output frequency and type + call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_history_option', value=hist_option, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_history_n', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) hist_n + + ! Determine alarmname + call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_auxname', value=auxcomp%files(nfcnt)%auxname, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(auxcomp%files(nfcnt)%alarmname,'(a,i0)') 'alarm_'//trim(prefix) + + ! Initialize clock and alarm for instantaneous history output + call med_phases_history_init_histclock(gcomp, auxcomp%files(nfcnt)%clock, & + auxcomp%files(nfcnt)%alarm, auxcomp%files(nfcnt)%alarmname, hist_option, hist_n, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + end if ! end of isPresent and isSet and if flag is on for file n + end do ! end of loop over nfile + + ! Set number of aux files for this component - this is a module variable + auxcomp%num_auxfiles = nfcnt + + ! Set initialization flags to .true. + auxcomp%init_auxfiles = .true. + + end if ! end of initialization if-block + + ! Write auxiliary history files for component compid + do nf = 1,auxcomp%num_auxfiles + + ! Determine if will write to history file + call med_phases_history_query_ifwrite(gcomp, auxcomp%files(nf)%clock, auxcomp%files(nf)%alarmname, write_now, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Do accumulation and average if required + if (auxcomp%files(nf)%doavg) then + call med_phases_history_fldbun_accum(is_local%wrap%FBImp(compid,compid), & + auxcomp%files(nf)%FBaccum, auxcomp%files(nf)%accumcnt, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (write_now) then + call med_phases_history_fldbun_average(auxcomp%files(nf)%FBaccum, auxcomp%files(nf)%accumcnt, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + end if + + ! Write time sample to file + if ( write_now ) then + + ! Determine time_val and tbnds data for history as well as history file name + call med_phases_history_set_timeinfo(gcomp, auxcomp%files(nf)%clock, auxcomp%files(nf)%alarmname, & + time_val, time_bnds, time_units, auxcomp%files(nf)%histfile, auxcomp%files(nf)%doavg, & + auxname=auxcomp%files(nf)%auxname, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Set shorthand variables + nx = is_local%wrap%nx(compid) + ny = is_local%wrap%ny(compid) + + ! Increment number of time samples on file + auxcomp%files(nf)%nt = auxcomp%files(nf)%nt + 1 + + ! Write header + if (auxcomp%files(nf)%nt == 1) then + ! open file + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_io_wopen(auxcomp%files(nf)%histfile, vm, file_ind=nf, clobber=.true.) + + ! define time variables + call ESMF_ClockGet(auxcomp%files(nf)%clock, calendar=calendar, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_io_define_time(time_units, calendar, file_ind=nf, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! define data variables with a time dimension (include the nt argument below) + call med_io_write(auxcomp%files(nf)%histfile, is_local%wrap%FBimp(compid,compid), & + whead(1), wdata(1), nx, ny, nt=auxcomp%files(nf)%nt, & + pre=trim(compname(compid))//'Imp', flds=auxcomp%files(nf)%flds, & + file_ind=nf, use_float=.true., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! end definition phase + call med_io_enddef(auxcomp%files(nf)%histfile, file_ind=nf) end if - if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_o,rc=rc) .and. & - ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compatm,compocn))) then - ! This provides the atm input on the ocn mesh needed for that atm/ocn calculation - ! that currently is restricted to the ocn mesh - nx = is_local%wrap%nx(compocn) - ny = is_local%wrap%ny(compocn) - call med_io_write(hist_file, iam, is_local%wrap%FBImp(compatm,compocn), & - nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre='AtmImp_ocn', rc=rc) + + ! Write time variables for time nt + call med_io_write_time(time_val, time_bnds, nt=auxcomp%files(nf)%nt, file_ind=nf, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Write data variables for time nt + if (auxcomp%files(nf)%doavg) then + call med_io_write(auxcomp%files(nf)%histfile, auxcomp%files(nf)%FBaccum, whead(2), wdata(2), nx, ny, & + nt=auxcomp%files(nf)%nt, pre=trim(compname(compid))//'Imp', flds=auxcomp%files(nf)%flds, file_ind=nf, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_methods_FB_reset(auxcomp%files(nf)%FBaccum, value=czero, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call med_io_write(auxcomp%files(nf)%histfile, is_local%wrap%FBimp(compid,compid), whead(2), wdata(2), nx, ny, & + nt=auxcomp%files(nf)%nt, pre=trim(compname(compid))//'Imp', flds=auxcomp%files(nf)%flds, file_ind=nf, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_o,rc=rc)) then - nx = is_local%wrap%nx(compocn) - ny = is_local%wrap%ny(compocn) - call med_io_write(hist_file, iam, is_local%wrap%FBMed_aoflux_o, & - nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre='Med_aoflux_ocn', rc=rc) + + ! Close file + if (auxcomp%files(nf)%nt == auxcomp%files(nf)%ntperfile) then + call med_io_close(auxcomp%files(nf)%histfile, vm, file_ind=nf, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + auxcomp%files(nf)%nt = 0 end if - if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_a,rc=rc)) then - nx = is_local%wrap%nx(compatm) - ny = is_local%wrap%ny(compatm) - call med_io_write(hist_file, iam, is_local%wrap%FBMed_ocnalb_a, & - nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre='Med_alb_atm', rc=rc) + + end if ! end of write_now if-block + + end do + call t_stopf('MED:'//subname) + + contains + + subroutine get_auxflds(str, flds, rc) + ! input/output variables + character(len=*) , intent(in) :: str ! colon deliminted string to search + character(len=*) , allocatable , intent(out) :: flds(:) ! memory will be allocate for flds + integer , intent(out) :: rc + ! local variables + integer :: i,k,n ! generic indecies + integer :: nflds ! allocatable size of flds + integer :: count ! counts occurances of char + integer :: kFlds ! number of fields in list + integer :: i0,i1 ! name = list(i0:i1) + integer :: nChar ! temporary + logical :: valid ! check if str is valid + !--------------------------------------- + rc = ESMF_SUCCESS + + ! check that this is a str is a valid colon dlimited list + valid = .true. + nChar = len_trim(str) + if (nChar < 1) then ! list is an empty string + valid = .false. + else if (str(1:1) == ':') then ! first char is delimiter + valid = .false. + else if (str(nChar:nChar) == ':') then ! last char is delimiter + valid = .false. + else if (index(trim(str)," ") > 0) then ! white-space in a field name + valid = .false. + end if + if (.not. valid) then + if (mastertask) write(logunit,*) "ERROR: invalid list = ",trim(str) + call ESMF_LogWrite("ERROR: invalid list = "//trim(str), ESMF_LOGMSG_ERROR) + rc = ESMF_FAILURE + return + end if + ! get number of fields in a colon delimited string list + nflds = 0 + if (len_trim(str) > 0) then + count = 0 + do n = 1, len_trim(str) + if (str(n:n) == ':') count = count + 1 + end do + nflds = count + 1 + endif + ! allocate memory for flds) + allocate(flds(nflds)) + do k = 1,nflds + ! start with whole list + i0 = 1 + i1 = len_trim(str) + ! remove field names before kth field + do n = 2,k + i = index(str(i0:i1),':') + i0 = i0 + i + end do + ! remove field names after kth field + if (k < nFlds) then + i = index(str(i0:i1),':') + i1 = i0 + i - 2 + end if + ! set flds(k) + flds(k) = str(i0:i1)//" " + end do + end subroutine get_auxflds + + end subroutine med_phases_history_write_comp_aux + + !=============================================================================== + subroutine med_phases_history_fldbun_accum(fldbun, fldbun_accum, count, rc) + + use ESMF, only : ESMF_Field, ESMF_FieldGet + + ! input/output variables + type(ESMF_FieldBundle) , intent(in) :: fldbun + type(ESMF_FieldBundle) , intent(inout) :: fldbun_accum + integer , intent(out) :: count + integer , intent(out) :: rc + + ! local variables + integer :: n + type(ESMF_Field) :: lfield + type(ESMF_Field) :: lfield_accum + integer :: fieldCount + character(CL), pointer :: fieldnames(:) => null() + real(r8), pointer :: dataptr1d(:) => null() + real(r8), pointer :: dataptr2d(:,:) => null() + real(r8), pointer :: dataptr1d_accum(:) => null() + real(r8), pointer :: dataptr2d_accum(:,:) => null() + integer :: ungriddedUBound(1) + !--------------------------------------- + + rc = ESMF_SUCCESS + + ! Accumulate field + call ESMF_FieldBundleGet(fldbun_accum, fieldCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(fieldnames(fieldCount)) + call ESMF_FieldBundleGet(fldbun_accum, fieldNameList=fieldnames, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + do n = 1, fieldcount + call ESMF_FieldBundleGet(fldbun, fieldName=trim(fieldnames(n)), field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleGet(fldbun_accum, fieldName=trim(fieldnames(n)), field=lfield_accum, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, ungriddedUBound=ungriddedUBound, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (ungriddedUBound(1) > 0) then + call ESMF_FieldGet(lfield, farrayptr=dataptr2d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield_accum, farrayptr=dataptr2d_accum, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + dataptr2d_accum(:,:) = dataptr2d_accum(:,:) + dataptr2d(:,:) + else + call ESMF_FieldGet(lfield, farrayptr=dataptr1d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield_accum, farrayptr=dataptr1d_accum, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + dataptr1d_accum(:) = dataptr1d_accum(:) + dataptr1d(:) + end if + end do + deallocate(fieldnames) + + ! Accumulate counter + count = count + 1 + + end subroutine med_phases_history_fldbun_accum + + !=============================================================================== + subroutine med_phases_history_fldbun_average(fldbun_accum, count, rc) + + use ESMF , only : ESMF_Field, ESMF_FieldGet + use med_constants_mod , only : czero => med_constants_czero + + ! input/output variables + type(ESMF_FieldBundle) , intent(inout) :: fldbun_accum + integer , intent(inout) :: count + integer , intent(out) :: rc + + ! local variables + integer :: n,i + type(ESMF_Field) :: lfield_accum + integer :: fieldCount + character(CL), pointer :: fieldnames(:) => null() + real(r8), pointer :: dataptr1d_accum(:) => null() + real(r8), pointer :: dataptr2d_accum(:,:) => null() + integer :: ungriddedUBound(1) + !--------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_FieldBundleGet(fldbun_accum, fieldCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(fieldnames(fieldCount)) + call ESMF_FieldBundleGet(fldbun_accum, fieldNameList=fieldnames, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + do n = 1, fieldcount + call ESMF_FieldBundleGet(fldbun_accum, fieldName=trim(fieldnames(n)), field=lfield_accum, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield_accum, ungriddedUBound=ungriddedUBound, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (ungriddedUBound(1) > 0) then + call ESMF_FieldGet(lfield_accum, farrayptr=dataptr2d_accum, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (count == 0) then + dataptr2d_accum(:,:) = czero + else + dataptr2d_accum(:,:) = dataptr2d_accum(:,:) / real(count, r8) end if - if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a,rc=rc)) then - nx = is_local%wrap%nx(compatm) - ny = is_local%wrap%ny(compatm) - call med_io_write(hist_file, iam, is_local%wrap%FBMed_aoflux_a, & - nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre='Med_aoflux_atm', rc=rc) + else + call ESMF_FieldGet(lfield_accum, farrayptr=dataptr1d_accum, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (count == 0) then + dataptr1d_accum(:) = czero + else + dataptr1d_accum(:) = dataptr1d_accum(:) / real(count, r8) end if - enddo + end if + end do + deallocate(fieldnames) + + ! Reset counter + count = 0 + + end subroutine med_phases_history_fldbun_average + + !=============================================================================== + subroutine med_phases_history_init_histclock(gcomp, hclock, alarm, alarmname, hist_option, hist_n, rc) + + use NUOPC_Mediator, only : NUOPC_MediatorGet + use ESMF , only : ESMF_ClockCreate, ESMF_ClockGet, ESMF_ClockSet + use med_time_mod , only : med_time_alarmInit + + ! input/output variables + type(ESMF_GridComp) , intent(in) :: gcomp + type(ESMF_Clock) , intent(inout) :: hclock + type(ESMF_Alarm) , intent(inout) :: alarm + character(len=*) , intent(in) :: alarmname + character(len=*) , intent(in) :: hist_option ! freq_option setting (ndays, nsteps, etc) + integer , intent(in) :: hist_n ! freq_n setting relative to freq_option + integer , intent(out) :: rc + + ! local variables + type(ESMF_Clock) :: mclock, dclock + type(ESMF_Time) :: StartTime + type(ESMF_TimeInterval) :: htimestep + type(ESMF_TimeInterval) :: mtimestep, dtimestep + integer :: msec, dsec + character(len=*), parameter :: subname='(med_phases_history_init_histclock) ' + !--------------------------------------- + + rc = ESMF_SUCCESS + + call NUOPC_MediatorGet(gcomp, mediatorClock=mClock, driverClock=dClock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ClockGet(mclock, timeStep=mtimestep, starttime=starttime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeIntervalGet(mtimestep, s=msec, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ClockGet(dclock, timeStep=dtimestep, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeIntervalGet(dtimestep, s=dsec, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (mastertask) then + write(logunit,'(a,2x,i8,2x,i8)') trim(subname) // " mediator, driver timesteps for " & + //trim(alarmname),msec,dsec + end if - call med_io_close(hist_file, iam, rc=rc) + ! Create history clock from mediator clock - THIS CALL DOES NOT COPY ALARMS + hclock = ESMF_ClockCreate(mclock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Initialize history alarm and advance history clock to trigger + ! alarms then reset history clock back to mcurrtime + call med_time_alarmInit(hclock, alarm, option=hist_option, opt_n=hist_n, & + reftime=StartTime, alarmname=trim(alarmname), advance_clock=.true., rc=rc) + + ! Write diagnostic info + if (mastertask) then + write(logunit,'(a,2x,i8)') trim(subname) // " initialized history alarm "//& + trim(alarmname)//" with option "//trim(hist_option)//" and frequency ",hist_n + end if + + end subroutine med_phases_history_init_histclock + + !=============================================================================== + subroutine med_phases_history_query_ifwrite(gcomp, hclock, alarmname, write_now, rc) + + use NUOPC_Mediator, only : NUOPC_MediatorGet + + ! input/output variables + type(ESMF_GridComp) , intent(in) :: gcomp + type(ESMF_Clock) , intent(inout) :: hclock ! write clock + character(len=*) , intent(in) :: alarmname ! write alarmname + logical , intent(out) :: write_now ! if true => write now + integer , intent(out) :: rc ! error code + + ! local variables + type(ESMF_Clock) :: mclock ! mediator clock + type(ESMF_Alarm) :: alarm ! write alarm + type(ESMF_Time) :: currtime ! current time + character(len=CS) :: currtimestr ! current time string + type(ESMF_Time) :: nexttime ! next time + character(len=CS) :: nexttimestr ! next time string + integer :: yr,mon,day,sec ! time units + type(ESMF_TimeInterval) :: ringInterval + integer :: ringInterval_length + character(len=*), parameter :: subname='(med_phases_history_query_ifwrite) ' + !--------------------------------------- + + rc = ESMF_SUCCESS + + ! Update hclock to trigger alarm + call ESMF_ClockAdvance(hclock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Get the history file alarm and determine if alarm is ringing + call ESMF_ClockGetAlarm(hclock, alarmname=trim(alarmname), alarm=alarm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Set write_now flag and turn ringer off if appropriate + if (ESMF_AlarmIsRinging(alarm, rc=rc)) then + if (ChkErr(rc,__LINE__,u_FILE_u)) return + write_now = .true. + call ESMF_AlarmRingerOff(alarm, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + write_now = .false. + end if + + ! Write diagnostic output + if (write_now) then + if (mastertask .and. debug_alarms) then + ! output alarm info + call ESMF_AlarmGet(alarm, ringInterval=ringInterval, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeIntervalGet(ringInterval, s=ringinterval_length, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ClockGet(hclock, currtime=currtime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeGet(currtime,yy=yr, mm=mon, dd=day, s=sec, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(currtimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + call ESMF_ClockGetNextTime(hclock, nextTime=nexttime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeGet(nexttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(nexttimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec - endif + if (mastertask) then + write(logunit,*) + write(logunit,'(a,i8)') trim(subname)//" : history alarmname "//trim(alarmname)//& + ' is ringing, interval length is ', ringInterval_length + write(logunit,'(a)') trim(subname)//" : hclock currtime = "//trim(currtimestr)//& + " hclock nexttime = "//trim(nexttimestr) + end if - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) - endif - call t_stopf('MED:'//subname) + call NUOPC_MediatorGet(gcomp, mediatorClock=mClock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockGet(mclock, currtime=currtime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeGet(currtime,yy=yr, mm=mon, dd=day, s=sec, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(currtimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + + call ESMF_ClockGetNextTime(mclock, nextTime=nexttime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeGet(nexttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(nexttimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec - first_time = .false. + if (mastertask) then + write(logunit,'(a)') trim(subname)//" : mclock currtime = "//trim(currtimestr)//& + " mclock nexttime = "//trim(nexttimestr) + end if - end subroutine med_phases_history_write + end if + end if + + end subroutine med_phases_history_query_ifwrite !=============================================================================== + subroutine med_phases_history_set_timeinfo(gcomp, hclock, alarmname, & + time_val, time_bnds, time_units, histfile, doavg, auxname, compname, rc) + + use NUOPC_Mediator , only : NUOPC_MediatorGet + use ESMF , only : ESMF_GridComp, ESMF_Clock, ESMF_Alarm, ESMF_Time, ESMF_TimeInterval + use ESMF , only : ESMF_ClockGet, ESMF_ClockGetNextTime, ESMF_ClockGetAlarm + use ESMF , only : ESMF_AlarmGet, ESMF_TimeIntervalGet, ESMF_TimeGet + use med_constants_mod , only : SecPerDay => med_constants_SecPerDay + use med_io_mod , only : med_io_ymd2date, med_io_date2yyyymmdd, med_io_sec2hms + + ! input/output variables + type(ESMF_GridComp) , intent(in) :: gcomp + type(ESMF_Clock) , intent(in) :: hclock + character(len=*) , intent(in) :: alarmname + real(r8) , intent(out) :: time_val + real(r8) , intent(out) :: time_bnds(2) + character(len=*) , intent(out) :: time_units + character(len=*) , intent(out) :: histfile + logical , intent(in) :: doavg + character(len=*) , optional , intent(in) :: auxname + character(len=*) , optional , intent(in) :: compname + integer , intent(out) :: rc + + ! local variables + type(ESMF_Clock) :: mclock + type(ESMF_Alarm) :: alarm + type(ESMF_Time) :: starttime + type(ESMF_Time) :: currtime + type(ESMF_Time) :: nexttime + type(ESMF_TimeInterval) :: ringInterval ! alarm interval + type(ESMF_TimeInterval) :: timediff(2) ! time bounds upper and lower relative to start + character(len=CL) :: currtime_str + character(len=CL) :: nexttime_str + character(len=CL) :: hist_str + integer :: yr,mon,day,sec ! time units + integer :: start_ymd ! Starting date YYYYMMDD + logical :: isPresent + logical :: isSet + character(len=*), parameter :: subname='(med_phases_history_set_timeinfo) ' + !--------------------------------------- + + rc = ESMF_SUCCESS + + ! Determine starttime, currtime and nexttime from the mediator clock rather than the input history clock + call NUOPC_MediatorGet(gcomp, mediatorClock=mClock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockGet(mclock, currtime=currtime, starttime=starttime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockGetNextTime(mclock, nextTime=nexttime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Determine time units + call ESMF_TimeGet(starttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_io_ymd2date(yr,mon,day,start_ymd) + time_units = 'days since ' // trim(med_io_date2yyyymmdd(start_ymd)) // ' ' // med_io_sec2hms(sec, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Set time bounds and time coord + if (doavg) then + call ESMF_ClockGetAlarm(hclock, alarmname=trim(alarmname), alarm=alarm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_AlarmGet(alarm, ringInterval=ringInterval, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + timediff(2) = nexttime - starttime + timediff(1) = nexttime - starttime - ringinterval + call ESMF_TimeIntervalGet(timediff(2), d_r8=time_bnds(2), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeIntervalGet(timediff(1), d_r8=time_bnds(1), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + time_val = 0.5_r8 * (time_bnds(1) + time_bnds(2)) + else + timediff(1) = nexttime - starttime + call ESMF_TimeIntervalGet(timediff(1), d=day, s=sec, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + time_val = day + sec/real(SecPerDay,R8) + time_bnds(1) = time_val + time_bnds(2) = time_val + end if + + ! Determine history file name + ! Use nexttime_str rather than currtime_str here since that is the time at the end of + ! the timestep and is preferred for history file names + + call ESMF_TimeGet(nexttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(nexttime_str,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + + if (trim(case_name) == 'unset') then + call NUOPC_CompAttributeGet(gcomp, name='case_name', value=case_name, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(gcomp, name='inst_suffix', isPresent=isPresent, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if(isPresent) then + call NUOPC_CompAttributeGet(gcomp, name='inst_suffix', value=inst_tag, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + inst_tag = "" + endif + end if + + if (present(auxname)) then + write(histfile, "(8a)") trim(case_name),'.cpl' ,trim(inst_tag),'.hx.',trim(auxname),'.',& + trim(nexttime_str),'.nc' + else if (present(compname)) then + if (doavg) then + hist_str = '.ha.' + else + hist_str = '.hi.' + end if + if (trim(compname) /= 'all') then + hist_str = trim(hist_str) // trim(compname) // '.' + end if + write(histfile, "(6a)") trim(case_name),'.cpl',trim(inst_tag),trim(hist_str),trim(nexttime_str),'.nc' + end if + + if (mastertask) then + call ESMF_TimeGet(currtime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(currtime_str,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + write(logunit,*) + write(logunit,' (a)') trim(subname) // " writing mediator history file "//trim(histfile) + write(logunit,' (a)') trim(subname) // " currtime = "//trim(currtime_str)//" nexttime = "//trim(nexttime_str) + end if + + end subroutine med_phases_history_set_timeinfo end module med_phases_history_mod diff --git a/mediator/med_phases_post_atm_mod.F90 b/mediator/med_phases_post_atm_mod.F90 index bd6b9323..acf1c229 100644 --- a/mediator/med_phases_post_atm_mod.F90 +++ b/mediator/med_phases_post_atm_mod.F90 @@ -22,10 +22,13 @@ subroutine med_phases_post_atm(gcomp, rc) ! map atm to ocn and atm to ice and atm to land !--------------------------------------- + use NUOPC_Mediator , only : NUOPC_MediatorGet + use ESMF , only : ESMF_Clock, ESMF_ClockIsCreated use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_FieldBundleGet use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use med_internalstate_mod , only : InternalState, mastertask, logunit + use med_phases_history_mod, only : med_phases_history_write_comp use med_map_mod , only : med_map_field_packed use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_utils_mod , only : chkerr => med_utils_ChkErr @@ -38,6 +41,7 @@ subroutine med_phases_post_atm(gcomp, rc) ! local variables type(InternalState) :: is_local + type(ESMF_Clock) :: dClock character(len=*), parameter :: subname='(med_phases_post_atm)' !------------------------------------------------------------------------------- @@ -93,6 +97,14 @@ subroutine med_phases_post_atm(gcomp, rc) call t_stopf('MED:'//trim(subname)//' map_atm2lnd') end if + ! Write atm inst, avg or aux if requested in mediator attributes + call NUOPC_MediatorGet(gcomp, driverClock=dClock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (ESMF_ClockIsCreated(dclock)) then + call med_phases_history_write_comp(gcomp, compatm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + if (dbug_flag > 20) then call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) end if diff --git a/mediator/med_phases_post_glc_mod.F90 b/mediator/med_phases_post_glc_mod.F90 index e04fc64b..4dd1e1ef 100644 --- a/mediator/med_phases_post_glc_mod.F90 +++ b/mediator/med_phases_post_glc_mod.F90 @@ -85,11 +85,16 @@ module med_phases_post_glc_mod subroutine med_phases_post_glc(gcomp, rc) + use NUOPC_Mediator , only : NUOPC_MediatorGet + use ESMF , only : ESMF_Clock, ESMF_ClockIsCreated + use med_phases_history_mod, only : med_phases_history_write_comp + ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc ! local variables + type(ESMF_Clock) :: dClock type(ESMF_StateItem_Flag) :: itemType type(InternalState) :: is_local integer :: n1,ncnt,ns @@ -213,6 +218,16 @@ subroutine med_phases_post_glc(gcomp, rc) ! Reset first call logical first_call = .false. + ! Write glc inst, avg or aux if requested in mediator attributes + call NUOPC_MediatorGet(gcomp, driverClock=dClock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (ESMF_ClockIsCreated(dclock)) then + do ns = 1,num_icesheets + call med_phases_history_write_comp(gcomp, compglc(ns), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do + end if + if (dbug_flag > 20) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end if diff --git a/mediator/med_phases_post_ice_mod.F90 b/mediator/med_phases_post_ice_mod.F90 index f605006e..2daa4c35 100644 --- a/mediator/med_phases_post_ice_mod.F90 +++ b/mediator/med_phases_post_ice_mod.F90 @@ -18,15 +18,18 @@ module med_phases_post_ice_mod subroutine med_phases_post_ice(gcomp, rc) - use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 + use NUOPC_Mediator , only : NUOPC_MediatorGet + use ESMF , only : ESMF_Clock, ESMF_ClockIsCreated use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS use ESMF , only : ESMF_GridComp + use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_utils_mod , only : chkerr => med_utils_ChkErr use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose use med_map_mod , only : med_map_field_packed use med_fraction_mod , only : med_fraction_set use med_internalstate_mod , only : InternalState, mastertask + use med_phases_history_mod, only : med_phases_history_write_comp use esmFlds , only : compice, compatm, compocn, compwav use perf_mod , only : t_startf, t_stopf @@ -35,7 +38,8 @@ subroutine med_phases_post_ice(gcomp, rc) integer, intent(out) :: rc ! local variables - type(InternalState) :: is_local + type(InternalState) :: is_local + type(ESMF_Clock) :: dClock character(len=*),parameter :: subname='(med_phases_post_ice)' !------------------------------------------------------------------------------- @@ -94,6 +98,14 @@ subroutine med_phases_post_ice(gcomp, rc) call t_stopf('MED:'//trim(subname)//' map_ice2wav') end if + ! Write ice inst, avg or aux if requested in mediator attributes + call NUOPC_MediatorGet(gcomp, driverClock=dClock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (ESMF_ClockIsCreated(dclock)) then + call med_phases_history_write_comp(gcomp, compice, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + call t_stopf('MED:'//subname) if (dbug_flag > 20) then call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) diff --git a/mediator/med_phases_post_lnd_mod.F90 b/mediator/med_phases_post_lnd_mod.F90 index 538db977..1bd416c7 100644 --- a/mediator/med_phases_post_lnd_mod.F90 +++ b/mediator/med_phases_post_lnd_mod.F90 @@ -3,7 +3,6 @@ module med_phases_post_lnd_mod implicit none private - public :: med_phases_post_lnd_init ! does not accumulate input to rof public :: med_phases_post_lnd character(*), parameter :: u_FILE_u = & @@ -15,17 +14,21 @@ module med_phases_post_lnd_mod subroutine med_phases_post_lnd(gcomp, rc) - use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 + use NUOPC_Mediator , only : NUOPC_MediatorGet + use ESMF , only : ESMF_Clock, ESMF_ClockIsCreated use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS use ESMF , only : ESMF_GridComp + use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_utils_mod , only : chkerr => med_utils_ChkErr use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose use med_map_mod , only : med_map_field_packed use med_internalstate_mod , only : InternalState, mastertask use med_phases_prep_rof_mod , only : med_phases_prep_rof_accum - use med_phases_prep_glc_mod , only : med_phases_prep_glc_accum_lnd - use esmFlds , only : complnd, compatm, comprof, compglc, num_icesheets, lnd2glc_coupling + use med_phases_prep_glc_mod , only : med_phases_prep_glc_accum_lnd, med_phases_prep_glc_avg + use med_phases_history_mod , only : med_phases_history_write_comp + use esmFlds , only : complnd, compatm, comprof, compglc, num_icesheets + use esmFlds , only : lnd2glc_coupling, accum_lnd2glc use perf_mod , only : t_startf, t_stopf ! input/output variables @@ -34,6 +37,7 @@ subroutine med_phases_post_lnd(gcomp, rc) ! local variables type(InternalState) :: is_local + type(ESMF_Clock) :: dClock character(len=*),parameter :: subname='(med_phases_post_lnd)' !------------------------------------------------------------------------------- @@ -49,82 +53,61 @@ subroutine med_phases_post_lnd(gcomp, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! map lnd to atm - if (is_local%wrap%med_coupling_active(complnd,compatm)) then - call med_map_field_packed( & - FBSrc=is_local%wrap%FBImp(complnd,complnd), & - FBDst=is_local%wrap%FBImp(complnd,compatm), & - FBFracSrc=is_local%wrap%FBFrac(complnd), & - field_NormOne=is_local%wrap%field_normOne(complnd,compatm,:), & - packed_data=is_local%wrap%packed_data(complnd,compatm,:), & - routehandles=is_local%wrap%RH(complnd,compatm,:), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - - ! accumulate lnd input for rof - if (is_local%wrap%med_coupling_active(complnd,comprof)) then - call med_phases_prep_rof_accum(gcomp, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if + call NUOPC_MediatorGet(gcomp, driverClock=dClock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! accumulate lnd input for glc (note that lnd2glc_coupling is determined in med.F90) - if (lnd2glc_coupling) then - call med_phases_prep_glc_accum_lnd(gcomp, rc) + ! If driver clock is created then are in the run phase otherwise are in the initialization phase + if (ESMF_ClockIsCreated(dclock)) then + + ! map lnd to atm + if (is_local%wrap%med_coupling_active(complnd,compatm)) then + call med_map_field_packed( & + FBSrc=is_local%wrap%FBImp(complnd,complnd), & + FBDst=is_local%wrap%FBImp(complnd,compatm), & + FBFracSrc=is_local%wrap%FBFrac(complnd), & + field_NormOne=is_local%wrap%field_normOne(complnd,compatm,:), & + packed_data=is_local%wrap%packed_data(complnd,compatm,:), & + routehandles=is_local%wrap%RH(complnd,compatm,:), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + ! accumulate lnd input for rof + if (is_local%wrap%med_coupling_active(complnd,comprof)) then + call med_phases_prep_rof_accum(gcomp, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + ! accumulate lnd input for glc (note that lnd2glc_coupling and accum_lnd2glc is determined in med.F90) + if (lnd2glc_coupling) then + call med_phases_prep_glc_accum_lnd(gcomp, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Note that in this case med_phases_prep_glc_avg is called + ! from med_phases_prep_glc in the run sequence + else if (accum_lnd2glc) then + call med_phases_prep_glc_accum_lnd(gcomp, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_phases_prep_glc_avg(gcomp, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + ! Write lnd inst, avg or aux if requested in mediator attributes + call med_phases_history_write_comp(gcomp, complnd, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - - if (dbug_flag > 20) then - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) - end if - call t_stopf('MED:'//subname) - - end subroutine med_phases_post_lnd - - !=============================================================================== - subroutine med_phases_post_lnd_init(gcomp, rc) - - use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS - use ESMF , only : ESMF_GridComp - use med_constants_mod , only : dbug_flag => med_constants_dbug_flag - use med_utils_mod , only : chkerr => med_utils_ChkErr - use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose - use med_map_mod , only : med_map_field_packed - use med_internalstate_mod , only : InternalState, mastertask - use esmFlds , only : complnd, compatm - use perf_mod , only : t_startf, t_stopf - - ! input/output variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - ! local variables - type(InternalState) :: is_local - character(len=*),parameter :: subname='(med_phases_post_lnd)' - !------------------------------------------------------------------------------- + else - call t_startf('MED:'//subname) - rc = ESMF_SUCCESS + ! initialization phase - map lnd to atm + if (is_local%wrap%med_coupling_active(complnd,compatm)) then + call med_map_field_packed( & + FBSrc=is_local%wrap%FBImp(complnd,complnd), & + FBDst=is_local%wrap%FBImp(complnd,compatm), & + FBFracSrc=is_local%wrap%FBFrac(complnd), & + field_NormOne=is_local%wrap%field_normOne(complnd,compatm,:), & + packed_data=is_local%wrap%packed_data(complnd,compatm,:), & + routehandles=is_local%wrap%RH(complnd,compatm,:), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if - if (dbug_flag > 20) then - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) - end if - - ! Get the internal state - nullify(is_local%wrap) - call ESMF_GridCompGetInternalState(gcomp, is_local, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! map lnd to atm - if (is_local%wrap%med_coupling_active(complnd,compatm)) then - call med_map_field_packed( & - FBSrc=is_local%wrap%FBImp(complnd,complnd), & - FBDst=is_local%wrap%FBImp(complnd,compatm), & - FBFracSrc=is_local%wrap%FBFrac(complnd), & - field_NormOne=is_local%wrap%field_normOne(complnd,compatm,:), & - packed_data=is_local%wrap%packed_data(complnd,compatm,:), & - routehandles=is_local%wrap%RH(complnd,compatm,:), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return end if if (dbug_flag > 20) then @@ -132,6 +115,6 @@ subroutine med_phases_post_lnd_init(gcomp, rc) end if call t_stopf('MED:'//subname) - end subroutine med_phases_post_lnd_init + end subroutine med_phases_post_lnd end module med_phases_post_lnd_mod diff --git a/mediator/med_phases_post_ocn_mod.F90 b/mediator/med_phases_post_ocn_mod.F90 index d0d00b97..c51f9eec 100644 --- a/mediator/med_phases_post_ocn_mod.F90 +++ b/mediator/med_phases_post_ocn_mod.F90 @@ -20,13 +20,16 @@ module med_phases_post_ocn_mod subroutine med_phases_post_ocn(gcomp, rc) - use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 + use NUOPC_Mediator , only : NUOPC_MediatorGet + use ESMF , only : ESMF_Clock, ESMF_ClockIsCreated use ESMF , only : ESMF_GridComp use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS + use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use med_utils_mod , only : chkerr => med_utils_ChkErr use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_map_mod , only : med_map_field_packed use med_internalstate_mod , only : InternalState, logunit, mastertask + use med_phases_history_mod , only : med_phases_history_write_comp use med_phases_prep_glc_mod , only : med_phases_prep_glc_accum_ocn use esmFlds , only : compice, compglc, compocn, num_icesheets use perf_mod , only : t_startf, t_stopf @@ -38,6 +41,7 @@ subroutine med_phases_post_ocn(gcomp, rc) ! local variables type(InternalState) :: is_local integer :: ns + type(ESMF_Clock) :: dClock logical :: first_call = .true. character(len=*),parameter :: subname='(med_phases_post_ocn)' !--------------------------------------- @@ -83,6 +87,14 @@ subroutine med_phases_post_ocn(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if + ! Write ocn inst, avg or aux if requested in mediator attributes + call NUOPC_MediatorGet(gcomp, driverClock=dClock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (ESMF_ClockIsCreated(dclock)) then + call med_phases_history_write_comp(gcomp, compocn, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + if (dbug_flag > 20) then call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) end if diff --git a/mediator/med_phases_post_rof_mod.F90 b/mediator/med_phases_post_rof_mod.F90 index 93e73ac3..10ca7bfc 100644 --- a/mediator/med_phases_post_rof_mod.F90 +++ b/mediator/med_phases_post_rof_mod.F90 @@ -16,13 +16,16 @@ module med_phases_post_rof_mod subroutine med_phases_post_rof(gcomp, rc) - use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 + use NUOPC_Mediator , only : NUOPC_MediatorGet + use ESMF , only : ESMF_Clock, ESMF_ClockIsCreated use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LOGMSG_ERROR, ESMF_SUCCESS, ESMF_FAILURE use ESMF , only : ESMF_GridComp, ESMF_GridCompGet + use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use esmFlds , only : complnd, compocn, compice, compatm, comprof, ncomps, compname use med_utils_mod , only : chkerr => med_utils_ChkErr use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_internalstate_mod , only : InternalState, mastertask, logunit + use med_phases_history_mod, only : med_phases_history_write_comp use med_map_mod , only : med_map_field_packed use perf_mod , only : t_startf, t_stopf @@ -32,6 +35,7 @@ subroutine med_phases_post_rof(gcomp, rc) ! local variables type(InternalState) :: is_local + type(ESMF_Clock) :: dClock character(len=*), parameter :: subname='(med_phases_post_rof)' !--------------------------------------- @@ -86,6 +90,14 @@ subroutine med_phases_post_rof(gcomp, rc) call t_stopf('MED:'//trim(subname)//' map_rof2ice') end if + ! Write rof inst, avg or aux if requested in mediator attributes + call NUOPC_MediatorGet(gcomp, driverClock=dClock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (ESMF_ClockIsCreated(dclock)) then + call med_phases_history_write_comp(gcomp, comprof, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + if (dbug_flag > 20) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end if diff --git a/mediator/med_phases_post_wav_mod.F90 b/mediator/med_phases_post_wav_mod.F90 index feb1c851..a1bf805e 100644 --- a/mediator/med_phases_post_wav_mod.F90 +++ b/mediator/med_phases_post_wav_mod.F90 @@ -14,14 +14,17 @@ module med_phases_post_wav_mod subroutine med_phases_post_wav(gcomp, rc) - use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 + use NUOPC_Mediator , only : NUOPC_MediatorGet + use ESMF , only : ESMF_Clock, ESMF_ClockIsCreated use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS use ESMF , only : ESMF_GridComp + use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_utils_mod , only : chkerr => med_utils_ChkErr use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose use med_map_mod , only : med_map_field_packed use med_internalstate_mod , only : InternalState, mastertask + use med_phases_history_mod, only : med_phases_history_write_comp use esmFlds , only : compwav, compatm, compocn, compice use perf_mod , only : t_startf, t_stopf @@ -30,7 +33,8 @@ subroutine med_phases_post_wav(gcomp, rc) integer, intent(out) :: rc ! local variables - type(InternalState) :: is_local + type(InternalState) :: is_local + type(ESMF_Clock) :: dClock character(len=*),parameter :: subname='(med_phases_post_wav)' !------------------------------------------------------------------------------- @@ -80,6 +84,14 @@ subroutine med_phases_post_wav(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if + ! Write atm inst, avg or aux if requested in mediator attributes + call NUOPC_MediatorGet(gcomp, driverClock=dClock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (ESMF_ClockIsCreated(dclock)) then + call med_phases_history_write_comp(gcomp, compwav, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + call t_stopf('MED:'//subname) if (dbug_flag > 20) then call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) diff --git a/mediator/med_phases_prep_glc_mod.F90 b/mediator/med_phases_prep_glc_mod.F90 index 2009f27f..09c5eb8a 100644 --- a/mediator/med_phases_prep_glc_mod.F90 +++ b/mediator/med_phases_prep_glc_mod.F90 @@ -24,7 +24,8 @@ module med_phases_prep_glc_mod use ESMF , only : ESMF_DYNAMICMASK, ESMF_DynamicMaskSetR8R8R8, ESMF_DYNAMICMASKELEMENTR8R8R8 use ESMF , only : ESMF_FieldRegrid use esmFlds , only : complnd, compocn, mapbilnr, mapconsd, compname - use esmFlds , only : max_icesheets, num_icesheets, compglc, ocn2glc_coupling, lnd2glc_coupling + use esmFlds , only : max_icesheets, num_icesheets, compglc + use esmFlds , only : ocn2glc_coupling, lnd2glc_coupling, accum_lnd2glc use med_internalstate_mod , only : InternalState, mastertask, logunit use med_map_mod , only : med_map_routehandles_init, med_map_rh_is_created use med_map_mod , only : med_map_field_normalized, med_map_field @@ -50,9 +51,10 @@ module med_phases_prep_glc_mod private public :: med_phases_prep_glc_init ! called from med.F90 - public :: med_phases_prep_glc ! called from nuopc run sequence public :: med_phases_prep_glc_accum_lnd ! called from med_phases_post_lnd_mod.F90 public :: med_phases_prep_glc_accum_ocn ! called from med_phases_post_ocn_mod.F90 + public :: med_phases_prep_glc_avg ! called either from med_phases_post_lnd_mod.F90 or med_phases_prep_glc + public :: med_phases_prep_glc ! called from nuopc run sequence private :: med_phases_prep_glc_map_lnd2glc private :: med_phases_prep_glc_renormalize_smb @@ -73,6 +75,7 @@ module med_phases_prep_glc_mod type(ESMF_FieldBundle), public :: FBlndAccum2glc_l integer , public :: lndAccum2glc_cnt + character(len=14) :: fldnames_fr_lnd(3) = (/'Flgl_qice_elev','Sl_tsrf_elev ','Sl_topo_elev '/) character(len=14) :: fldnames_to_glc(2) = (/'Flgl_qice ','Sl_tsrf '/) @@ -131,16 +134,22 @@ subroutine med_phases_prep_glc_init(gcomp, rc) integer, intent(out) :: rc ! local variables - type(InternalState) :: is_local - integer :: i,n,ns,nf - type(ESMF_Mesh) :: mesh_l - type(ESMF_Mesh) :: mesh_o - type(ESMF_Field) :: lfield - real(r8), pointer :: data2d_in(:,:) => null() - real(r8), pointer :: data2d_out(:,:) => null() - character(len=CS) :: glc_renormalize_smb - logical :: glc_coupled_fluxes - integer :: ungriddedUBound_output(1) ! currently the size must equal 1 for rank 2 fieldds + type(InternalState) :: is_local + type(ESMF_Clock) :: med_clock + type(ESMF_ALARM) :: glc_avg_alarm + character(len=CS) :: glc_avg_period + type(ESMF_Time) :: starttime + integer :: glc_cpl_dt + integer :: i,n,ns,nf + type(ESMF_Mesh) :: mesh_l + type(ESMF_Mesh) :: mesh_o + type(ESMF_Field) :: lfield + character(len=CS) :: cvalue + real(r8), pointer :: data2d_in(:,:) => null() + real(r8), pointer :: data2d_out(:,:) => null() + character(len=CS) :: glc_renormalize_smb + logical :: glc_coupled_fluxes + integer :: ungriddedUBound_output(1) ! currently the size must equal 1 for rank 2 fieldds character(len=*),parameter :: subname=' (med_phases_prep_glc_init) ' !--------------------------------------- @@ -157,43 +166,10 @@ subroutine med_phases_prep_glc_init(gcomp, rc) if (chkErr(rc,__LINE__,u_FILE_u)) return ! ------------------------------- - ! If lnd->glc couplng is active + ! If will accumulate lnd2glc input on land grid ! ------------------------------- - if (lnd2glc_coupling) then - - ! Determine if renormalize smb - call NUOPC_CompAttributeGet(gcomp, name='glc_renormalize_smb', value=glc_renormalize_smb, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! TODO: talk to Bill Sacks to determine if this is the correct logic - glc_coupled_fluxes = is_local%wrap%med_coupling_active(compglc(1),complnd) - - ! Note glc_coupled_fluxes should be false in the no_evolve cases - ! Goes back to the zero-gcm fluxes variable - if zero-gcm fluxes is true than do not renormalize - ! The user can set this to true in an evolve cases - - select case (glc_renormalize_smb) - case ('on') - smb_renormalize = .true. - case ('off') - smb_renormalize = .false. - case ('on_if_glc_coupled_fluxes') - if (.not. glc_coupled_fluxes) then - ! Do not renormalize if med_coupling_active is not true for compglc->complnd - ! In this case, conservation is not important - smb_renormalize = .false. - else - smb_renormalize = .true. - end if - case default - write(logunit,*) subname,' ERROR: unknown value for glc_renormalize_smb: ', trim(glc_renormalize_smb) - call ESMF_LogWrite(trim(subname)//' ERROR: unknown value for glc_renormalize_smb: '// trim(glc_renormalize_smb), & - ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__) - rc = ESMF_FAILURE - return - end select - + if (accum_lnd2glc) then ! Create field bundles for the fldnames_fr_lnd that have an ! undistributed dimension corresponding to elevation classes (including bare land) call ESMF_FieldBundleGet(is_local%wrap%FBImp(complnd,complnd), fldnames_fr_lnd(1), field=lfield, rc=rc) @@ -221,7 +197,13 @@ subroutine med_phases_prep_glc_init(gcomp, rc) end do call fldbun_reset(FBlndAccum2glc_l, value=0.0_r8, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + + ! ------------------------------- + ! If lnd->glc couplng is active + ! ------------------------------- + if (lnd2glc_coupling) then ! Create accumulation field bundles from land on each glc ice sheet mesh ! Determine glc mesh from the mesh from the first export field to glc ! However FBlndAccum2glc_g has the fields fldnames_fr_lnd BUT ON the glc grid @@ -258,9 +240,7 @@ subroutine med_phases_prep_glc_init(gcomp, rc) end if end do - ! ------------------------------- ! Determine if renormalize smb - ! ------------------------------- call NUOPC_CompAttributeGet(gcomp, name='glc_renormalize_smb', value=glc_renormalize_smb, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -415,11 +395,6 @@ subroutine med_phases_prep_glc_accum_lnd(gcomp, rc) integer :: i,n real(r8), pointer :: data2d_in(:,:) => null() real(r8), pointer :: data2d_out(:,:) => null() - type(ESMF_Clock) :: med_clock - type(ESMF_ALARM) :: glc_avg_alarm - character(len=CS) :: glc_avg_period - integer :: glc_cpl_dt - character(len=CS) :: cvalue character(len=*),parameter :: subname=' (med_phases_prep_glc_accum) ' !--------------------------------------- @@ -430,49 +405,6 @@ subroutine med_phases_prep_glc_accum_lnd(gcomp, rc) rc = ESMF_SUCCESS - if (.not. ESMF_ClockIsCreated(prepglc_clock)) then - - ! Initialize prepglc_clock from mclock - THIS CALL DOES NOT COPY ALARMS - call NUOPC_ModelGet(gcomp, modelClock=med_clock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - prepglc_clock = ESMF_ClockCreate(med_clock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! Set alarm glc averaging interval - call NUOPC_CompAttributeGet(gcomp, name="glc_avg_period", value=glc_avg_period, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (trim(glc_avg_period) == 'yearly') then - call med_time_alarmInit(prepglc_clock, glc_avg_alarm, 'yearly', alarmname='alarm_glc_avg', rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (mastertask) then - write(logunit,'(a,i10)') trim(subname)//& - ' created alarm with averaging period for export to glc is yearly' - end if - else if (trim(glc_avg_period) == 'glc_coupling_period') then - call NUOPC_CompAttributeGet(gcomp, name="glc_cpl_dt", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) glc_cpl_dt - call med_time_alarmInit(prepglc_clock, glc_avg_alarm, 'nseconds', opt_n=glc_cpl_dt, alarmname='alarm_glc_avg', rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (mastertask) then - write(logunit,'(a,i10)') trim(subname)//& - ' created alarm with averaging period for export to glc (in seconds) ',glc_cpl_dt - end if - else - call ESMF_LogWrite(trim(subname)// ": ERROR glc_avg_period = "//trim(glc_avg_period)//" not supported", & - ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - RETURN - end if - call ESMF_AlarmSet(glc_avg_alarm, clock=prepglc_clock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - - ! Advance prepglc_clock - this will make the prepglc_clock in sync with the mediator clock - ! TODO: this assumes that the land is in the fast time loop - call ESMF_ClockAdvance(prepglc_clock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Get the internal state nullify(is_local%wrap) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) @@ -537,11 +469,6 @@ subroutine med_phases_prep_glc_accum_ocn(gcomp, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (chkErr(rc,__LINE__,u_FILE_u)) return - ! Advance prepglc_clock - this will make the prepglc_clock in sync with the mediator clock - ! TODO: do we need 2 clocks? one for the lnd and one for the ocean? - ! call ESMF_ClockAdvance(prepglc_clock, rc=rc) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Accumulate fields from ocean on ocean mesh that will be sent to glc do n = 1, size(fldnames_fr_ocn) call fldbun_getdata2d(is_local%wrap%FBImp(compocn,compocn), fldnames_fr_ocn(n), data2d_in, rc) @@ -566,13 +493,15 @@ subroutine med_phases_prep_glc_accum_ocn(gcomp, rc) end subroutine med_phases_prep_glc_accum_ocn !================================================================================================ - subroutine med_phases_prep_glc(gcomp, rc) + subroutine med_phases_prep_glc_avg(gcomp, rc) !--------------------------------------- ! Create module clock (prepglc_clock) ! Prepare the GLC export Fields from the mediator !--------------------------------------- + use med_phases_history_mod, only : med_phases_history_write_lnd2glc + ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc @@ -593,6 +522,10 @@ subroutine med_phases_prep_glc(gcomp, rc) integer :: i, n, ns real(r8), pointer :: data2d(:,:) => null() real(r8), pointer :: data2d_import(:,:) => null() + character(len=CS) :: cvalue + logical :: do_avg + logical :: isPresent, isSet + logical :: write_histaux_l2x1yrg character(len=*) , parameter :: subname=' (med_phases_prep_glc) ' !--------------------------------------- @@ -608,41 +541,89 @@ subroutine med_phases_prep_glc(gcomp, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (chkErr(rc,__LINE__,u_FILE_u)) return - ! Check time - call NUOPC_ModelGet(gcomp, modelClock=med_clock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockGet(med_clock, currtime=med_currtime, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeGet(med_currtime,yy=yr_med, mm=mon_med, dd=day_med, s=sec_med, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockGet(prepglc_clock, currtime=prepglc_currtime, rc=rc) + if (.not. ESMF_ClockIsCreated(prepglc_clock)) then + ! Initialize prepglc_clock from mclock - THIS CALL DOES NOT COPY ALARMS + call NUOPC_ModelGet(gcomp, modelClock=med_clock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + prepglc_clock = ESMF_ClockCreate(med_clock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Set alarm glc averaging interval + call NUOPC_CompAttributeGet(gcomp, name="glc_avg_period", value=glc_avg_period, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (trim(glc_avg_period) == 'yearly') then + call med_time_alarmInit(prepglc_clock, glc_avg_alarm, 'yearly', alarmname='alarm_glc_avg', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (mastertask) then + write(logunit,'(a,i10)') trim(subname)//& + ' created alarm with averaging period for export to glc is yearly' + end if + else if (trim(glc_avg_period) == 'glc_coupling_period') then + call NUOPC_CompAttributeGet(gcomp, name="glc_cpl_dt", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) glc_cpl_dt + call med_time_alarmInit(prepglc_clock, glc_avg_alarm, 'nseconds', opt_n=glc_cpl_dt, alarmname='alarm_glc_avg', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (mastertask) then + write(logunit,'(a,i10)') trim(subname)//& + ' created alarm with averaging period for export to glc (in seconds) ',glc_cpl_dt + end if + else + call ESMF_LogWrite(trim(subname)// ": ERROR glc_avg_period = "//trim(glc_avg_period)//" not supported", & + ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + RETURN + end if + call ESMF_AlarmSet(glc_avg_alarm, clock=prepglc_clock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + ! Advance prepglc_clock - this will make the prepglc_clock in sync with the mediator clock + call ESMF_ClockAdvance(prepglc_clock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeGet(prepglc_currtime,yy=yr_prepglc, mm=mon_prepglc, dd=day_prepglc, s=sec_prepglc, rc=rc) - if (mastertask) then - write(logunit,'(a,4(i8,2x))') trim(subname)//'med clock yr, mon, day, sec = ',& - yr_med,mon_med,day_med,sec_med - write(logunit,'(a,4(i8,2x))') trim(subname)//'prep glc clock yr, mon, day, sec = ',& - yr_prepglc,mon_prepglc,day_prepglc,sec_prepglc + + ! Check time + if (dbug_flag > 5) then + if (mastertask) then + call NUOPC_ModelGet(gcomp, modelClock=med_clock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockGet(med_clock, currtime=med_currtime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeGet(med_currtime,yy=yr_med, mm=mon_med, dd=day_med, s=sec_med, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockGet(prepglc_clock, currtime=prepglc_currtime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeGet(prepglc_currtime,yy=yr_prepglc, mm=mon_prepglc, dd=day_prepglc, s=sec_prepglc, rc=rc) + if (mastertask) then + write(logunit,'(a,4(i8,2x))') trim(subname)//'med clock yr, mon, day, sec = ',& + yr_med,mon_med,day_med,sec_med + write(logunit,'(a,4(i8,2x))') trim(subname)//'prep glc clock yr, mon, day, sec = ',& + yr_prepglc,mon_prepglc,day_prepglc,sec_prepglc + end if + end if end if ! Determine if the alarm is ringing call ESMF_ClockGetAlarm(prepglc_clock, alarmname='alarm_glc_avg', alarm=alarm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (.not. ESMF_AlarmIsRinging(alarm, rc=rc)) then - ! Do nothing if the alarm is not ringing - call ESMF_LogWrite(trim(subname)//": glc_avg alarm is not ringing - returning", ESMF_LOGMSG_INFO) - else - call ESMF_LogWrite(trim(subname)//": glc_avg alarm is ringing - averaging input from lnd and ocn to glc", & + if (ESMF_AlarmIsRinging(alarm, rc=rc)) then + do_avg = .true. + call ESMF_LogWrite(trim(subname)//": glc_avg alarm is ringing - average input from lnd and ocn to glc", & ESMF_LOGMSG_INFO) if (mastertask) then write(logunit,'(a)') trim(subname)//"glc_avg alarm is ringing - averaging input from lnd and ocn to glc" end if - ! Turn off the alarm call ESMF_AlarmRingerOff( alarm, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + do_avg = .false. + call ESMF_LogWrite(trim(subname)//": glc_avg alarm is not ringing - returning", ESMF_LOGMSG_INFO) + end if - ! Average import from accumulated land import data + ! Average and map data from land (and possibly ocean) + if (do_avg) then + ! Always average import from accumulated land import data do n = 1, size(fldnames_fr_lnd) call fldbun_getdata2d(FBlndAccum2glc_l, fldnames_fr_lnd(n), data2d, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -658,6 +639,22 @@ subroutine med_phases_prep_glc(gcomp, rc) end if end do + ! Write auxiliary history file if flag is set and accumulation is being done + if (lndAccum2glc_cnt > 0) then + call NUOPC_CompAttributeGet(gcomp, name="histaux_l2x1yrg", value=cvalue, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) write_histaux_l2x1yrg + else + write_histaux_l2x1yrg = .false. + end if + if (write_histaux_l2x1yrg) then + call med_phases_history_write_lnd2glc(gcomp, FBlndAccum2glc_l, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end if + if (ocn2glc_coupling) then ! Average import from accumulated ocn import data do n = 1, size(fldnames_fr_ocn) @@ -722,6 +719,18 @@ subroutine med_phases_prep_glc(gcomp, rc) endif call t_stopf('MED:'//subname) + end subroutine med_phases_prep_glc_avg + + !================================================================================================ + subroutine med_phases_prep_glc(gcomp, rc) + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + call med_phases_prep_glc_avg(gcomp, rc) + if (chkErr(rc,__LINE__,u_FILE_u)) return + end subroutine med_phases_prep_glc !================================================================================================ @@ -794,13 +803,11 @@ subroutine med_phases_prep_glc_map_lnd2glc(gcomp, rc) call ESMF_FieldBundleGet(is_local%wrap%FBFrac(complnd), 'lfrac', field=field_lfrac_l, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! TODO: is this needed? + ! map accumlated land fields to each ice sheet (normalize by the land fraction in the mapping) do ns = 1,num_icesheets call fldbun_reset(toglc_frlnd(ns)%FBlndAccum2glc_g, value=0.0_r8, rc=rc) if (chkErr(rc,__LINE__,u_FILE_u)) return end do - - ! map accumlated land fields to each ice sheet (normalize by the land fraction in the mapping) do ns = 1,num_icesheets call ESMF_FieldBundleGet(toglc_frlnd(ns)%FBlndAccum2glc_g, fieldlist=fieldlist_glc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/mediator/med_phases_restart_mod.F90 b/mediator/med_phases_restart_mod.F90 index f119d6ab..e2e00c47 100644 --- a/mediator/med_phases_restart_mod.F90 +++ b/mediator/med_phases_restart_mod.F90 @@ -6,10 +6,8 @@ module med_phases_restart_mod use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use med_constants_mod , only : dbug_flag => med_constants_dbug_flag - use med_constants_mod , only : SecPerDay => med_constants_SecPerDay use med_utils_mod , only : chkerr => med_utils_ChkErr use med_internalstate_mod , only : mastertask, logunit, InternalState - use med_time_mod , only : med_time_AlarmInit use esmFlds , only : ncomps, compname, compocn, complnd use perf_mod , only : t_startf, t_stopf use med_phases_prep_glc_mod , only : FBlndAccum2glc_l, lndAccum2glc_cnt @@ -23,8 +21,11 @@ module med_phases_restart_mod public :: med_phases_restart_write private :: med_phases_restart_alarm_init + logical :: write_restart_at_endofrun = .false. - + logical :: whead(2) = (/.true. , .false./) + logical :: wdata(2) = (/.false., .true. /) + character(*), parameter :: u_FILE_u = & __FILE__ @@ -38,16 +39,15 @@ subroutine med_phases_restart_alarm_init(gcomp, rc) ! Initialize mediator restart file alarms (module variables) ! -------------------------------------- - use ESMF , only : ESMF_GridComp, ESMF_GridCompGet - use ESMF , only : ESMF_Clock, ESMF_ClockGet, ESMF_ClockAdvance, ESMF_ClockSet - use ESMF , only : ESMF_Time - use ESMF , only : ESMF_TimeInterval, ESMF_TimeIntervalGet - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LOGMSG_ERROR - use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE - use ESMF , only : operator(==), operator(-) - use ESMF , only : ESMF_ALARMLIST_ALL, ESMF_Alarm, ESMF_AlarmSet - use NUOPC , only : NUOPC_CompAttributeGet - use NUOPC_Model, only : NUOPC_ModelGet + use ESMF , only : ESMF_GridComp, ESMF_GridCompGet + use ESMF , only : ESMF_Clock, ESMF_ClockGet, ESMF_ClockAdvance, ESMF_ClockSet + use ESMF , only : ESMF_Time, ESMF_TimeInterval, ESMF_TimeIntervalGet + use ESMF , only : ESMF_Alarm, ESMF_AlarmSet + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LOGMSG_ERROR + use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE + use NUOPC , only : NUOPC_CompAttributeGet + use NUOPC_Model , only : NUOPC_ModelGet + use med_time_mod , only : med_time_AlarmInit ! input/output variables type(ESMF_GridComp) :: gcomp @@ -71,37 +71,26 @@ subroutine med_phases_restart_alarm_init(gcomp, rc) rc = ESMF_SUCCESS - ! ----------------------------- ! Get model clock - ! ----------------------------- - call NUOPC_ModelGet(gcomp, modelClock=mclock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! get current time - call ESMF_ClockGet(mclock, currTime=mCurrTime, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! ----------------------------- - ! Set alarm for instantaneous mediator restart output - ! ----------------------------- - + ! Determine restart frequency call NUOPC_CompAttributeGet(gcomp, name='restart_option', value=restart_option, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeGet(gcomp, name='restart_n', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) restart_n + ! Set alarm for instantaneous mediator restart output + call ESMF_ClockGet(mclock, currTime=mCurrTime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call med_time_alarmInit(mclock, alarm, option=restart_option, opt_n=restart_n, & reftime=mcurrTime, alarmname='alarm_restart', rc=rc) - call ESMF_AlarmSet(alarm, clock=mclock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - !-------------------------------- - ! Advance model clock to trigger alarms then reset model clock back to currtime - !-------------------------------- - + ! Advance model clock to trigger alarm then reset model clock back to currtime call ESMF_ClockGet(mclock, currTime=mCurrTime, timeStep=mtimestep, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeIntervalGet(mtimestep, s=timestep_length, rc=rc) @@ -111,33 +100,26 @@ subroutine med_phases_restart_alarm_init(gcomp, rc) call ESMF_ClockSet(mclock, currTime=mcurrtime, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - !-------------------------------- ! Handle end of run restart - !-------------------------------- call NUOPC_CompAttributeGet(gcomp, name="write_restart_at_endofrun", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent .and. isSet) then if (trim(cvalue) .eq. '.true.') write_restart_at_endofrun = .true. end if - ! ----------------------------- ! Write mediator diagnostic output - ! ----------------------------- - if (mastertask) then write(logunit,*) - write(logunit,100) trim(subname)//" restart clock timestep = ",timestep_length - write(logunit,100) trim(subname)//" set restart alarm with option "//& + write(logunit,'(a,2x,i8)') trim(subname)//" restart clock timestep = ",timestep_length + write(logunit,'(a,2x,i8)') trim(subname)//" set restart alarm with option "//& trim(restart_option)//" and frequency ",restart_n - write(logunit,*) "write_restart_at_endofrun : ", write_restart_at_endofrun -100 format(a,2x,i8) + write(logunit,'(a)') trim(subname)//" write_restart_at_endofrun : ", write_restart_at_endofrun write(logunit,*) end if end subroutine med_phases_restart_alarm_init !=============================================================================== - subroutine med_phases_restart_write(gcomp, rc) ! Write mediator restart @@ -146,14 +128,17 @@ subroutine med_phases_restart_write(gcomp, rc) use ESMF , only : ESMF_TimeInterval, ESMF_CalKind_Flag, ESMF_MAXSTR use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_FAILURE use ESMF , only : ESMF_LOGMSG_ERROR, operator(==), operator(-) - use ESMF , only : ESMF_GridCompGet, ESMF_VMGet, ESMF_ClockGet, ESMF_ClockGetNextTime + use ESMF , only : ESMF_GridCompGet, ESMF_ClockGet, ESMF_ClockGetNextTime use ESMF , only : ESMF_TimeGet, ESMF_ClockGetAlarm, ESMF_ClockPrint, ESMF_TimeIntervalGet use ESMF , only : ESMF_AlarmIsRinging, ESMF_AlarmRingerOff, ESMF_FieldBundleIsCreated use ESMF , only : ESMF_Calendar use NUOPC , only : NUOPC_CompAttributeGet use NUOPC_Model, only : NUOPC_ModelGet + use med_io_mod , only : med_io_define_time, med_io_write_time use med_io_mod , only : med_io_write, med_io_wopen, med_io_enddef use med_io_mod , only : med_io_close, med_io_date2yyyymmdd, med_io_sec2hms + use med_phases_history_mod, only : auxcomp + use med_constants_mod , only : SecPerDay => med_constants_SecPerDay ! Input/output variables type(ESMF_GridComp) :: gcomp @@ -172,7 +157,7 @@ subroutine med_phases_restart_write(gcomp, rc) character(len=CS) :: currtimestr character(len=CS) :: nexttimestr type(InternalState) :: is_local - integer :: i,j,m,n,n1,ncnt + integer :: m,n,nf,nc ! counters integer :: curr_ymd ! Current date YYYYMMDD integer :: curr_tod ! Current time-of-day (s) integer :: start_ymd ! Starting date YYYYMMDD @@ -181,7 +166,7 @@ subroutine med_phases_restart_write(gcomp, rc) integer :: next_tod ! Starting time-of-day (s) integer :: nx,ny ! global grid size integer :: yr,mon,day,sec ! time units - real(R8) :: dayssince ! Time interval since start time + real(R8) :: days_since ! Time interval since start time integer :: unitn ! unit number character(ESMF_MAXSTR) :: time_units ! units of time variable character(ESMF_MAXSTR) :: case_name ! case name @@ -194,8 +179,6 @@ subroutine med_phases_restart_write(gcomp, rc) integer :: freq_n ! freq_n setting relative to freq_option logical :: alarmIsOn ! generic alarm flag real(R8) :: tbnds(2) ! CF1.0 time bounds - logical :: whead,wdata ! for writing restart/restart cdf files - integer :: iam ! vm stuff character(ESMF_MAXSTR) :: tmpstr logical :: isPresent logical :: first_time = .true. @@ -215,16 +198,8 @@ subroutine med_phases_restart_write(gcomp, rc) nullify(is_local%wrap) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_VMGet(vm, localPet=iam, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(gcomp, name='case_name', value=case_name, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(gcomp, name='inst_suffix', isPresent=isPresent, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if(isPresent) then @@ -233,7 +208,6 @@ subroutine med_phases_restart_write(gcomp, rc) else cpl_inst_tag = "" endif - call NUOPC_CompAttributeGet(gcomp, name='restart_dir', isPresent=isPresent, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if(isPresent) then @@ -255,48 +229,38 @@ subroutine med_phases_restart_write(gcomp, rc) call NUOPC_ModelGet(gcomp, modelClock=clock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - !--------------------------------------- - ! --- Restart Alarm - !--------------------------------------- - + ! Restart Alarm call ESMF_ClockGetAlarm(clock, alarmname='alarm_restart', alarm=alarm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (ESMF_AlarmIsRinging(alarm, rc=rc)) then if (ChkErr(rc,__LINE__,u_FILE_u)) return alarmIsOn = .true. call ESMF_AlarmRingerOff( alarm, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - !--------------------------------------- - ! --- Stop Alarm - !--------------------------------------- - + ! Stop Alarm call ESMF_ClockGetAlarm(clock, alarmname='alarm_stop', alarm=alarm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (ESMF_AlarmIsRinging(alarm, rc=rc).and.write_restart_at_endofrun) then + if (ESMF_AlarmIsRinging(alarm, rc=rc) .and. write_restart_at_endofrun) then AlarmIsOn = .true. else AlarmIsOn = .false. endif endif + if (alarmIsOn) then call ESMF_ClockGet(clock, currtime=currtime, starttime=starttime, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockGetNextTime(clock, nextTime=nexttime, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockGet(clock, calendar=calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeGet(currtime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return write(currtimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec if (dbug_flag > 1) then call ESMF_LogWrite(trim(subname)//": currtime = "//trim(currtimestr), ESMF_LOGMSG_INFO) endif - call ESMF_TimeGet(nexttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return write(nexttimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec @@ -311,7 +275,7 @@ subroutine med_phases_restart_write(gcomp, rc) endif timediff = nexttime - starttime call ESMF_TimeIntervalGet(timediff, d=day, s=sec, rc=rc) - dayssince = day + sec/real(SecPerDay,R8) + days_since = day + sec/real(SecPerDay,R8) call ESMF_TimeGet(starttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -331,15 +295,15 @@ subroutine med_phases_restart_write(gcomp, rc) curr_tod = sec !--------------------------------------- - ! --- Restart File + ! Restart File ! Use nexttimestr rather than currtimestr here since that is the time at the end of ! the timestep and is preferred for restart file names !--------------------------------------- - write(restart_file,"(6a)") trim(restart_dir)//trim(case_name),'.cpl', & - trim(cpl_inst_tag),'.r.',trim(nexttimestr),'.nc' + write(restart_file,"(6a)") trim(restart_dir)//trim(case_name),'.cpl', trim(cpl_inst_tag),'.r.',& + trim(nexttimestr),'.nc' - if (iam == 0) then + if (mastertask) then restart_pfile = "rpointer.cpl"//cpl_inst_tag call ESMF_LogWrite(trim(subname)//" write rpointer file = "//trim(restart_pfile), ESMF_LOGMSG_INFO) open(newunit=unitn, file=restart_pfile, form='FORMATTED') @@ -348,85 +312,72 @@ subroutine med_phases_restart_write(gcomp, rc) endif call ESMF_LogWrite(trim(subname)//": write "//trim(restart_file), ESMF_LOGMSG_INFO) - call med_io_wopen(restart_file, vm, iam, clobber=.true.) + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_io_wopen(restart_file, vm, clobber=.true.) do m = 1,2 - if (m == 1) then - whead = .true. - wdata = .false. - else if (m == 2) then - whead = .false. - wdata = .true. - endif - if (wdata) then + if (m == 2) then call med_io_enddef(restart_file) end if - tbnds = dayssince + tbnds = days_since call ESMF_LogWrite(trim(subname)//": time "//trim(time_units), ESMF_LOGMSG_INFO) - if (tbnds(1) >= tbnds(2)) then - call med_io_write(restart_file, iam=iam, & - time_units=time_units, calendar=calendar, time_val=dayssince, & - whead=whead, wdata=wdata, rc=rc) + if (whead(m)) then + call ESMF_ClockGet(clock, calendar=calendar, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_io_define_time(time_units, calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call med_io_write(restart_file, iam=iam, & - time_units=time_units, calendar=calendar, time_val=dayssince, & - whead=whead, wdata=wdata, tbnds=tbnds, rc=rc) + call med_io_write_time(days_since, tbnds=(/days_since,days_since/), nt=1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - endif + end if ! Write out next ymd/tod in place of curr ymd/tod because the ! restart represents the time at end of the current timestep ! and that is where we want to start the next run. - - call med_io_write(restart_file, iam, start_ymd, 'start_ymd', whead=whead, wdata=wdata, rc=rc) + call med_io_write(restart_file, start_ymd, 'start_ymd', whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_write(restart_file, iam, start_tod, 'start_tod', whead=whead, wdata=wdata, rc=rc) + call med_io_write(restart_file, start_tod, 'start_tod', whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_write(restart_file, iam, next_ymd , 'curr_ymd' , whead=whead, wdata=wdata, rc=rc) + call med_io_write(restart_file, next_ymd , 'curr_ymd' , whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_write(restart_file, iam, next_tod , 'curr_tod' , whead=whead, wdata=wdata, rc=rc) + call med_io_write(restart_file, next_tod , 'curr_tod' , whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return do n = 1,ncomps if (is_local%wrap%comp_present(n)) then nx = is_local%wrap%nx(n) ny = is_local%wrap%ny(n) - ! Write import field bundles if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(n,n),rc=rc)) then - call med_io_write(restart_file, iam, is_local%wrap%FBimp(n,n), & - nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre=trim(compname(n))//'Imp', rc=rc) + call med_io_write(restart_file, is_local%wrap%FBimp(n,n), whead(m), wdata(m), nx, ny, & + nt=1, pre=trim(compname(n))//'Imp', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif - ! Write export field bundles if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(n),rc=rc)) then - call med_io_write(restart_file, iam, is_local%wrap%FBexp(n), & - nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre=trim(compname(n))//'Exp', rc=rc) + call med_io_write(restart_file, is_local%wrap%FBexp(n), whead(m), wdata(m), nx, ny, & + nt=1, pre=trim(compname(n))//'Exp', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif - ! Write fraction field bundles if (ESMF_FieldBundleIsCreated(is_local%wrap%FBfrac(n),rc=rc)) then - call med_io_write(restart_file, iam, is_local%wrap%FBfrac(n), & - nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre=trim(compname(n))//'Frac', rc=rc) + call med_io_write(restart_file, is_local%wrap%FBfrac(n), whead(m), wdata(m), nx, ny, & + nt=1, pre=trim(compname(n))//'Frac', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif - - endif + end if enddo ! Write export accumulation to ocn if (ESMF_FieldBundleIsCreated(is_local%wrap%FBExpAccumOcn)) then nx = is_local%wrap%nx(compocn) ny = is_local%wrap%ny(compocn) - call med_io_write(restart_file, iam, is_local%wrap%FBExpAccumOcn, & - nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre='ocnExpAccum', rc=rc) + call med_io_write(restart_file, is_local%wrap%FBExpAccumOcn, whead(m), wdata(m), nx, ny, & + nt=1, pre='ocnExpAccum', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_write(restart_file, iam, is_local%wrap%ExpAccumOcnCnt, 'ocnExpAccum_cnt', & - whead=whead, wdata=wdata, rc=rc) + call med_io_write(restart_file, is_local%wrap%ExpAccumOcnCnt, 'ocnExpAccum_cnt', whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif @@ -434,11 +385,10 @@ subroutine med_phases_restart_write(gcomp, rc) if (ESMF_FieldBundleIsCreated(FBlndAccum2rof_l)) then nx = is_local%wrap%nx(complnd) ny = is_local%wrap%ny(complnd) - call med_io_write(restart_file, iam, FBlndAccum2rof_l, & - nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre='lndImpAccum2rof', rc=rc) + call med_io_write(restart_file, FBlndAccum2rof_l, whead(m), wdata(m), nx, ny, & + nt=1, pre='lndImpAccum2rof', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_write(restart_file, iam, lndAccum2rof_cnt, 'lndImpAccum2rof_cnt', & - whead=whead, wdata=wdata, rc=rc) + call med_io_write(restart_file, lndAccum2rof_cnt, 'lndImpAccum2rof_cnt', whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -446,11 +396,10 @@ subroutine med_phases_restart_write(gcomp, rc) if (ESMF_FieldBundleIsCreated(FBlndAccum2glc_l)) then nx = is_local%wrap%nx(complnd) ny = is_local%wrap%ny(complnd) - call med_io_write(restart_file, iam, FBlndAccum2glc_l, & - nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre='lndImpAccum2glc', rc=rc) + call med_io_write(restart_file, FBlndAccum2glc_l, whead(m), wdata(m), nx, ny, & + nt=1, pre='lndImpAccum2glc', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_write(restart_file, iam, lndAccum2glc_cnt, 'lndImpAccum2glc_cnt', & - whead=whead, wdata=wdata, rc=rc) + call med_io_write(restart_file, lndAccum2glc_cnt, 'lndImpAccum2glc_cnt', whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -458,11 +407,10 @@ subroutine med_phases_restart_write(gcomp, rc) if (ESMF_FieldBundleIsCreated(FBocnAccum2glc_o)) then nx = is_local%wrap%nx(compocn) ny = is_local%wrap%ny(compocn) - call med_io_write(restart_file, iam, FBocnAccum2glc_o, & - nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre='ocnImpAccum2glc_o', rc=rc) + call med_io_write(restart_file, FBocnAccum2glc_o, whead(m), wdata(m), nx, ny, & + nt=1, pre='ocnImpAccum2glc_o', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_write(restart_file, iam, ocnAccum2glc_cnt, 'ocnImpAccum2glc_cnt', & - whead=whead, wdata=wdata, rc=rc) + call med_io_write(restart_file, ocnAccum2glc_cnt, 'ocnImpAccum2glc_cnt', whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -470,15 +418,35 @@ subroutine med_phases_restart_write(gcomp, rc) if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o,rc=rc)) then nx = is_local%wrap%nx(compocn) ny = is_local%wrap%ny(compocn) - call med_io_write(restart_file, iam, is_local%wrap%FBMed_ocnalb_o, & - nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre='MedOcnAlb_o', rc=rc) + call med_io_write(restart_file, is_local%wrap%FBMed_ocnalb_o, whead(m), wdata(m), nx, ny, & + nt=1, pre='MedOcnAlb_o', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if + ! Write auxiliary files accumulation - + ! For now assume that any time averaged history file has only + ! one time sample - this will be generalized in the future + do nc = 2,ncomps + do nf = 1,auxcomp(nc)%num_auxfiles + if (auxcomp(nc)%files(nf)%doavg .and. auxcomp(nc)%files(nf)%accumcnt > 0) then + nx = is_local%wrap%nx(nc) + ny = is_local%wrap%ny(nc) + call med_io_write(restart_file, auxcomp(nc)%files(nf)%FBaccum, & + whead(m), wdata(m), nx, ny, & + nt=1, pre=trim(compname(nc))//trim(auxcomp(nc)%files(nf)%auxname), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_io_write(restart_file, auxcomp(nc)%files(nf)%accumcnt, & + trim(compname(nc))//trim(auxcomp(nc)%files(nf)%auxname)//'_accumcnt', & + whead(m), wdata(m), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end do + end do + enddo ! end of whead/wdata loop ! Close file - call med_io_close(restart_file, iam, rc=rc) + call med_io_close(restart_file, vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif @@ -501,14 +469,14 @@ subroutine med_phases_restart_read(gcomp, rc) use ESMF , only : ESMF_GridComp, ESMF_VM, ESMF_Clock, ESMF_Time, ESMF_MAXSTR use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_FAILURE use ESMF , only : ESMF_LOGMSG_ERROR, ESMF_VMBroadCast - use ESMF , only : ESMF_GridCompGet, ESMF_VMGet, ESMF_ClockGet, ESMF_ClockPrint + use ESMF , only : ESMF_GridCompGet, ESMF_ClockGet, ESMF_ClockPrint use ESMF , only : ESMF_FieldBundleIsCreated, ESMF_TimeGet use NUOPC , only : NUOPC_CompAttributeGet use med_io_mod , only : med_io_read ! Input/output variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc ! Local variables type(ESMF_VM) :: vm @@ -516,76 +484,56 @@ subroutine med_phases_restart_read(gcomp, rc) type(ESMF_Time) :: currtime character(len=CS) :: currtimestr type(InternalState) :: is_local - integer :: i,j,m,n,n1,ncnt + integer :: i,j,m,n integer :: ierr, unitn integer :: yr,mon,day,sec ! time units - integer :: iam ! vm stuff character(ESMF_MAXSTR) :: case_name ! case name character(ESMF_MAXSTR) :: restart_file ! Local path to restart filename character(ESMF_MAXSTR) :: restart_pfile ! Local path to restart pointer filename character(ESMF_MAXSTR) :: cpl_inst_tag ! instance tag logical :: isPresent - character(len=*), parameter :: sp_str = 'str_undefined' character(len=*), parameter :: subname='(med_phases_restart_read)' !--------------------------------------- call t_startf('MED:'//subname) call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) rc = ESMF_SUCCESS - !--------------------------------------- - ! --- Get the internal state - !--------------------------------------- - + ! Get the internal state nullify(is_local%wrap) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMGet(vm, localPet=iam, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - + ! Get case name and inst suffix call NUOPC_CompAttributeGet(gcomp, name='case_name', value=case_name, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(gcomp, name='inst_suffix', isPresent=isPresent, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if(isPresent) then + if (isPresent) then call NUOPC_CompAttributeGet(gcomp, name='inst_suffix', value=cpl_inst_tag, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else cpl_inst_tag = "" endif - !--------------------------------------- - ! --- Get the clock info - !--------------------------------------- - + ! Get the clock info call ESMF_GridCompGet(gcomp, clock=clock) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockGet(clock, currtime=currtime, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeGet(currtime,yy=yr, mm=mon, dd=day, s=sec, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return write(currtimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec if (dbug_flag > 1) then call ESMF_LogWrite(trim(subname)//": currtime = "//trim(currtimestr), ESMF_LOGMSG_INFO) endif - if (iam==0) then + if (mastertask) then call ESMF_ClockPrint(clock, options="currTime", preString="-------->"//trim(subname)//" mediating for: ", rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif - !--------------------------------------- - ! --- Restart File - !--------------------------------------- - ! Get the restart file name from the pointer file - restart_pfile = "rpointer.cpl"//cpl_inst_tag - if (iam == 0) then + if (mastertask) then call ESMF_LogWrite(trim(subname)//" read rpointer file = "//trim(restart_pfile), ESMF_LOGMSG_INFO) open(newunit=unitn, file=restart_pfile, form='FORMATTED', status='old', iostat=ierr) if (ierr < 0) then @@ -602,70 +550,64 @@ subroutine med_phases_restart_read(gcomp, rc) close(unitn) call ESMF_LogWrite(trim(subname)//' restart file from rpointer = '//trim(restart_file), ESMF_LOGMSG_INFO) endif + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_VMBroadCast(vm, restart_file, len(restart_file), 0, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(trim(subname)//": read "//trim(restart_file), ESMF_LOGMSG_INFO) ! Now read in the restart file - do n = 1,ncomps if (is_local%wrap%comp_present(n)) then ! Read import field bundle if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(n,n),rc=rc)) then - call med_io_read(restart_file, vm, iam, is_local%wrap%FBimp(n,n), pre=trim(compname(n))//'Imp', rc=rc) + call med_io_read(restart_file, vm, is_local%wrap%FBimp(n,n), pre=trim(compname(n))//'Imp', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif - ! Read export field bundle if (ESMF_FieldBundleIsCreated(is_local%wrap%FBExp(n),rc=rc)) then - call med_io_read(restart_file, vm, iam, is_local%wrap%FBexp(n), pre=trim(compname(n))//'Exp', rc=rc) + call med_io_read(restart_file, vm, is_local%wrap%FBexp(n), pre=trim(compname(n))//'Exp', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif - ! Read fraction field bundles if (ESMF_FieldBundleIsCreated(is_local%wrap%FBfrac(n),rc=rc)) then - call med_io_read(restart_file, vm, iam, is_local%wrap%FBfrac(n), pre=trim(compname(n))//'Frac', rc=rc) + call med_io_read(restart_file, vm, is_local%wrap%FBfrac(n), pre=trim(compname(n))//'Frac', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif - endif enddo ! Read export field bundle accumulator if (ESMF_FieldBundleIsCreated(is_local%wrap%FBExpAccumOcn,rc=rc)) then - call med_io_read(restart_file, vm, iam, is_local%wrap%FBExpAccumOcn, pre='ocnExpAccum', rc=rc) + call med_io_read(restart_file, vm, is_local%wrap%FBExpAccumOcn, pre='ocnExpAccum', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_read(restart_file, vm, iam, is_local%wrap%ExpAccumOcnCnt, 'ocnExpAccum_cnt', rc=rc) + call med_io_read(restart_file, vm, is_local%wrap%ExpAccumOcnCnt, 'ocnExpAccum_cnt', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif - - ! If lnd->glc, read accumulation from lnd to rof (CESM only) + ! If lnd->rof, read accumulation from lnd to rof (CESM only) if (ESMF_FieldBundleIsCreated(FBlndAccum2rof_l)) then - call med_io_read(restart_file, vm, iam, FBlndAccum2rof_l, pre='lndImpAccum2rof', rc=rc) + call med_io_read(restart_file, vm, FBlndAccum2rof_l, pre='lndImpAccum2rof', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_read(restart_file, vm, iam, lndAccum2rof_cnt, 'lndImpAccum2rof_cnt', rc=rc) + call med_io_read(restart_file, vm, lndAccum2rof_cnt, 'lndImpAccum2rof_cnt', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - ! If lnd->glc, read accumulation from lnd to glc (CESM only) if (ESMF_FieldBundleIsCreated(FBlndAccum2glc_l)) then - call med_io_read(restart_file, vm, iam, FBlndAccum2glc_l, pre='lndImpAccum2glc', rc=rc) + call med_io_read(restart_file, vm, FBlndAccum2glc_l, pre='lndImpAccum2glc', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_read(restart_file, vm, iam, lndAccum2glc_cnt, 'lndImpAccum2glc_cnt', rc=rc) + call med_io_read(restart_file, vm, lndAccum2glc_cnt, 'lndImpAccum2glc_cnt', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - ! If ocn->glc, read accumulation from ocn to glc (CESM only) if (ESMF_FieldBundleIsCreated(FBocnAccum2glc_o)) then - call med_io_read(restart_file, vm, iam, FBocnAccum2glc_o, pre='ocnImpAccum2glc', rc=rc) + call med_io_read(restart_file, vm, FBocnAccum2glc_o, pre='ocnImpAccum2glc', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_read(restart_file, vm, iam, ocnAccum2glc_cnt, 'ocnImpAccum2glc_cnt', rc=rc) + call med_io_read(restart_file, vm, ocnAccum2glc_cnt, 'ocnImpAccum2glc_cnt', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - ! Read ocn albedo field bundle (CESM only) if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o,rc=rc)) then - call med_io_read(restart_file, vm, iam, is_local%wrap%FBMed_ocnalb_o, pre='MedOcnAlb_o', rc=rc) + call med_io_read(restart_file, vm, is_local%wrap%FBMed_ocnalb_o, pre='MedOcnAlb_o', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -679,7 +621,6 @@ subroutine med_phases_restart_read(gcomp, rc) end subroutine med_phases_restart_read !=============================================================================== - subroutine ymd2date(year,month,day,date) ! Converts year, month, day to coded-date ! NOTE: this calendar has a year zero (but no day or month zero) diff --git a/mediator/med_time_mod.F90 b/mediator/med_time_mod.F90 index 4cf8a0ed..51e4db6e 100644 --- a/mediator/med_time_mod.F90 +++ b/mediator/med_time_mod.F90 @@ -4,7 +4,7 @@ module med_time_mod use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_GridCompSet use ESMF , only : ESMF_Clock, ESMF_ClockCreate, ESMF_ClockGet, ESMF_ClockSet use ESMF , only : ESMF_ClockAdvance - use ESMF , only : ESMF_Alarm, ESMF_AlarmCreate, ESMF_AlarmGet + use ESMF , only : ESMF_Alarm, ESMF_AlarmCreate, ESMF_AlarmGet, ESMF_AlarmSet use ESMF , only : ESMF_Calendar, ESMF_CalKind_Flag, ESMF_CalendarCreate use ESMF , only : ESMF_CALKIND_NOLEAP, ESMF_CALKIND_GREGORIAN use ESMF , only : ESMF_Time, ESMF_TimeGet, ESMF_TimeSet @@ -15,9 +15,9 @@ module med_time_mod use ESMF , only : operator(<), operator(/=), operator(+) use ESMF , only : operator(-), operator(*) , operator(>=) use ESMF , only : operator(<=), operator(>), operator(==) - use NUOPC , only : NUOPC_CompAttributeGet use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_utils_mod , only : chkerr => med_utils_ChkErr + use med_internalstate_mod, only : mastertask, logunit implicit none private ! default private @@ -51,7 +51,7 @@ module med_time_mod !=============================================================================== subroutine med_time_alarmInit( clock, alarm, option, & - opt_n, opt_ymd, opt_tod, RefTime, alarmname, rc) + opt_n, opt_ymd, opt_tod, reftime, alarmname, advance_clock, rc) ! Setup an alarm in a clock ! Notes: The ringtime sent to AlarmCreate MUST be the next alarm @@ -65,15 +65,16 @@ subroutine med_time_alarmInit( clock, alarm, option, & ! advance it properly based on the ring interval. ! input/output variables - type(ESMF_Clock) , intent(inout) :: clock ! clock - type(ESMF_Alarm) , intent(inout) :: alarm ! alarm - character(len=*) , intent(in) :: option ! alarm option - integer , optional , intent(in) :: opt_n ! alarm freq - integer , optional , intent(in) :: opt_ymd ! alarm ymd - integer , optional , intent(in) :: opt_tod ! alarm tod (sec) - type(ESMF_Time) , optional , intent(in) :: RefTime ! ref time - character(len=*) , optional , intent(in) :: alarmname ! alarm name - integer , intent(inout) :: rc ! Return code + type(ESMF_Clock) , intent(inout) :: clock ! clock + type(ESMF_Alarm) , intent(inout) :: alarm ! alarm + character(len=*) , intent(in) :: option ! alarm option + integer , optional , intent(in) :: opt_n ! alarm freq + integer , optional , intent(in) :: opt_ymd ! alarm ymd + integer , optional , intent(in) :: opt_tod ! alarm tod (sec) + type(ESMF_Time) , optional , intent(in) :: reftime ! reference time + character(len=*) , optional , intent(in) :: alarmname ! alarm name + logical , optional , intent(in) :: advance_clock ! advance clock to trigger alarm + integer , intent(out) :: rc ! Return code ! local variables type(ESMF_Calendar) :: cal ! calendar @@ -83,7 +84,7 @@ subroutine med_time_alarmInit( clock, alarm, option, & character(len=64) :: lalarmname ! local alarm name logical :: update_nextalarm ! update next alarm type(ESMF_Time) :: CurrTime ! Current Time - type(ESMF_Time) :: NextAlarm ! Next restart alarm time + type(ESMF_Time) :: NextAlarm ! Next alarm time type(ESMF_TimeInterval) :: AlarmInterval ! Alarm interval integer :: sec character(len=*), parameter :: subname = '(med_time_alarmInit): ' @@ -253,12 +254,32 @@ subroutine med_time_alarmInit( clock, alarm, option, & enddo endif + if (mastertask) then + write(logunit,*) + write(logunit,'(a)') trim(subname) //' creating alarm '// trim(lalarmname) + end if + alarm = ESMF_AlarmCreate( name=lalarmname, clock=clock, ringTime=NextAlarm, & ringInterval=AlarmInterval, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Advance model clock to trigger alarm then reset model clock back to currtime + if (present(advance_clock)) then + if (advance_clock) then + call ESMF_AlarmSet(alarm, clock=clock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockGet(clock, currTime=CurrTime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockAdvance(clock,rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockSet(clock, currTime=currtime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end if + end subroutine med_time_alarmInit + !=============================================================================== subroutine med_time_date2ymd (date, year, month, day) ! input/output variables @@ -269,7 +290,6 @@ subroutine med_time_date2ymd (date, year, month, day) integer :: tdate ! temporary date character(*),parameter :: subName = "(med_time_date2ymd)" !------------------------------------------------------------------------------- - tdate = abs(date) year = int(tdate/10000) if (date < 0) then @@ -277,8 +297,6 @@ subroutine med_time_date2ymd (date, year, month, day) end if month = int( mod(tdate,10000)/ 100) day = mod(tdate, 100) - end subroutine med_time_date2ymd - !=============================================================================== end module med_time_mod