From 5903c0f342b2c70770ac16a36170066015a26043 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 31 Jul 2020 14:49:57 -0600 Subject: [PATCH 01/61] fixed bug for running in clm single column mode --- cime_config/buildnml | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/cime_config/buildnml b/cime_config/buildnml index 9d18d7136..492b65c61 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -49,7 +49,6 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): config['continue_run'] = '.true.' if case.get_value('CONTINUE_RUN') else '.false.' config['flux_epbal'] = 'ocn' if case.get_value('CPL_EPBAL') == 'ocn' else 'off' config['atm_grid'] = case.get_value('ATM_GRID') - # needed for determining the run sequence as well as glc_renormalize_smb config['COMP_ATM'] = case.get_value("COMP_ATM") config['COMP_ICE'] = case.get_value("COMP_ICE") @@ -233,8 +232,11 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): if case.get_value(item + "_NX") == "0" and case.get_value(item + "_NY") == "0": valid = False # special case - mosart or rtm in NULL mode - elif (case.get_value("COMP_ROF") == 'mosart' or case.get_value("COMP_ROF") == 'rtm'): - if (case.get_value("MOSART_MODE") == 'NULL' or case.get_value("RTM_MODE") == 'NULL'): + elif comp == "mosart": + if case.get_value("MOSART_MODE") == 'NULL': + valid = False + elif comp == "rtm": + if case.get_value("RTM_MODE") == 'NULL': valid = False if valid: valid_comps.append(item) From 1b2a6ff343bdaea1ed7fe25bca4309becb2921d7 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sat, 1 Aug 2020 13:57:00 -0600 Subject: [PATCH 02/61] updates to be consistent with mct --- cime_config/config_component_cesm.xml | 105 +++++++++++++++----------- 1 file changed, 61 insertions(+), 44 deletions(-) diff --git a/cime_config/config_component_cesm.xml b/cime_config/config_component_cesm.xml index 8abf8d37f..940dbaf79 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 @@ -137,8 +141,10 @@ CO2A none CO2A + CO2A + CO2A CO2A - CO2A + CO2A CO2C CO2C @@ -201,39 +207,47 @@ 288 72 48 - - - 24 - 24 - 24 - 24 - 24 - 24 - 48 - 48 - 1 - 96 - 96 - 96 - 96 - 192 - 192 - 192 - 192 - 384 - 384 - 384 - 144 - 72 - 144 - 288 - 48 - 48 - 24 - 24 - 1 - - + 4 + 24 + 24 + 144 + 24 + 24 + 24 + 48 + 48 + 1 + 96 + 96 + 96 + 96 + 192 + 192 + 192 + 192 + 384 + 384 + 384 + 384 + 192 + 384 + 48 + 48 + 48 + 96 + 192 + 72 + 144 + 288 + 48 + 48 + 24 + 24 + 1 + 4 + 4 + 4 + 4 run_coupling env_run.xml @@ -272,16 +286,18 @@ integer $ATM_NCPL - 24 + 1 24 4 24 24 - - - - + 48 + 1 + 1 1 + $ATM_NCPL + $ATM_NCPL + 24 run_coupling env_run.xml @@ -486,7 +502,8 @@ 284.7 367.0 - 284.7 + 284.317 + 284.7 run_co2 env_run.xml From 30377d5329d23bfdb4282f82b3402ca9eccb3578 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 6 Aug 2020 13:49:03 -0600 Subject: [PATCH 03/61] updates to be more consistent with cpl7 --- cime_config/config_component_cesm.xml | 50 ++++++++++++++++++--------- cime_config/runseq/runseq_general.py | 7 +++- drivers/cime/esm_time_mod.F90 | 3 -- 3 files changed, 40 insertions(+), 20 deletions(-) diff --git a/cime_config/config_component_cesm.xml b/cime_config/config_component_cesm.xml index 940dbaf79..255d3f630 100644 --- a/cime_config/config_component_cesm.xml +++ b/cime_config/config_component_cesm.xml @@ -205,18 +205,44 @@ 144 288 288 - 72 + + + 48 - 4 + 48 + 48 + 24 + 24 + + 72 + + + + 24 24 + + + + + + + + + + 24 144 24 24 + + + 24 48 48 - 1 + + + 96 96 96 @@ -239,15 +265,11 @@ 72 144 288 - 48 - 48 - 24 - 24 + + + + 1 - 4 - 4 - 4 - 4 run_coupling env_run.xml @@ -286,17 +308,13 @@ integer $ATM_NCPL - 1 24 + 1 4 24 24 48 - 1 - 1 1 - $ATM_NCPL - $ATM_NCPL 24 run_coupling diff --git a/cime_config/runseq/runseq_general.py b/cime_config/runseq/runseq_general.py index e0a4cfb36..83a9e4a5d 100644 --- a/cime_config/runseq/runseq_general.py +++ b/cime_config/runseq/runseq_general.py @@ -37,13 +37,18 @@ def gen_runseq(case, coupling_times): # Note: assume that atm_cpl_dt, lnd_cpl_dt, ice_cpl_dt and wav_cpl_dt are the same - if lnd_cpl_time != atm_cpl_time: expect(False, "assume that lnd_cpl_time is equal to atm_cpl_time") if ice_cpl_time != atm_cpl_time: expect(False, "assume that ice_cpl_time is equal to atm_cpl_time") if wav_cpl_time != atm_cpl_time: expect(False, "assume that wav_cpl_time is equal to atm_cpl_time") + + # assume that atm coupling time is always less than or equal to ocean coupling time + if atm_cpl_time > ocn_cpl_time: + expect(False, "assume that atm_cpl_time is always less or equal to ocn_cpl_time") + + # assume that rof coupling time is always greater than or equal to ocean coupling time if rof_cpl_time < ocn_cpl_time: expect(False, "assume that rof_cpl_time is always greater than or equal to ocn_cpl_time") diff --git a/drivers/cime/esm_time_mod.F90 b/drivers/cime/esm_time_mod.F90 index 8990632d5..3b35c89b0 100644 --- a/drivers/cime/esm_time_mod.F90 +++ b/drivers/cime/esm_time_mod.F90 @@ -144,7 +144,6 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert endif restart_pfile = trim(restart_file)//inst_suffix - write(6,*)'DEBUG: restart_pfile = ',restart_pfile if (mastertask) then call ESMF_LogWrite(trim(subname)//" read rpointer file = "//trim(restart_pfile), & @@ -170,8 +169,6 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert call esm_time_read_restart(restart_file, start_ymd, start_tod, curr_ymd, curr_tod, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - write(6,*)'DEBUG: curr_ymd = ',curr_ymd - write(6,*)'DEBUG: curr_tod = ',curr_tod tmp(1) = start_ymd ; tmp(2) = start_tod tmp(3) = curr_ymd ; tmp(4) = curr_tod endif From 5b23e225d45beac3fffad4f50e579f38bc2e5fc0 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 7 Aug 2020 15:36:37 -0600 Subject: [PATCH 04/61] removed commented sections --- cime_config/config_component_cesm.xml | 5 ----- 1 file changed, 5 deletions(-) diff --git a/cime_config/config_component_cesm.xml b/cime_config/config_component_cesm.xml index 255d3f630..f52591f92 100644 --- a/cime_config/config_component_cesm.xml +++ b/cime_config/config_component_cesm.xml @@ -222,11 +222,6 @@ 24 - - - - - From 2580aff6c651930bd2d9c9f70ad9244d95fbf89e Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sat, 22 Aug 2020 11:57:12 -0600 Subject: [PATCH 05/61] changes needed to get aux_cam_tests to work --- cime_config/buildnml | 5 +- drivers/cime/esm_time_mod.F90 | 155 +++++++++++++++------------------- mediator/med_io_mod.F90 | 2 +- 3 files changed, 73 insertions(+), 89 deletions(-) diff --git a/cime_config/buildnml b/cime_config/buildnml index 492b65c61..8a89b64e3 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -249,13 +249,12 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): if dcompname in case.get_value("COMP_{}".format(comp)): datamodel_in_compset = True - # Determine if will skip the mediator and then set the - # driver rpointer file if there is only one non-stub component then skip mediator + # Determine if will skip the mediator and then determine the restart pointer file for the driver if len(valid_comps) == 2 and not datamodel_in_compset: # skip the mediator if there is a prognostic component and all other components are stub valid_comps.remove("CPL") nmlgen.set_value('mediator_present', value='.false.') - nmlgen.set_value("drv_restart_pointer", value="none") + nmlgen.set_value("drv_restart_pointer", value="rpointer.drv") nmlgen.set_value("component_list", value=" ".join(valid_comps)) else: # do not skip mediator if there is a data component but all other components are stub diff --git a/drivers/cime/esm_time_mod.F90 b/drivers/cime/esm_time_mod.F90 index 3b35c89b0..3d67f8475 100644 --- a/drivers/cime/esm_time_mod.F90 +++ b/drivers/cime/esm_time_mod.F90 @@ -1,22 +1,22 @@ module esm_time_mod - use shr_kind_mod , only : cx=>shr_kind_cx, cs=>shr_kind_cs, cl=>shr_kind_cl, r8=>shr_kind_r8 - 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_Calendar, ESMF_CalKind_Flag, ESMF_CalendarCreate - use ESMF , only : ESMF_CALKIND_NOLEAP, ESMF_CALKIND_GREGORIAN - use ESMF , only : ESMF_Time, ESMF_TimeGet, ESMF_TimeSet - use ESMF , only : ESMF_TimeInterval, ESMF_TimeIntervalSet, ESMF_TimeIntervalGet - use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_FAILURE - use ESMF , only : ESMF_VM, ESMF_VMGet, ESMF_VMBroadcast - use ESMF , only : ESMF_LOGMSG_INFO, ESMF_FAILURE - use ESMF , only : operator(<), operator(/=), operator(+) - use ESMF , only : operator(-), operator(*) , operator(>=) - use ESMF , only : operator(<=), operator(>), operator(==) - use NUOPC , only : NUOPC_CompAttributeGet - use esm_utils_mod , only : chkerr + use shr_kind_mod , only : cx=>shr_kind_cx, cs=>shr_kind_cs, cl=>shr_kind_cl, r8=>shr_kind_r8 + 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_Calendar, ESMF_CalKind_Flag, ESMF_CalendarCreate + use ESMF , only : ESMF_CALKIND_NOLEAP, ESMF_CALKIND_GREGORIAN + use ESMF , only : ESMF_Time, ESMF_TimeGet, ESMF_TimeSet + use ESMF , only : ESMF_TimeInterval, ESMF_TimeIntervalSet, ESMF_TimeIntervalGet + use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_FAILURE + use ESMF , only : ESMF_VM, ESMF_VMGet, ESMF_VMBroadcast + use ESMF , only : ESMF_LOGMSG_INFO, ESMF_FAILURE + use ESMF , only : operator(<), operator(/=), operator(+) + use ESMF , only : operator(-), operator(*) , operator(>=) + use ESMF , only : operator(<=), operator(>), operator(==) + use NUOPC , only : NUOPC_CompAttributeGet + use esm_utils_mod , only : chkerr implicit none private ! default private @@ -107,91 +107,76 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert rc = ESMF_SUCCESS - call ESMF_GridCompGet(instance_driver, vm=vm, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - !--------------------------------------------------------------------------- ! Determine start time, reference time and current time !--------------------------------------------------------------------------- - call NUOPC_CompAttributeGet(instance_driver, name="start_ymd", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) start_ymd - call NUOPC_CompAttributeGet(instance_driver, name="start_tod", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) start_tod - + ! The read_restart attribute is set in ensemble_driver and is based on the start_type + ! being equal to continue or branch call NUOPC_CompAttributeGet(instance_driver, name='read_restart', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) read_restart if (read_restart) then + ! Determine restart pointer file for driver time info call NUOPC_CompAttributeGet(instance_driver, name='drv_restart_pointer', value=restart_file, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - write(6,*)'DEBUG: restart_file = ',trim(restart_file) - - if (trim(restart_file) /= 'none') then - - call NUOPC_CompAttributeGet(instance_driver, name="inst_suffix", isPresent=isPresent, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if(isPresent) then - call NUOPC_CompAttributeGet(instance_driver, name="inst_suffix", value=inst_suffix, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - inst_suffix = "" - endif - - restart_pfile = trim(restart_file)//inst_suffix - - 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 - rc = ESMF_FAILURE - call ESMF_LogWrite(trim(subname)//' ERROR rpointer file open returns error', & - ESMF_LOGMSG_INFO, line=__LINE__, file=__FILE__) - return - end if - read(unitn,'(a)', iostat=ierr) restart_file - if (ierr < 0) then - rc = ESMF_FAILURE - call ESMF_LogWrite(trim(subname)//' ERROR rpointer file read returns error', & - ESMF_LOGMSG_INFO, line=__LINE__, file=__FILE__) - return - end if - close(unitn) - call ESMF_LogWrite(trim(subname)//" read driver restart from file = "//trim(restart_file), & - ESMF_LOGMSG_INFO) - - call esm_time_read_restart(restart_file, start_ymd, start_tod, curr_ymd, curr_tod, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - tmp(1) = start_ymd ; tmp(2) = start_tod - tmp(3) = curr_ymd ; tmp(4) = curr_tod - endif - - call ESMF_VMBroadcast(vm, tmp, 4, 0, rc=rc) + restart_file = 'rpointer.cpl' + call NUOPC_CompAttributeGet(instance_driver, name="inst_suffix", isPresent=isPresent, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if(isPresent) then + call NUOPC_CompAttributeGet(instance_driver, name="inst_suffix", value=inst_suffix, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - start_ymd = tmp(1) ; start_tod = tmp(2) - curr_ymd = tmp(3) ; curr_tod = tmp(4) - else - - if (mastertask) then - write(logunit,*) ' NOTE: the current compset has no mediator - which provides the clock restart information' - write(logunit,*) ' In this case the restarts are handled solely by the component being used and' - write(logunit,*) ' and the driver clock will always be starting from the initial date on restart' + inst_suffix = "" + endif + restart_pfile = trim(restart_file)//inst_suffix + + ! Read the restart pointer file and the restart time info for the driver + 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 + rc = ESMF_FAILURE + call ESMF_LogWrite(trim(subname)//' ERROR rpointer file open returns error', & + ESMF_LOGMSG_INFO, line=__LINE__, file=__FILE__) + return end if - curr_ymd = start_ymd - curr_tod = start_tod - - end if + read(unitn,'(a)', iostat=ierr) restart_file + if (ierr < 0) then + rc = ESMF_FAILURE + call ESMF_LogWrite(trim(subname)//' ERROR rpointer file read returns error', & + ESMF_LOGMSG_INFO, line=__LINE__, file=__FILE__) + return + end if + close(unitn) + call ESMF_LogWrite(trim(subname)//" read driver restart from file = "//trim(restart_file), & + ESMF_LOGMSG_INFO) + + call esm_time_read_restart(restart_file, start_ymd, start_tod, curr_ymd, curr_tod, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + tmp(1) = start_ymd ; tmp(2) = start_tod + tmp(3) = curr_ymd ; tmp(4) = curr_tod + endif + ! Broadcast info + call ESMF_GridCompGet(instance_driver, vm=vm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMBroadcast(vm, tmp, 4, 0, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + start_ymd = tmp(1) ; start_tod = tmp(2) + curr_ymd = tmp(3) ; curr_tod = tmp(4) - else + else ! run is a startup + call NUOPC_CompAttributeGet(instance_driver, name="start_ymd", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) start_ymd + call NUOPC_CompAttributeGet(instance_driver, name="start_tod", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) start_tod curr_ymd = start_ymd curr_tod = start_tod diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index 0a4fa7753..62b5ec6fc 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -78,7 +78,7 @@ module med_io_mod character(*),parameter :: modName = "(med_io_mod) " character(*),parameter :: version = "cmeps0" integer , parameter :: file_desc_t_cnt = 20 ! Note - this is hard-wired for now - integer , parameter :: number_strlen = 2 + integer , parameter :: number_strlen = 8 character(CL) :: wfilename = '' type(file_desc_t) :: io_file(0:file_desc_t_cnt) integer :: pio_iotype From d7c08497476970e0724e76b5712653b76baa8159 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 26 Aug 2020 18:46:03 -0600 Subject: [PATCH 06/61] fixes necessary to run preapha tests --- cime_config/buildnml | 12 +++ cime_config/config_component_cesm.xml | 4 +- cime_config/runseq/driver_config.py | 3 + mediator/med_map_mod.F90 | 149 ++++++++++++++++++++++---- 4 files changed, 147 insertions(+), 21 deletions(-) diff --git a/cime_config/buildnml b/cime_config/buildnml index 8a89b64e3..0e2fee447 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -235,9 +235,13 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): elif comp == "mosart": if case.get_value("MOSART_MODE") == 'NULL': valid = False + if case.get_value("PTS_MODE"): + valid = False elif comp == "rtm": if case.get_value("RTM_MODE") == 'NULL': valid = False + if case.get_value("PTS_MODE"): + valid = False if valid: valid_comps.append(item) @@ -262,6 +266,14 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): valid_comps_string = " ".join(valid_comps) nmlgen.set_value("component_list", value=valid_comps_string.replace("CPL","MED")) + for item in case.get_values("COMP_CLASSES"): + if item != 'CPL' and item != 'ESP': + if item in valid_comps: + comp = case.get_value("COMP_" + item) + nmlgen.set_value(item + '_model', comp) + else: + nmlgen.set_value(item + '_model', 's'+item.lower()) + logger.info("Writing nuopc_runseq 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_cesm.xml b/cime_config/config_component_cesm.xml index f52591f92..616fcc206 100644 --- a/cime_config/config_component_cesm.xml +++ b/cime_config/config_component_cesm.xml @@ -304,10 +304,10 @@ $ATM_NCPL 24 - 1 - 4 + 24 24 24 + 48 48 1 24 diff --git a/cime_config/runseq/driver_config.py b/cime_config/runseq/driver_config.py index 8251eeebb..a82dfe116 100644 --- a/cime_config/runseq/driver_config.py +++ b/cime_config/runseq/driver_config.py @@ -152,6 +152,9 @@ def __compute_rof(self, case, coupling_times): # If the prognostic flag is on, then should set med_to_rof to True if_prognostic = False med_to_rof = if_prognostic + elif case.get_value("PTS_MODE"): + run_rof = False + med_to_rof = False else: # this is active runoff - determine if the mode or the grid is null - and in that case # remove all interactions with rof from the run sequence diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 91b5fdb9e..12a4f8627 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -535,6 +535,7 @@ logical function med_map_RH_is_created_RH3d(RHs,n1,n2,mapindex,rc) use ESMF , only : ESMF_RouteHandle + ! input/output variables type(ESMF_RouteHandle) , intent(in) :: RHs(:,:,:) integer , intent(in) :: n1 integer , intent(in) :: n2 @@ -542,12 +543,14 @@ logical function med_map_RH_is_created_RH3d(RHs,n1,n2,mapindex,rc) integer , intent(out) :: rc ! local variables - integer :: rc1, rc2 - logical :: mapexists character(len=*), parameter :: subname=' (med_map_RH_is_created: ) ' + !----------------------------------------------------------- rc = ESMF_SUCCESS + write(6,*)'calling med_map_RH_is_created_RH1d for n1 to n2 and mapindex= ',& + compname(n1), compname(n2), mapindex + med_map_RH_is_created_RH3d = med_map_RH_is_created_RH1d(RHs(n1,n2,:),mapindex,rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -557,43 +560,151 @@ end function med_map_RH_is_created_RH3d logical function med_map_RH_is_created_RH1d(RHs,mapindex,rc) - use ESMF , only : ESMF_RouteHandle, ESMF_RouteHandleIsCreated + use ESMF, only : ESMF_RouteHandle, ESMF_RouteHandleIsCreated + ! input/output variables type(ESMF_RouteHandle) , intent(in) :: RHs(:) integer , intent(in) :: mapindex integer , intent(out) :: rc ! local variables - integer :: rc1, rc2 logical :: mapexists + logical :: map1, map2 character(len=*), parameter :: subname=' (med_map_RH_is_created_RH1d: ) ' + !----------------------------------------------------------- rc = ESMF_SUCCESS - rc1 = ESMF_SUCCESS - rc2 = ESMF_SUCCESS mapexists = .false. - if (mapindex == mapnstod_consd .and. & - ESMF_RouteHandleIsCreated(RHs(mapnstod), rc=rc1) .and. & - ESMF_RouteHandleIsCreated(RHs(mapconsd), rc=rc2)) then - mapexists = .true. - else if (mapindex == mapnstod_consf .and. & - ESMF_RouteHandleIsCreated(RHs(mapnstod), rc=rc1) .and. & - ESMF_RouteHandleIsCreated(RHs(mapconsf), rc=rc2)) then - mapexists = .true. - else if (ESMF_RouteHandleIsCreated(RHs(mapindex), rc=rc1)) then - mapexists = .true. + if (mapindex == mapnstod_consd) then + map1 = ESMF_RouteHandleIsCreated(RHs(mapnstod), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + map2 = ESMF_RouteHandleIsCreated(RHs(mapconsd), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (map1 .and. map2) mapexists = .true. + else if (mapindex == mapnstod_consf) then + map1 = ESMF_RouteHandleIsCreated(RHs(mapnstod), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + map2 = ESMF_RouteHandleIsCreated(RHs(mapconsf), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (map1 .and. map2) mapexists = .true. + else + map1 = ESMF_RouteHandleIsCreated(RHs(mapindex), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (map1) mapexists = .true. end if med_map_RH_is_created_RH1d = mapexists - rc = rc1 + end function med_map_RH_is_created_RH1d + +<<<<<<< HEAD +======= +!================================================================================ + + subroutine med_map_Fractions_init(gcomp, n1, n2, FBSrc, FBDst, RouteHandle, rc) + + !--------------------------------------------- + ! Initialize initialize additional route handles + ! for mapping fractions + !--------------------------------------------- + + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_LogFlush + use ESMF , only : ESMF_GridComp, ESMF_FieldBundle, ESMF_RouteHandle, ESMF_Field + use ESMF , only : ESMF_FieldRedistStore, ESMF_FieldSMMStore, ESMF_FieldRegridStore + use ESMF , only : ESMF_UNMAPPEDACTION_IGNORE, ESMF_REGRIDMETHOD_CONSERVE, ESMF_NORMTYPE_FRACAREA + use NUOPC , only : NUOPC_CompAttributeGet + + type(ESMF_GridComp) :: gcomp + integer , intent(in) :: n1 + integer , intent(in) :: n2 + type(ESMF_FieldBundle) , intent(in) :: FBSrc + type(ESMF_FieldBundle) , intent(in) :: FBDst + type(ESMF_RouteHandle) , intent(inout) :: RouteHandle + integer , intent(out) :: rc + + ! local variables + type(ESMF_Field) :: fldsrc + type(ESMF_Field) :: flddst + character(len=128) :: rhname + character(len=CS) :: mapname + character(len=CX) :: mapfile + character(len=CS) :: string + integer :: SrcMaskValue + integer :: DstMaskValue + real(R8), pointer :: factorList(:) + character(len=*), parameter :: subname=' (med_map_fractions_init: ) ' + !--------------------------------------------- + + call t_startf('MED:'//subname) + + if (dbug_flag > 1) then + call ESMF_LogWrite("Initializing RHs not yet created and needed for mapping fractions", & + ESMF_LOGMSG_INFO) + call ESMF_LogFlush() + endif + + rc = ESMF_SUCCESS + + call FB_getFieldN(FBsrc, 1, fldsrc, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - rc = rc2 + + call FB_getFieldN(FBDst, 1, flddst, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - end function med_map_RH_is_created_RH1d + dstMaskValue = ispval_mask + srcMaskValue = ispval_mask + if (n1 == compocn .or. n1 == compice) srcMaskValue = 0 + if (n2 == compocn .or. n2 == compice) dstMaskValue = 0 + + rhname = trim(compname(n1))//"2"//trim(compname(n2)) + string = trim(rhname)//'_weights' + if ( (n1 == compocn .and. n2 == compice) .or. (n1 == compice .and. n2 == compocn)) then + mapfile = 'idmap' + else + call ESMF_LogWrite("Querying for attribute "//trim(rhname)//"_fmapname = ", ESMF_LOGMSG_INFO) + call NUOPC_CompAttributeGet(gcomp, name=trim(rhname)//"_fmapname", value=mapfile, rc=rc) + mapname = trim(mapnames(mapconsf)) + end if + + if (mapfile == 'idmap') then + call ESMF_LogWrite(trim(subname) // trim(string) //& + ' RH '//trim(mapname)// ' is redist', ESMF_LOGMSG_INFO) + call ESMF_FieldRedistStore(fldsrc, flddst, & + routehandle=RouteHandle, & + ignoreUnmatchedIndices = .true., rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else if (mapfile /= 'unset') then + call ESMF_LogWrite(subname // trim(string) //& + ' RH '//trim(mapname)//' via input file '//trim(mapfile), ESMF_LOGMSG_INFO) + call ESMF_FieldSMMStore(fldsrc, flddst, mapfile, & + routehandle=RouteHandle, & + ignoreUnmatchedIndices=.true., & + srcTermProcessing=srcTermProcessing_Value, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + call ESMF_LogWrite(subname // trim(string) //& + ' RH '//trim(mapname)//' computed on the fly '//trim(mapfile), ESMF_LOGMSG_INFO) + call ESMF_FieldRegridStore(fldsrc, flddst, & + routehandle=RouteHandle, & + srcMaskValues=(/srcMaskValue/), & + dstMaskValues=(/dstMaskValue/), & + regridmethod=ESMF_REGRIDMETHOD_CONSERVE, & + normType=ESMF_NORMTYPE_FRACAREA, & + srcTermProcessing=srcTermProcessing_Value, & + factorList=factorList, & + ignoreDegenerate=.true., & + unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) + end if + + if (dbug_flag > 1) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + call t_stopf('MED:'//subname) + + end subroutine med_map_Fractions_init +>>>>>>> fixes necessary to run preapha tests !================================================================================ subroutine med_map_MapNorm_init(gcomp, llogunit, rc) From 0f835b84c3f483b36c0a80dbd7fc0abbf49f601c Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sat, 29 Aug 2020 10:48:02 -0600 Subject: [PATCH 07/61] updates needed for aux_pop and bug fixes --- cime_config/buildnml | 6 +++++- cime_config/config_component_cesm.xml | 22 +++++++++++----------- cime_config/namelist_definition_drv.xml | 5 +---- mediator/med_map_mod.F90 | 6 ++++-- 4 files changed, 21 insertions(+), 18 deletions(-) diff --git a/cime_config/buildnml b/cime_config/buildnml index 0e2fee447..b506eb527 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -88,9 +88,13 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): if case.get_value('CASE') == case.get_value('RUN_REFCASE'): nmlgen.set_value('brnch_retain_casename' , value='.true.') - # set aquaplanet if appropriate + #-------------------------------- + # set aquaplanet flag + #-------------------------------- if config['COMP_OCN'] == 'docn' and 'aqua' in case.get_value("DOCN_MODE"): nmlgen.set_value('aqua_planet' , value='.true.') + else: + nmlgen.set_value('aqua_planet' , value='.false.') #-------------------------------- # Overwrite: set component coupling frequencies diff --git a/cime_config/config_component_cesm.xml b/cime_config/config_component_cesm.xml index 616fcc206..5fe546b22 100644 --- a/cime_config/config_component_cesm.xml +++ b/cime_config/config_component_cesm.xml @@ -304,7 +304,7 @@ $ATM_NCPL 24 - 24 + 1 24 24 48 @@ -358,16 +358,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 diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 3bbc58483..9d04820d0 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -743,16 +743,13 @@ - + logical expdef ALLCOMP_attributes true => turn on aquaplanet mode in cam - - .false. - diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 12a4f8627..ec0d19a20 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -1346,8 +1346,10 @@ subroutine norm_field_dest (fldname, dstfield, frac, rc) end do end if - call Field_diagnose(dstfield, fldname, " --> after frac: ", rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 1) then + call Field_diagnose(dstfield, fldname, " --> after frac: ", rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if end subroutine norm_field_dest From efe4f43a659c1460d5694c7c4535850c2b7c5083 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 30 Aug 2020 21:38:33 -0600 Subject: [PATCH 08/61] first addition to adding auxiliary history files --- cime_config/namelist_definition_drv.xml | 296 ++++----- mediator/med.F90 | 70 ++- mediator/med_phases_history_mod.F90 | 779 +++++++++++++++--------- mediator/med_time_mod.F90 | 1 - 4 files changed, 675 insertions(+), 471 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 9d04820d0..36ce086cb 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -1268,7 +1268,6 @@ - @@ -1281,7 +1280,6 @@ - @@ -1294,7 +1292,6 @@ - @@ -1307,7 +1304,6 @@ - @@ -1320,7 +1316,6 @@ - @@ -1333,7 +1328,6 @@ - @@ -1346,7 +1340,6 @@ - @@ -1359,201 +1352,128 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + char + aux_hist + MED_attributes + + turns on coupler history stream for instantaneous runoff to coupler fields. + + none,all + + none + + - - - - - - - - - - - - + + char + aux_hist + MED_attributes + + turns on coupler history stream for instantaneous land to coupler fields. + + none,all + + none + + - - - - - - - - - - - - + + char + aux_hist + MED_attributes + + turns on coupler history stream for annual sno to coupler fields. + + none,all + + none + + - - - - - - - - - - - + + char + aux_hist + MED_attributes + + Auxiliary mediator a2x history fields (default is none) + + none,all,Faxa_swndr:Faxa_swvdr:Faxa_swndf:Faxa_swvdf + + none + + - - - - - - - - - - - + + char + aux_hist + MED_attributes + + Auxiliary coupler a2x averaged history output every hour + + none,all,Sa_u:Sa_v + + none + + - - - - - - - - - - - + + char + aux_hist + MED_attributes + + Auxiliary coupler a2x instantaneous history output every hour + + none,all,Faxa_swndr:Faxa_swvdr:Faxa_swndf:Faxa_swvdf + + none + + - - - - - - - - - - - + + char + aux_hist + MED_attributes + + Auxiliary coupler a2x history output every 24 hours + + none,all,Faxa_bcph:Faxa_ocph:Faxa_dstwet:Faxa_dstdry:Sa_co2prog:Sa_co2diag + + none + + - - - - - - - - - - - + + char + aux_hist + MED_attributes + + Auxiliary coupler a2x precipitation history output every 3 hours + + none,all,Faxa_rainc:Faxa_rainl:Faxa_snowc:Faxa_snowl + + none + + - - - - - - - - - - - + + char + aux_hist + MED_attributes + + Auxiliary coupler a2x averaged history output every 3 hours + + none,all,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 + + none + + diff --git a/mediator/med.F90 b/mediator/med.F90 index 12a289d81..44d6f38a0 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -83,6 +83,13 @@ subroutine SetServices(gcomp, rc) use NUOPC_Mediator , only: mediator_label_SetRunClock => label_SetRunClock use NUOPC_Mediator , only: mediator_label_Finalize => label_Finalize use med_phases_history_mod , only: med_phases_history_write + use med_phases_history_mod , only: med_phases_history_write_atm + use med_phases_history_mod , only: med_phases_history_write_ice + use med_phases_history_mod , only: med_phases_history_write_glc + use med_phases_history_mod , only: med_phases_history_write_lnd + use med_phases_history_mod , only: med_phases_history_write_ocn + use med_phases_history_mod , only: med_phases_history_write_rof + use med_phases_history_mod , only: med_phases_history_write_wav use med_phases_restart_mod , only: med_phases_restart_write use med_phases_prep_atm_mod , only: med_phases_prep_atm use med_phases_prep_ice_mod , only: med_phases_prep_ice @@ -105,12 +112,15 @@ subroutine SetServices(gcomp, rc) use med_diag_mod , only: med_phases_diag_glc use med_diag_mod , only: med_phases_diag_ocn use med_diag_mod , only: med_phases_diag_ice_ice2med, med_phases_diag_ice_med2ice + use med_phases_history_mod , only: med_phases_history_alarms_init use med_fraction_mod , only: med_fraction_init, med_fraction_set use med_phases_profile_mod , only: med_phases_profile + ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc character(len=*),parameter :: subname='(module_MED:SetServices)' + !--------------------------------------- rc = ESMF_SUCCESS if (profile_memory) call ESMF_VMLogMemInfo("Entering "//trim(subname)) @@ -177,7 +187,7 @@ subroutine SetServices(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ - ! setup mediator history phase + ! setup mediator history phases !------------------ call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & @@ -187,6 +197,55 @@ subroutine SetServices(gcomp, rc) specPhaseLabel="med_phases_history_write", specRoutine=med_phases_history_write, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & + phaseLabelList=(/"med_phases_history_write_atm"/), userRoutine=mediator_routine_Run, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & + specPhaseLabel="med_phases_history_write_atm", specRoutine=med_phases_history_write_atm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & + phaseLabelList=(/"med_phases_history_write_ice"/), userRoutine=mediator_routine_Run, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & + specPhaseLabel="med_phases_history_write_ice", specRoutine=med_phases_history_write_ice, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & + phaseLabelList=(/"med_phases_history_write_glc"/), userRoutine=mediator_routine_Run, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & + specPhaseLabel="med_phases_history_write_glc", specRoutine=med_phases_history_write_glc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & + phaseLabelList=(/"med_phases_history_write_lnd"/), userRoutine=mediator_routine_Run, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & + specPhaseLabel="med_phases_history_write_lnd", specRoutine=med_phases_history_write_lnd, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & + phaseLabelList=(/"med_phases_history_write_ocn"/), userRoutine=mediator_routine_Run, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & + specPhaseLabel="med_phases_history_write_ocn", specRoutine=med_phases_history_write_ocn, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & + phaseLabelList=(/"med_phases_history_write_rof"/), userRoutine=mediator_routine_Run, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & + specPhaseLabel="med_phases_history_write_rof", specRoutine=med_phases_history_write_rof, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & + phaseLabelList=(/"med_phases_history_write_wav"/), userRoutine=mediator_routine_Run, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & + specPhaseLabel="med_phases_history_write_wav", specRoutine=med_phases_history_write_wav, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + !------------------ ! setup mediator restart phase !------------------ @@ -1575,6 +1634,7 @@ subroutine DataInitialize(gcomp, rc) use med_phases_prep_atm_mod , only : med_phases_prep_atm use med_phases_ocnalb_mod , only : med_phases_ocnalb_run use med_phases_aofluxes_mod , only : med_phases_aofluxes_run + use med_phases_history_mod , only : med_phases_history_alarms_init 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_MapNorm_init, med_map_RouteHandles_init @@ -2137,7 +2197,15 @@ subroutine DataInitialize(gcomp, rc) call med_phases_restart_read(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif + + !--------------------------------------- + ! Initialize mediator hitory alarms + !--------------------------------------- + call med_phases_history_alarms_init(gcomp, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_phases_profile(gcomp, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return else ! Not all done call NUOPC_CompAttributeSet(gcomp, name="InitializeDataComplete", value="false", rc=rc) diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index f4f60f09f..822c801ed 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -18,7 +18,21 @@ module med_phases_history_mod !----------------------------------------------------------------------------- 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 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_FieldBundleIsCreated + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LOGMSG_ERROR + use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE, ESMF_MAXSTR + use ESMF , only : operator(==), operator(-) + use NUOPC , only : NUOPC_CompAttributeGet + use NUOPC_Model , only : NUOPC_ModelGet + use esmFlds , only : compatm, complnd, compocn, compice, comprof, compglc, ncomps, compname, ncomps + use esmFlds , only : fldListFr, fldListTo 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 @@ -33,16 +47,22 @@ module med_phases_history_mod use med_io_mod , only : med_io_close, med_io_date2yyyymmdd, med_io_sec2hms use med_io_mod , only : med_io_ymd2date 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_alarms_init public :: med_phases_history_write + public :: med_phases_history_write_atm + public :: med_phases_history_write_ice + public :: med_phases_history_write_glc + public :: med_phases_history_write_lnd + public :: med_phases_history_write_ocn + public :: med_phases_history_write_rof + public :: med_phases_history_write_wav - ! type(ESMF_Alarm) :: alarm_hist_inst - ! type(ESMF_Alarm) :: alarm_hist_avg + ! type(ESMF_FieldBundle) :: FBImpAvg(ncomps) ! TODO: fill this in + ! type(ESMF_FieldBundle) :: FBExpAvg(ncomps) ! TODO: fill this in character(*), parameter :: u_FILE_u = & __FILE__ @@ -51,375 +71,444 @@ module med_phases_history_mod contains !=============================================================================== - subroutine med_phases_history_alarm_init(gcomp, rc) + subroutine med_phases_history_alarms_init(gcomp, rc) ! -------------------------------------- - ! Initialize mediator history file alarms (module variables) + ! Initialize mediator history file alarms ! -------------------------------------- - 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 ESMF , only : operator(==), operator(-) + use NUOPC , only : NUOPC_CompAttributeGet + use NUOPC_Model , only : NUOPC_ModelGet ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc ! local variables + type(InternalState) :: is_local + type(ESMF_VM) :: vm type(ESMF_Alarm) :: alarm - type(ESMF_Clock) :: mclock, dclock - type(ESMF_TimeInterval) :: mtimestep, dtimestep + type(ESMF_Clock) :: mclock + type(ESMF_TimeInterval) :: mtimestep type(ESMF_Time) :: mCurrTime type(ESMF_Time) :: mStartTime type(ESMF_TimeInterval) :: timestep - integer :: alarmcount integer :: timestep_length + character(CS) :: alarmname ! alarm name 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(CL) :: hist_option ! freq_option setting (ndays, nsteps, etc) + integer :: hist_n ! freq_n setting relative to freq_option + integer :: n + logical :: isPresent + logical :: isSet + character(*),parameter :: F01 = "(a,2x,i8)" + character(len=*), parameter :: subname='(med_phases_history_alarms_init)' !--------------------------------------- rc = ESMF_SUCCESS - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) - endif - - ! ----------------------------- - ! Get model clock - ! ----------------------------- + ! 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, start time, current time and time step call NUOPC_ModelGet(gcomp, modelClock=mclock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! get start time - call ESMF_ClockGet(mclock, startTime=mStartTime, rc=rc) + call ESMF_ClockGet(mclock, startTime=mStartTime, 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(logunit,*) + write(logunit,F01) trim(subname)//" history clock timestep = ",timestep_length - ! ----------------------------- - ! Set alarm for instantaneous mediator history output - ! ----------------------------- + ! Determine instantaneous mediator output frequency and type + 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 + hist_option = 'none' + hist_n = -999 + end if - call NUOPC_CompAttributeGet(gcomp, name='history_option', value=histinst_option, rc=rc) + ! Set alarms for instantaneous mediator history output + ! Advance model clock to trigger alarms then reset model clock back to currtime + alarmname = 'alarm_history_inst_all' + call med_time_alarmInit(mclock, alarm, option=hist_option, opt_n=hist_n, & + reftime=mStartTime, alarmname=trim(alarmname), rc=rc) + call ESMF_AlarmSet(alarm, clock=mclock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(gcomp, name='history_n', value=cvalue, rc=rc) + call ESMF_ClockAdvance(mclock,rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) histinst_n + call ESMF_ClockSet(mclock, currTime=mcurrtime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (mastertask) then + write(logunit,F01) trim(subname)//" set instantaneous mediator history alarm "//& + trim(alarmname)//" with option "//trim(hist_option)//" and frequency ",hist_n + end if + do n = 1,ncomps + if (is_local%wrap%comp_present(n)) then + alarmname = 'alarm_history_inst_' // trim(compname(n)) + call med_time_alarmInit(mclock, alarm, option=hist_option, opt_n=hist_n, & + reftime=mStartTime, alarmname=trim(alarmname), rc=rc) + call ESMF_AlarmSet(alarm, clock=mclock, 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=mcurrtime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (mastertask) then + write(logunit,F01) trim(subname)//" set instantaneous mediator history alarm "//& + trim(alarmname)//" with option "//trim(hist_option)//" and frequency ",hist_n + end if + end if + end do - call med_time_alarmInit(mclock, alarm, option=histinst_option, opt_n=histinst_n, & - reftime=mStartTime, alarmname='alarm_history_inst', rc=rc) + ! Initialize field bundles for doing time averaged mediator history output + if (hist_option /= 'none') then + ! TODO: fill this in + end if + ! Determine time average mediator output frequency and type + call NUOPC_CompAttributeGet(gcomp, name='histavg_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='hist_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 + hist_option = 'none' + hist_n = -999 + end if + + ! Set alarm for time averaged mediator history output + alarmname = 'alarm_history_avg_all' + call med_time_alarmInit(mclock, alarm, option=hist_option, opt_n=hist_n, & + reftime=mStartTime, alarmname=trim(alarmname), rc=rc) call ESMF_AlarmSet(alarm, clock=mclock, 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=mcurrtime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (mastertask) then + write(logunit,F01) trim(subname)//" set average mediator history alarm "//& + trim(alarmname)//" with option "//trim(hist_option)//" and frequency ",hist_n + end if + do n = 1,ncomps + if (is_local%wrap%comp_present(n)) then + alarmname = 'alarm_history_avg_' // trim(compname(n)) + call med_time_alarmInit(mclock, alarm, option=hist_option, opt_n=hist_n, & + reftime=mStartTime, alarmname=trim(alarmname), rc=rc) + call ESMF_AlarmSet(alarm, clock=mclock, 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=mcurrtime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (mastertask) then + write(logunit,F01) trim(subname)//" set average mediator history alarm "//& + trim(alarmname)//" with option "//trim(hist_option)//" and frequency ",hist_n + end if + end if + end do - ! ----------------------------- - ! Set alarm for averaged mediator history output - ! ----------------------------- + if (mastertask) write(logunit,*) - !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 + end subroutine med_phases_history_alarms_init - !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 + !=============================================================================== + subroutine med_phases_history_write(gcomp, rc) + ! -------------------------------------- + ! Write mediator history file for all variables + ! -------------------------------------- - !call ESMF_AlarmSet(alarm, clock=mclock, rc=rc) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc - !-------------------------------- - ! Advance model clock to trigger alarms then reset model clock back to currtime - !-------------------------------- + ! local variables + character(len=*), parameter :: subname='(med_phases_history_write)' + !--------------------------------------- - call ESMF_ClockGet(mclock, currTime=mCurrTime, timeStep=mtimestep, rc=rc) + rc = ESMF_SUCCESS + + call t_startf('MED:'//subname) + call med_phases_history_write_file_inst(gcomp, 'all', 'alarm_history_inst_all', rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeIntervalGet(mtimestep, s=timestep_length, rc=rc) + call t_stopf('MED:'//subname) + end subroutine med_phases_history_write + + !=============================================================================== + subroutine med_phases_history_write_atm(gcomp, rc) + ! -------------------------------------- + ! Write mediator history file for atm variables + ! -------------------------------------- + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + character(len=*), parameter :: subname='(med_phases_history_write_atm)' + !--------------------------------------- + rc = ESMF_SUCCESS + + call t_startf('MED:'//subname) + call med_phases_history_write_file_inst(gcomp, 'atm', 'alarm_history_inst_atm', rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call t_stopf('MED:'//subname) + end subroutine med_phases_history_write_atm - call ESMF_ClockAdvance(mclock,rc=rc) + !=============================================================================== + subroutine med_phases_history_write_ice(gcomp, rc) + ! -------------------------------------- + ! Write mediator history file for ice variables + ! -------------------------------------- + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + character(len=*), parameter :: subname='(med_phases_history_write_ice)' + !--------------------------------------- + rc = ESMF_SUCCESS + + call t_startf('MED:'//subname) + call med_phases_history_write_file_inst(gcomp, 'ice', 'alarm_history_inst_ice', rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call t_stopf('MED:'//subname) + end subroutine med_phases_history_write_ice - call ESMF_ClockSet(mclock, currTime=mcurrtime, rc=rc) + !=============================================================================== + subroutine med_phases_history_write_glc(gcomp, rc) + ! -------------------------------------- + ! Write mediator history file for glc variables + ! -------------------------------------- + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + character(len=*), parameter :: subname='(med_phases_history_write_glc)' + !--------------------------------------- + rc = ESMF_SUCCESS + + call t_startf('MED:'//subname) + call med_phases_history_write_file_inst(gcomp, 'glc', 'alarm_history_inst_glc', rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call t_stopf('MED:'//subname) + end subroutine med_phases_history_write_glc - ! ----------------------------- - ! Write mediator diagnostic output - ! ----------------------------- + !=============================================================================== + subroutine med_phases_history_write_lnd(gcomp, rc) + ! -------------------------------------- + ! Write mediator history file for lnd variables + ! -------------------------------------- - 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 + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": exited", ESMF_LOGMSG_INFO) - endif + ! local variables + character(len=*), parameter :: subname='(med_phases_history_write_lnd)' + !--------------------------------------- + rc = ESMF_SUCCESS - end subroutine med_phases_history_alarm_init + call t_startf('MED:'//subname) + call med_phases_history_write_file_inst(gcomp, 'lnd', 'alarm_history_inst_lnd', rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call t_stopf('MED:'//subname) + end subroutine med_phases_history_write_lnd !=============================================================================== + subroutine med_phases_history_write_ocn(gcomp, rc) + ! -------------------------------------- + ! Write mediator history file for ocn variables + ! -------------------------------------- - subroutine med_phases_history_write(gcomp, rc) + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + ! local variables + character(len=*), parameter :: subname='(med_phases_history_write_ocn)' + !--------------------------------------- + rc = ESMF_SUCCESS + + call t_startf('MED:'//subname) + call med_phases_history_write_file_inst(gcomp, 'ocn', 'alarm_history_inst_ocn', rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call t_stopf('MED:'//subname) + end subroutine med_phases_history_write_ocn + + !=============================================================================== + subroutine med_phases_history_write_rof(gcomp, rc) ! -------------------------------------- - ! Write mediator history file + ! Write mediator history file for rof variables ! -------------------------------------- - 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, complnd, compocn, compice, comprof, compglc, ncomps, compname - use esmFlds , only : fldListFr, fldListTo - use NUOPC_Model, only : NUOPC_ModelGet + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + character(len=*), parameter :: subname='(med_phases_history_write_rof)' + !--------------------------------------- + + rc = ESMF_SUCCESS + + call t_startf('MED:'//subname) + call med_phases_history_write_file_inst(gcomp, 'rof', 'alarm_history_inst_rof', rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call t_stopf('MED:'//subname) + end subroutine med_phases_history_write_rof + + !=============================================================================== + subroutine med_phases_history_write_wav(gcomp, rc) + ! -------------------------------------- + ! Write mediator history file for wav variables + ! -------------------------------------- ! 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 + character(len=*), parameter :: subname='(med_phases_history_write_wav)' + !--------------------------------------- + rc = ESMF_SUCCESS + + call t_startf('MED:'//subname) + call med_phases_history_write_file_inst(gcomp, 'wav', 'alarm_history_inst_wav', rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call t_stopf('MED:'//subname) + end subroutine med_phases_history_write_wav + + !=============================================================================== + subroutine med_phases_history_write_file_inst(gcomp, type, alarmname, rc) + + ! input/output variables + type(ESMF_GridComp) , intent(inout) :: gcomp + character(len=*) , intent(in) :: type + character(len=*) , intent(in) :: alarmname + integer , intent(out) :: rc + + ! local variables + type(ESMF_Clock) :: mclock type(ESMF_Alarm) :: alarm - integer :: alarmCount type(ESMF_VM) :: vm - type(ESMF_Time) :: currtime - type(ESMF_Time) :: starttime - 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 :: i,j,m,n 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 + character(CL) :: hist_file + real(r8) :: days_since ! Time interval since reference time 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)' + character(len=*), parameter :: subname='(med_phases_history_write_file)' !--------------------------------------- - 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 communicator and localpet 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 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 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=cpl_inst_tag, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - cpl_inst_tag = "" - endif - - call NUOPC_ModelGet(gcomp, modelClock=mclock, rc=rc) + ! Get the history file alarm + call NUOPC_ModelGet(gcomp, modelClock=mclock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (first_time) then - call med_phases_history_alarm_init(gcomp, rc) - end if - - !--------------------------------------- - ! Check if history alarm is ringing - and if so write the mediator history file - !--------------------------------------- - - ! 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 - - call ESMF_ClockGetAlarm(mclock, alarmname='alarm_history_inst', alarm=alarm, rc=rc) + call ESMF_ClockGetAlarm(mclock, alarmname=trim(alarmname), alarm=alarm, rc=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) + call med_phases_history_output_alarminfo(mclock, alarm, 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 - 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) - end if end if + ! Check if history alarm is ringing - and if so write the mediator history file if (ESMF_AlarmIsRinging(alarm, rc=rc)) then if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Turn ringer off - call ESMF_AlarmRingerOff( alarm, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! Get time info for history file - call ESMF_GridCompGet(gcomp, clock=mclock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_ClockGet(mclock, currtime=currtime, starttime=starttime, calendar=calendar, rc=rc) + call ESMF_AlarmRingerOff(alarm, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockGetNextTime(mclock, nextTime=nexttime, rc=rc) + ! Determine history file name and time units + call med_phases_history_get_filename(gcomp, type, hist_file, time_units, days_since, 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_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) - - 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) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! 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' - - 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 - + ! Create history file 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. + whead = .true. + wdata = .false. + else if (m == 2) then + whead = .false. + wdata = .true. call med_io_enddef(hist_file) - endif - - tbnds = dayssince + end if - 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) - 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) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - endif + ! write time values + call ESMF_ClockGet(mclock, calendar=calendar, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_io_write(hist_file, iam, time_units=time_units, calendar=calendar, time_val=days_since, & + whead=whead, wdata=wdata, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! write field bundles 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) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - 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 (ChkErr(rc,__LINE__,u_FILE_u)) return + if (type == 'all' .or. type == trim(compname(n))) then + 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) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + 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 (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + 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 endif - 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 - endif + end if enddo if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o,rc=rc)) then nx = is_local%wrap%nx(compocn) @@ -439,28 +528,156 @@ subroutine med_phases_history_write(gcomp, rc) 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 - 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) + if (type == 'all' .or. type == 'atm') then + 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 + 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) + end if end if - enddo + end do ! end of loop over m + ! Close file call med_io_close(hist_file, iam, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - endif + end if ! end of if-alarm is ringingblock + + end subroutine med_phases_history_write_file_inst + + !=============================================================================== + subroutine med_phases_history_get_filename(gcomp, type, hist_file, time_units, days_since, rc) + + ! input/output variables + type(ESMF_GridComp) , intent(inout) :: gcomp + character(len=*) , intent(in) :: type + character(len=*) , intent(out) :: hist_file + character(len=*) , intent(out) :: time_units + real(r8) , intent(out) :: days_since ! Time interval since reference time + integer , intent(out) :: rc - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + ! local variables + type(ESMF_Clock) :: mclock + type(ESMF_Time) :: currtime + type(ESMF_Time) :: starttime + type(ESMF_Time) :: nexttime + type(ESMF_TimeInterval) :: timediff ! Used to calculate curr_time + type(ESMF_Calendar) :: calendar ! calendar type + character(len=CS) :: currtimestr + character(len=CS) :: nexttimestr + integer :: start_tod ! Starting time-of-day (s) + integer :: start_ymd ! Starting date YYYYMMDD + integer :: yr,mon,day,sec ! time units + logical :: isPresent + character(CL) :: case_name ! case name + character(CS) :: cpl_inst_tag ! instance tag + character(len=*), parameter :: subname='(med_phases_history_get_timeunits)' + !--------------------------------------- + + rc = ESMF_SUCCESS + + ! Get case_name and cpl_inst_tag + 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=cpl_inst_tag, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + cpl_inst_tag = "" endif - call t_stopf('MED:'//subname) - first_time = .false. + ! Get time unit attribute value for variables + call NUOPC_ModelGet(gcomp, modelClock=mclock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockGet(mclock, currtime=currtime, starttime=starttime, calendar=calendar, 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 + 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_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 + 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 + 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) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - end subroutine med_phases_history_write + ! Determine history file name + ! Use nexttimestr rather than currtimestr here since that is the time at the end of + ! the timestep and is preferred for history file names + if (trim(type) == 'all') then + write(hist_file,"(6a)") trim(case_name), '.cpl',trim(cpl_inst_tag),'.hi.', trim(nexttimestr),'.nc' + else + write(hist_file,"(6a)") trim(case_name), '.cpl.'//trim(type),trim(cpl_inst_tag),'.hi.', trim(nexttimestr),'.nc' + end if + 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 subroutine med_phases_history_get_filename !=============================================================================== + subroutine med_phases_history_output_alarminfo(mclock, alarm, rc) + + ! input/output variables + type(ESMF_Clock), intent(in) :: mclock + type(ESMF_Alarm), intent(in) :: alarm + integer , intent(out) :: rc + + ! local variables + type(ESMF_TimeInterval) :: ringInterval + integer :: ringInterval_length + type(ESMF_Time) :: currtime + type(ESMF_Time) :: nexttime + integer :: yr,mon,day,sec ! time units + character(len=CS) :: currtimestr + character(len=CS) :: nexttimestr + character(len=*), parameter :: subname='(med_phases_history_output_alarminfo)' + !--------------------------------------- + + rc = ESMF_SUCCESS + + 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) + 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 + 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) + end if + + end subroutine med_phases_history_output_alarminfo end module med_phases_history_mod diff --git a/mediator/med_time_mod.F90 b/mediator/med_time_mod.F90 index 99d19cc4c..b6c9d653b 100644 --- a/mediator/med_time_mod.F90 +++ b/mediator/med_time_mod.F90 @@ -15,7 +15,6 @@ 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 From 9d259080ba2cfd29f647490f35bd57ae21a2f5d2 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 2 Sep 2020 19:49:41 -0600 Subject: [PATCH 09/61] more updates for auxiliary files --- cime_config/namelist_definition_drv.xml | 483 ++++++++++++++++++++++-- mediator/med.F90 | 8 + mediator/med_io_mod.F90 | 181 +++++---- mediator/med_map_mod.F90 | 3 - mediator/med_phases_history_mod.F90 | 352 ++++++++++++++++- 5 files changed, 879 insertions(+), 148 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 36ce086cb..0bc752f6a 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -1358,16 +1358,435 @@ - + + + + char aux_hist MED_attributes - turns on coupler history stream for instantaneous runoff to coupler fields. + Auxiliary coupler a2x instantaneous history output every hour. - none,all + off,on - none + off + + + + char + aux_hist + MED_attributes + + Auxiliary coupler a2x instantaneous history output every hour. + + + Faxa_swndr:Faxa_swvdr:Faxa_swndf:Faxa_swvdf + + + + char + aux_hist + MED_attributes + + Auxiliary coupler a2x instantaneous history output every hour. + + + 3600 + + + + char + aux_hist + MED_attributes + + Auxiliary name identifier in history name + + + a2x1hi + + + + char + aux_hist + MED_attributes + + Averaging type (inst or time average) + + inst,timeavg + + inst + + + + char + aux_hist + MED_attributes + + Number of time sames per file. + + + 24 + + + + + + + + char + aux_hist + MED_attributes + + Auxiliary a2x history output averaged over 1 hour. + + off,on + + off + + + + char + aux_hist + MED_attributes + + Auxiliary a2x history output averaged over 1 hour. + + + Sa_u:Sa_v + + + + char + aux_hist + MED_attributes + + Auxiliary coupler a2x instantaneous history output every hour. + + + 3600 + + + + char + aux_hist + MED_attributes + + Auxiliary name identifier in history name + + + a2x1h + + + + char + aux_hist + MED_attributes + + Averaging type (inst or time average) + + inst,timeavg + + timeavg + + + + char + aux_hist + MED_attributes + + Number of time sames per file. + + + 24 + + + + + + + + char + aux_hist + MED_attributes + + Auxiliary coupler a2x precipitation history output every 3 hours + + off,on + + off + + + + char + aux_hist + MED_attributes + + Auxiliary coupler a2x precipitation history output every 3 hours + + + Faxa_rainc:Faxa_rainl:Faxa_snowc:Faxa_snowl + + + + char + aux_hist + MED_attributes + + Auxiliary coupler a2x instantaneous history output every hour. + + + 10800 + + + + char + aux_hist + MED_attributes + + Auxiliary name identifier in history name + + + a2x3h_prec + + + + char + aux_hist + MED_attributes + + Averaging type (inst or time average) + + inst,timeavg + + timeavg + + + + char + aux_hist + MED_attributes + + Number of time sames per file. + + + 8 + + + + + + + + char + aux_hist + MED_attributes + + Auxiliary coupler a2x precipitation history output every 3 hours + + off,on + + off + + + + char + aux_hist + MED_attributes + + Auxiliary coupler 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 + + Auxiliary coupler a2x instantaneous history output every hour. + + + 10800 + + + + char + aux_hist + MED_attributes + + Auxiliary name identifier in history name + + + a2x3h + + + + char + aux_hist + MED_attributes + + Averaging type (inst or time average) + + inst,timeavg + + timeavg + + + + char + aux_hist + MED_attributes + + Number of time sames per file. + + + 8 + + + + + + + + char + aux_hist + MED_attributes + + Auxiliary coupler a2x precipitation history output every 3 hours + + off,on + + off + + + + char + aux_hist + MED_attributes + + Auxiliary coupler a2x precipitation history output every 3 hours + + + Faxa_bcph:Faxa_ocph:Faxa_dstwet:Faxa_dstdry:Sa_co2prog:Sa_co2diag + + + + char + aux_hist + MED_attributes + + Auxiliary coupler a2x instantaneous history output every hour. + + + 86400 + + + + char + aux_hist + MED_attributes + + Auxiliary name identifier in history name + + + a2x24h + + + + char + aux_hist + MED_attributes + + Averaging type (inst or time average) + + inst,timeavg + + timeavg + + + + char + aux_hist + MED_attributes + + Number of time sames per file. + + + 1 + + + + + + + + char + aux_hist + MED_attributes + + Auxiliary coupler a2x precipitation history output every 3 hours + + off,on + + off + + + + char + aux_hist + MED_attributes + + Auxiliary coupler a2x precipitation history output every 3 hours + + + Faxa_bcph:Faxa_ocph:Faxa_dstwet:Faxa_dstdry:Sa_co2prog:Sa_co2diag + + + + char + aux_hist + MED_attributes + + Auxiliary coupler a2x instantaneous history output every hour. + + + 86400 + + + + char + aux_hist + MED_attributes + + Auxiliary name identifier in history name + + + a2x24h + + + + char + aux_hist + MED_attributes + + Averaging type (inst or time average) + + inst,timeavg + + timeavg + + + + char + aux_hist + MED_attributes + + Number of time sames per file. + + + 1 @@ -1384,6 +1803,9 @@ + + + char aux_hist @@ -1397,81 +1819,76 @@ - + + + + + char aux_hist MED_attributes - Auxiliary mediator a2x history fields (default is none) + Auxiliary coupler a2x precipitation history output every 3 hours - none,all,Faxa_swndr:Faxa_swvdr:Faxa_swndf:Faxa_swvdf + off,on - none + off - - + char aux_hist MED_attributes - Auxiliary coupler a2x averaged history output every hour + Auxiliary coupler a2x precipitation history output every 3 hours - none,all,Sa_u:Sa_v - none + Forr_rofr,Forr_rofi - - + char aux_hist MED_attributes - Auxiliary coupler a2x instantaneous history output every hour + Auxiliary coupler a2x instantaneous history output every hour. - none,all,Faxa_swndr:Faxa_swvdr:Faxa_swndf:Faxa_swvdf - none + 86400 - - + char aux_hist MED_attributes - Auxiliary coupler a2x history output every 24 hours + Auxiliary name identifier in history name - none,all,Faxa_bcph:Faxa_ocph:Faxa_dstwet:Faxa_dstdry:Sa_co2prog:Sa_co2diag - none + r2x24h - - + char aux_hist MED_attributes - Auxiliary coupler a2x precipitation history output every 3 hours + Averaging type (inst or time average) - none,all,Faxa_rainc:Faxa_rainl:Faxa_snowc:Faxa_snowl + inst,timeavg - none + timeavg - - + char aux_hist MED_attributes - Auxiliary coupler a2x averaged history output every 3 hours + Number of time sames per file. - none,all,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 - none + 1 diff --git a/mediator/med.F90 b/mediator/med.F90 index 44d6f38a0..eaa2c86ee 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -90,6 +90,7 @@ subroutine SetServices(gcomp, rc) use med_phases_history_mod , only: med_phases_history_write_ocn use med_phases_history_mod , only: med_phases_history_write_rof use med_phases_history_mod , only: med_phases_history_write_wav + use med_phases_history_mod , only: med_phases_history_write_aux use med_phases_restart_mod , only: med_phases_restart_write use med_phases_prep_atm_mod , only: med_phases_prep_atm use med_phases_prep_ice_mod , only: med_phases_prep_ice @@ -246,6 +247,13 @@ subroutine SetServices(gcomp, rc) specPhaseLabel="med_phases_history_write_wav", specRoutine=med_phases_history_write_wav, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & + phaseLabelList=(/"med_phases_history_write_aux"/), userRoutine=mediator_routine_Run, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & + specPhaseLabel="med_phases_history_write_aux", specRoutine=med_phases_history_write_aux, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + !------------------ ! setup mediator restart phase !------------------ diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index 62b5ec6fc..e568e1a02 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -244,8 +244,10 @@ subroutine med_io_wopen(filename, vm, iam, clobber, file_ind, model_doi_url) endif elseif (trim(wfilename) /= 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) + if (iam==0) then + write(logunit,*) subname,' different filename currently open ',trim(filename) + write(logunit,*) subname,' different wfilename currently open ',trim(wfilename) + end if call ESMF_LogWrite(subname//'different file currently open '//trim(filename), ESMF_LOGMSG_INFO) rc = ESMF_FAILURE return @@ -392,7 +394,7 @@ 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) + fillval, pre, flds, tavg, use_float, file_ind, rc) !--------------- ! Write FB to netcdf file @@ -418,6 +420,7 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & 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 @@ -464,37 +467,25 @@ 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 + integer :: fieldcount + 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 - + if (present(pre)) lpre = trim(pre) lwhead = .true. - lwdata = .true. if (present(whead)) lwhead = whead + lwdata = .true. if (present(wdata)) lwdata = wdata + luse_float = .false. + if (present(use_float)) luse_float = use_float + lfile_ind = 0 + if (present(file_ind)) lfile_ind=file_ind if (.not.lwhead .and. .not.lwdata) then ! should we write a warning? @@ -504,17 +495,9 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & return endif - 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 @@ -522,43 +505,60 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & return endif + ! Get number of fields + if (present(flds)) then + fieldcount = size(flds) + else + call ESMF_FieldBundleGet(FB, fieldCount=fieldcount, rc=rc) + write(tmpstr,*) subname//' field count = '//trim(lpre),fieldcount + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + if (fieldcount < 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(fieldCount)) + 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 @@ -586,24 +586,27 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & !return endif + ! Write header 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)) - + 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 + do k = 1,fieldcount + ! 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) @@ -694,7 +697,6 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & ! Finish define mode if (lwdata) call med_io_enddef(filename, file_ind=lfile_ind) - end if if (lwdata) then @@ -706,19 +708,19 @@ 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 + do k = 1,fieldcount + ! 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) + call FB_getFldPtr(FB, itemc, fldptr1=fldptr1, fldptr2=fldptr2, rank=rank, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! TODO (mvertens, 2019-03-13): this is a temporary mod to NOT write hgt @@ -754,7 +756,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) @@ -769,9 +771,7 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & call pio_freedecomp(io_file(lfile_ind), iodesc) endif - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) - endif + if (allocated(fieldnamelist)) deallocate(fieldnamelist) end subroutine med_io_write_FB @@ -832,7 +832,6 @@ subroutine med_io_write_int(filename, iam, idata, dname, whead, wdata, file_ind, if (lwdata) 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 @@ -897,15 +896,11 @@ subroutine med_io_write_int1d(filename, iam, idata, dname, whead, wdata, file_in 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 (lwdata) 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 !=============================================================================== @@ -962,9 +957,7 @@ subroutine med_io_write_r8(filename, iam, rdata, dname, whead, wdata, file_ind, 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 (lwdata) then rcode = pio_inq_varid(io_file(lfile_ind),trim(dname),varid) rcode = pio_put_var(io_file(lfile_ind),varid,rdata) endif @@ -1078,6 +1071,7 @@ subroutine med_io_write_char(filename, iam, rdata, dname, whead, wdata, file_ind 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 @@ -1093,8 +1087,7 @@ subroutine med_io_write_char(filename, iam, rdata, dname, whead, wdata, file_ind 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 (lwdata) then charvar = '' charvar = trim(rdata) rcode = pio_inq_varid(io_file(lfile_ind),trim(dname),varid) @@ -1154,17 +1147,18 @@ subroutine med_io_write_time(filename, iam, time_units, calendar, time_val, nt,& 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 ! Write out header - ! Write out header - if (lwhead) then + ! define time 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 @@ -1182,6 +1176,7 @@ subroutine med_io_write_time(filename, iam, time_units, calendar, time_val, nt,& end if rcode = pio_put_att(io_file(lfile_ind),varid,'calendar',trim(calname)) + ! define time bounds if (present(tbnds)) then dimid2(2) = dimid(1) rcode = pio_put_att(io_file(lfile_ind),varid,'bounds','time_bnds') @@ -1189,28 +1184,33 @@ subroutine med_io_write_time(filename, iam, time_units, calendar, time_val, nt,& 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 + + else if (lwdata) then ! Write out data - ! Write out data - if (lwdata) then + ! write time 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) + 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_1d) + + ! write time bounds if (present(tbnds)) then - rcode = pio_inq_varid(io_file(lfile_ind),'time_bnds',varid) - start = 1 - count = 1 + rcode = pio_inq_varid(io_file(lfile_ind), 'time_bnds', varid) + count(1) = 2 + count(2) = 1 + start(1) = 1 if (present(nt)) then start(2) = nt + else + start(2) = 1 endif - count(1) = 2 - rcode = pio_put_var(io_file(lfile_ind),varid,start,count,tbnds) + rcode = pio_put_var(io_file(lfile_ind), varid, start(1:2), count(1:2), tbnds) endif + endif end subroutine med_io_write_time @@ -1266,8 +1266,6 @@ subroutine med_io_read_FB(filename, vm, iam, FB, pre, frame, rc) character(*),parameter :: subName = '(med_io_read_FB) ' !------------------------------------------------------------------------------- rc = ESMF_Success - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) - if (chkerr(rc,__LINE__,u_FILE_u)) return lpre = ' ' if (present(pre)) then @@ -1278,6 +1276,7 @@ subroutine med_io_read_FB(filename, vm, iam, FB, pre, frame, rc) else lframe = 1 endif + if (.not. ESMF_FieldBundleIsCreated(FB,rc=rc)) then call ESMF_LogWrite(trim(subname)//" FB "//trim(lpre)//" not created", ESMF_LOGMSG_INFO) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -1420,10 +1419,6 @@ subroutine med_io_read_FB(filename, vm, iam, FB, pre, frame, rc) call pio_freedecomp(pioid, iodesc) call pio_closefile(pioid) - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) - endif - end subroutine med_io_read_FB !=============================================================================== diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index ec0d19a20..d451a0b0b 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -548,9 +548,6 @@ logical function med_map_RH_is_created_RH3d(RHs,n1,n2,mapindex,rc) rc = ESMF_SUCCESS - write(6,*)'calling med_map_RH_is_created_RH1d for n1 to n2 and mapindex= ',& - compname(n1), compname(n2), mapindex - med_map_RH_is_created_RH3d = med_map_RH_is_created_RH1d(RHs(n1,n2,:),mapindex,rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 822c801ed..1fa0d505c 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -25,10 +25,11 @@ module med_phases_history_mod 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_FieldBundleIsCreated - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LOGMSG_ERROR - use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE, ESMF_MAXSTR - use ESMF , only : operator(==), operator(-) + use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleIsCreated + 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(-), operator(/=) use NUOPC , only : NUOPC_CompAttributeGet use NUOPC_Model , only : NUOPC_ModelGet use esmFlds , only : compatm, complnd, compocn, compice, comprof, compglc, ncomps, compname, ncomps @@ -60,6 +61,9 @@ module med_phases_history_mod public :: med_phases_history_write_ocn public :: med_phases_history_write_rof public :: med_phases_history_write_wav + public :: med_phases_history_write_aux + + private :: med_phases_history_setauxflds ! type(ESMF_FieldBundle) :: FBImpAvg(ncomps) ! TODO: fill this in ! type(ESMF_FieldBundle) :: FBExpAvg(ncomps) ! TODO: fill this in @@ -67,6 +71,25 @@ module med_phases_history_mod character(*), parameter :: u_FILE_u = & __FILE__ + integer, parameter :: maxfiles = 20 + integer :: nfiles = 0 + type, public :: auxfile_type + integer :: ncomp ! component index + character(CS) :: auxname ! name for history file creation + character(CS), allocatable :: flds(:) ! array of aux field names + character(CS) :: alarmname ! alarm name for output + integer :: deltat ! interval to write out aux data in seconds + integer :: ntperfile ! maximum number of time samples per file + integer :: nt = 0 ! time in file + real(r8) :: tbnds(2) ! CF1.0 time bounds + character(CS) :: avgtype ! instantaneous or time average + type(ESMF_FieldBundle) :: FBavg ! field bundle for time averaging + end type auxfile_type + type(auxfile_type) :: auxfiles(maxfiles) + + character(CL) :: case_name ! case name + character(CS) :: inst_tag ! instance tag + !=============================================================================== contains !=============================================================================== @@ -408,7 +431,7 @@ subroutine med_phases_history_write_file_inst(gcomp, type, alarmname, rc) type(ESMF_GridComp) , intent(inout) :: gcomp character(len=*) , intent(in) :: type character(len=*) , intent(in) :: alarmname - integer , intent(out) :: rc + integer , intent(out) :: rc ! local variables type(ESMF_Clock) :: mclock @@ -440,7 +463,7 @@ subroutine med_phases_history_write_file_inst(gcomp, type, alarmname, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Get the history file alarm + ! Get the history file alarm 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) @@ -471,15 +494,15 @@ subroutine med_phases_history_write_file_inst(gcomp, type, alarmname, rc) wdata = .false. else if (m == 2) then whead = .false. - wdata = .true. + wdata = .true. call med_io_enddef(hist_file) end if - ! write time values + ! write time values (tbnds does not appear in instantaneous output) call ESMF_ClockGet(mclock, calendar=calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call med_io_write(hist_file, iam, time_units=time_units, calendar=calendar, time_val=days_since, & - whead=whead, wdata=wdata, rc=rc) + nt=1, whead=whead, wdata=wdata, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! write field bundles @@ -552,11 +575,229 @@ subroutine med_phases_history_write_file_inst(gcomp, type, alarmname, rc) end subroutine med_phases_history_write_file_inst + !=============================================================================== + subroutine med_phases_history_write_aux(gcomp, rc) + ! -------------------------------------- + ! Write mediator history file for wav variables + ! -------------------------------------- + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + character(CS) :: alarmname + character(CL) :: auxflds + character(CS) :: cvalue + integer :: n,nf + integer :: ntapes + logical :: first_time = .true. + logical :: isPresent + character(CS) :: prefix + character(len=*), parameter :: subname='(med_phases_history_write_aux)' + !--------------------------------------- + rc = ESMF_SUCCESS + + call t_startf('MED:'//subname) + + if (first_time) then + nfiles = 0 + + ! currently 5 atm2med tapes + do nf = 1,5 + write(prefix,'(a,i0)') 'histaux_atm2med_file',nf + call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_flag', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (trim(cvalue) == 'on') then + nfiles = nfiles + 1 + auxfiles(nfiles)%ncomp = compatm + call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_auxname', value=auxfiles(nfiles)%auxname, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_deltat', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) auxfiles(nfiles)%deltat + call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_ntperfile', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) auxfiles(nfiles)%ntperfile + call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_avgtype', value=auxfiles(nfiles)%avgtype, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_flds', value=auxflds, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_phases_history_setauxflds(auxflds, auxfiles(nfiles)%flds, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end do + + 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 + + do n = 1,nfiles + call med_phases_history_write_aux_file(gcomp, case_name, inst_tag, first_time, n, auxfiles(n), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do + + first_time = .false. + + call t_stopf('MED:'//subname) + + end subroutine med_phases_history_write_aux + + !=============================================================================== + subroutine med_phases_history_write_aux_file(gcomp, case_name, inst_tag, first_time, nfile_index, auxfile, rc) + + ! input/output variables + type(ESMF_GridComp) , intent(inout) :: gcomp + character(len=*) , intent(in) :: case_name + character(len=*) , intent(in) :: inst_tag + logical , intent(in) :: first_time + integer , intent(in) :: nfile_index + type(auxfile_type) , intent(inout) :: auxfile + integer , intent(out) :: rc + + ! local variables + type(InternalState) :: is_local + type(ESMF_Clock) :: mclock + type(ESMF_Time) :: starttime + type(ESMF_Time) :: currtime + type(ESMF_Calendar) :: calendar ! calendar type + type(ESMF_TimeInterval) :: timediff ! Used to calculate curr_time + type(ESMF_VM) :: vm + character(CS) :: timestr + character(CL) :: time_units ! units of time variable + character(CL) :: hist_file + real(r8) :: days_since ! Time interval since reference time + integer :: nx,ny ! global grid size + logical :: whead,wdata ! for writing restart/history cdf files + integer :: iam ! mpi task + integer :: start_ymd ! Starting date YYYYMMDD + integer :: yr,mon,day,sec ! time units + integer :: diff_day,diff_sec ! time units + integer :: ncomp + character(len=*), parameter :: subname='(med_phases_history_write_file)' + !--------------------------------------- + + rc = ESMF_SUCCESS + + ! Get the communicator and localpet + 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 the internal state + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Determine time info + call NUOPC_ModelGet(gcomp, modelClock=mclock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockGet(mclock, currtime=currtime, starttime=starttime, 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 + timediff = currtime - starttime + call ESMF_TimeIntervalGet(timediff, d=diff_day, s=diff_sec, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! If write history data + if (currtime /= starttime .and. mod(sec,auxfile%deltat) == 0) then + + ! Increment number of time samples on file + auxfile%nt = auxfile%nt + 1 + + ! Set tbnds(1) + if (diff_sec == auxfile%deltat) then + auxfile%tbnds(1) = 0._r8 + else if ( auxfile%nt == 1 ) then + auxfile%tbnds(1) = day + sec/real(SecPerDay,R8) + else + auxfile%tbnds(1) = auxfile%tbnds(2) + end if + + ! Set tbnds(2) + days_since = diff_day + diff_sec/real(SecPerDay,R8) + auxfile%tbnds(2) = days_since + + ! Create history file + ncomp = auxfile%ncomp + nx = is_local%wrap%nx(ncomp) + ny = is_local%wrap%ny(ncomp) + + ! Write header + if (auxfile%nt == 1) then + + ! determine history file name + 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(timestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + write(hist_file, "(8a)") & + trim(case_name),'.cpl',trim(inst_tag),'.h', trim(auxfile%auxname),'.',trim(timestr), '.nc' + + ! open file + call med_io_wopen(hist_file, vm, iam, file_ind=nfile_index, clobber=.true.) + + ! define 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 + + ! define time variables + call med_io_write(hist_file, iam, time_units, calendar, days_since, & + nt=auxfile%nt, tbnds=auxfile%tbnds, whead=.true., wdata=.false., file_ind=nfile_index, 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(hist_file, iam, is_local%wrap%FBimp(ncomp,ncomp), & + nx=nx, ny=ny, nt=auxfile%nt, whead=.true., wdata=.false., pre=trim(compname(ncomp))//'Imp', & + flds=auxfile%flds, file_ind=nfile_index, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! end definition phase + call med_io_enddef(hist_file, file_ind=nfile_index) + + end if + + ! Write time variables for time nt + call med_io_write(hist_file, iam, time_units, calendar, days_since, & + nt=auxfile%nt, tbnds=auxfile%tbnds, whead=.false., wdata=.true., file_ind=nfile_index, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Write data variables for time nt + call med_io_write(hist_file, iam, is_local%wrap%FBimp(ncomp,ncomp), & + nx=nx, ny=ny, nt=auxfile%nt, whead=.false., wdata=.true., pre=trim(compname(ncomp))//'Imp', & + flds=auxfile%flds, file_ind=nfile_index, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Close file + if (auxfile%nt == auxfile%ntperfile) then + call med_io_close(hist_file, iam, file_ind=nfile_index, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + auxfile%nt = 0 + end if + + end if ! end of write_now if-block + + end subroutine med_phases_history_write_aux_file + !=============================================================================== subroutine med_phases_history_get_filename(gcomp, type, hist_file, time_units, days_since, rc) ! input/output variables - type(ESMF_GridComp) , intent(inout) :: gcomp + type(ESMF_GridComp) , intent(inout) :: gcomp character(len=*) , intent(in) :: type character(len=*) , intent(out) :: hist_file character(len=*) , intent(out) :: time_units @@ -572,27 +813,26 @@ subroutine med_phases_history_get_filename(gcomp, type, hist_file, time_units, d type(ESMF_Calendar) :: calendar ! calendar type character(len=CS) :: currtimestr character(len=CS) :: nexttimestr - integer :: start_tod ! Starting time-of-day (s) integer :: start_ymd ! Starting date YYYYMMDD integer :: yr,mon,day,sec ! time units logical :: isPresent character(CL) :: case_name ! case name - character(CS) :: cpl_inst_tag ! instance tag + character(CS) :: inst_tag ! instance tag character(len=*), parameter :: subname='(med_phases_history_get_timeunits)' !--------------------------------------- rc = ESMF_SUCCESS - ! Get case_name and cpl_inst_tag + ! Get case_name and inst_tag 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=cpl_inst_tag, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='inst_suffix', value=inst_tag, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - cpl_inst_tag = "" + inst_tag = "" endif ! Get time unit attribute value for variables @@ -615,17 +855,16 @@ subroutine med_phases_history_get_filename(gcomp, type, hist_file, time_units, d 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) + time_units = 'days since ' // trim(med_io_date2yyyymmdd(start_ymd)) // ' ' // med_io_sec2hms(sec, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Determine history file name ! Use nexttimestr rather than currtimestr here since that is the time at the end of ! the timestep and is preferred for history file names if (trim(type) == 'all') then - write(hist_file,"(6a)") trim(case_name), '.cpl',trim(cpl_inst_tag),'.hi.', trim(nexttimestr),'.nc' + write(hist_file,"(6a)") trim(case_name), '.cpl',trim(inst_tag),'.hi.', trim(nexttimestr),'.nc' else - write(hist_file,"(6a)") trim(case_name), '.cpl.'//trim(type),trim(cpl_inst_tag),'.hi.', trim(nexttimestr),'.nc' + write(hist_file,"(6a)") trim(case_name), '.cpl.'//trim(type),trim(inst_tag),'.hi.', trim(nexttimestr),'.nc' end if if (mastertask) then write(logunit,*) @@ -680,4 +919,79 @@ subroutine med_phases_history_output_alarminfo(mclock, alarm, rc) end subroutine med_phases_history_output_alarminfo + !=============================================================================== + subroutine med_phases_history_setauxflds(str, auxflds, rc) + + ! input/output variables + character(len=*) , intent(in) :: str ! colon deliminted string to search + character(len=*) , allocatable, intent(out) :: auxflds(:) ! memory will be allocate for auxflds + integer , intent(out) :: rc + + ! local variables + integer :: i,k,n ! generic indecies + integer :: nflds ! allocatable size of auxflds + 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 + write(logunit,*) "ERROR: invalid list = ",trim(str) + call ESMF_LogWrite("ERROR: invalid list = "//trim(str), ESMF_LOGMSG_INFO) + 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 auxflds) + allocate(auxflds(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 auxflds(k) + auxflds(k) = str(i0:i1)//" " + end do + + end subroutine med_phases_history_setauxflds + end module med_phases_history_mod From f1daa88c8ae5e1a638fc967f156db8aef0a579f2 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 6 Sep 2020 16:47:23 -0600 Subject: [PATCH 10/61] changes needed for auxiliary files --- cime_config/namelist_definition_drv.xml | 64 ++--- mediator/med.F90 | 2 + mediator/med_io_mod.F90 | 47 ++-- mediator/med_map_mod.F90 | 1 + mediator/med_methods_mod.F90 | 20 +- mediator/med_phases_history_mod.F90 | 304 ++++++++++++++++++------ 6 files changed, 293 insertions(+), 145 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 0bc752f6a..a790e6c0d 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -1406,20 +1406,19 @@ a2x1hi - - char + + logical aux_hist MED_attributes Averaging type (inst or time average) - inst,timeavg - inst + .false. - char + integer aux_hist MED_attributes @@ -1478,16 +1477,15 @@ a2x1h - - char + + logical aux_hist MED_attributes Averaging type (inst or time average) - inst,timeavg - timeavg + .true. @@ -1550,16 +1548,15 @@ a2x3h_prec - - char + + logical aux_hist MED_attributes Averaging type (inst or time average) - inst,timeavg - timeavg + .true. @@ -1622,16 +1619,15 @@ a2x3h - - char + + logical aux_hist MED_attributes Averaging type (inst or time average) - inst,timeavg - timeavg + .true. @@ -1694,16 +1690,15 @@ a2x24h - - char + + logical aux_hist MED_attributes Averaging type (inst or time average) - inst,timeavg - timeavg + .true. @@ -1726,7 +1721,7 @@ aux_hist MED_attributes - Auxiliary coupler a2x precipitation history output every 3 hours + Auxiliary coupler l2x fields every year off,on @@ -1766,16 +1761,15 @@ a2x24h - - char + + logical aux_hist MED_attributes Averaging type (inst or time average) - inst,timeavg - timeavg + .true. @@ -1790,19 +1784,6 @@ - - char - aux_hist - MED_attributes - - turns on coupler history stream for instantaneous land to coupler fields. - - none,all - - none - - - @@ -1868,16 +1849,15 @@ r2x24h - + char aux_hist MED_attributes Averaging type (inst or time average) - inst,timeavg - timeavg + .true. diff --git a/mediator/med.F90 b/mediator/med.F90 index eaa2c86ee..2972675bb 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -1572,11 +1572,13 @@ subroutine completeFieldInitialization(State,rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return allocate(ungriddedLBound(ungriddedCount), ungriddedUBound(ungriddedCount)) + if (ungriddedCount > 0) then call ESMF_AttributeGet(fieldList(n), name="UngriddedLBound", convention="NUOPC", & purpose="Instance", valueList=ungriddedLBound, rc=rc) call ESMF_AttributeGet(fieldList(n), name="UngriddedUBound", convention="NUOPC", & purpose="Instance", valueList=ungriddedUBound, rc=rc) + call ESMF_LogWrite(subname//" "//trim(fieldName) // "has ungriddedcount > 0 ",ESMF_LOGMSG_INFO, rc=rc) endif call ESMF_FieldEmptyComplete(fieldList(n), typekind=ESMF_TYPEKIND_R8, gridToFieldMap=gridToFieldMap, & diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index e568e1a02..57acbcd8b 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 + 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 @@ -70,16 +70,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 :: file_desc_t_cnt = 20 ! Note - this is hard-wired for now integer , parameter :: number_strlen = 8 - character(CL) :: wfilename = '' + integer , parameter :: file_desc_t_cnt = 20 ! Note - this is hard-wired for now + 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 @@ -202,7 +199,7 @@ subroutine med_io_wopen(filename, vm, iam, clobber, file_ind, model_doi_url) if (.not. pio_file_is_open(io_file(lfile_ind))) then ! filename not open - wfilename = filename + wfilename(lfile_ind) = trim(filename) if (med_io_file_exists(vm, iam, filename)) then if (lclobber) then @@ -242,15 +239,17 @@ subroutine med_io_wopen(filename, vm, iam, clobber, file_ind, model_doi_url) 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) then write(logunit,*) subname,' different filename currently open ',trim(filename) - write(logunit,*) subname,' different wfilename currently open ',trim(wfilename) + write(logunit,*) subname,' different wfilename currently open ',trim(wfilename(lfile_ind)) end if call ESMF_LogWrite(subname//'different file currently open '//trim(filename), ESMF_LOGMSG_INFO) rc = ESMF_FAILURE return + else ! filename is already open, just return endif @@ -281,21 +280,29 @@ subroutine med_io_close(filename, iam, file_ind, rc) lfile_ind = 0 if (present(file_ind)) lfile_ind=file_ind + write(6,*)'DEBUG: lfile_ind = ',lfile_ind 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 ! 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,*) 'filename = ',trim(filename) + write(logunit,*) 'wfilename = ',trim(wfilename(lfile_ind)) + write(logunit,*) '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 !=============================================================================== @@ -604,11 +611,13 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & ! Determine field name if (present(flds)) then itemc = trim(flds(k)) + write(6,*)'DEBUG: using flds itemc = ',trim(itemc) else itemc = trim(fieldNameList(k)) end if ! Determine rank of field with name itemc + write(6,*)' DEBUG: itemc= ',trim(itemc) call ESMF_FieldBundleGet(FB, itemc, field=lfield, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldGet(lfield, rank=rank, rc=rc) @@ -756,7 +765,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 - why is this being done each time? + ! 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) @@ -1152,7 +1161,7 @@ subroutine med_io_write_time(filename, iam, time_units, calendar, time_val, nt,& ! should we write a warning? return endif - + if (lwhead) then ! Write out header ! define time @@ -1184,7 +1193,7 @@ subroutine med_io_write_time(filename, iam, time_units, calendar, time_val, nt,& 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) - + else if (lwdata) then ! Write out data ! write time diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index d451a0b0b..00a219616 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -692,6 +692,7 @@ subroutine med_map_Fractions_init(gcomp, n1, n2, FBSrc, FBDst, RouteHandle, rc) factorList=factorList, & ignoreDegenerate=.true., & unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return end if if (dbug_flag > 1) then diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index 9ec6500a7..fce0cc912 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -283,6 +283,8 @@ subroutine med_methods_FB_init_pointer(StateIn, FBout, flds_scalar_name, name, r if (chkerr(rc,__LINE__,u_FILE_u)) return ! create new field with an ungridded dimension + call ESMF_LogWrite(trim(subname)// ": creating new field "// & + trim(lfieldnamelist(n)) //" with ungridded dimension", ESMF_LOGMSG_INFO) newfield = ESMF_FieldCreate(lmesh, dataptr2d, ESMF_INDEX_DELOCAL, & meshloc=meshloc, name=lfieldNameList(n), & ungriddedLbound=ungriddedLbound, ungriddedUbound=ungriddedUbound, gridToFieldMap=gridtoFieldMap, rc=rc) @@ -294,7 +296,7 @@ subroutine med_methods_FB_init_pointer(StateIn, FBout, flds_scalar_name, name, r call ESMF_FieldGet(lfield, farrayptr=dataptr1d, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ! create new field without an ungridded dimension + ! create new field without an ungridded dimension newfield = ESMF_FieldCreate(lmesh, dataptr1d, ESMF_INDEX_DELOCAL, & meshloc=meshloc, name=lfieldNameList(n), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -560,7 +562,11 @@ subroutine med_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBgeom, S ! Create the field on a lmesh if (ungriddedCount > 0) then + ! ungridded dimensions in field + call ESMF_LogWrite(trim(subname) // ": creating new field "// & + trim(lfieldnamelist(n)) //" with ungridded dimension", ESMF_LOGMSG_INFO) + allocate(ungriddedLBound(ungriddedCount), ungriddedUBound(ungriddedCount)) call ESMF_AttributeGet(lfield, name="UngriddedLBound", convention="NUOPC", & purpose="Instance", valueList=ungriddedLBound, rc=rc) @@ -583,6 +589,8 @@ subroutine med_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBgeom, S deallocate( ungriddedLbound, ungriddedUbound, gridToFieldMap) else ! No ungridded dimensions in field + call ESMF_LogWrite(trim(subname)// ": creating new field "// & + trim(lfieldnamelist(n)) //" without ungridded dimension", ESMF_LOGMSG_INFO) field = ESMF_FieldCreate(lmesh, ESMF_TYPEKIND_R8, meshloc=meshloc, name=lfieldNameList(n), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if @@ -590,16 +598,16 @@ subroutine med_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBgeom, S else if (present(fieldNameList)) then ! Assume no ungridded dimensions if just the field name list is give + call ESMF_LogWrite(trim(subname)// ": creating new field "// & + trim(lfieldnamelist(n)) //" without ungridded dimension", ESMF_LOGMSG_INFO) field = ESMF_FieldCreate(lmesh, ESMF_TYPEKIND_R8, meshloc=meshloc, name=lfieldNameList(n), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if ! Add the created field bundle FBout - if (dbug_flag > 1) then - call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" adding field "//trim(lfieldNameList(n)), & - ESMF_LOGMSG_INFO) - end if + call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" adding field "//trim(lfieldNameList(n)), & + ESMF_LOGMSG_INFO) call ESMF_FieldBundleAdd(FBout, (/field/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -1667,6 +1675,7 @@ logical function med_methods_FB_FldChk(FB, fldname, rc) if (dbug_flag > 10) then call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif + rc = ESMF_SUCCESS ! If field bundle is not created then set return to .false. @@ -1684,6 +1693,7 @@ logical function med_methods_FB_FldChk(FB, fldname, rc) ESMF_LOGMSG_ERROR) return endif + if (isPresent) then med_methods_FB_FldChk = .true. endif diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 1fa0d505c..6c59b58e3 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -23,24 +23,29 @@ module med_phases_history_mod 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_TimeInterval, ESMF_TimeIntervalGet, ESMF_TimeIntervalSet use ESMF , only : ESMF_Alarm, ESMF_AlarmIsRinging, ESMF_AlarmRingerOff, ESMF_AlarmGet - use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleIsCreated + use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet + use ESMF , only : ESMF_FieldBundleIsCreated, ESMF_FieldBundleRemove 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(-), operator(/=) use NUOPC , only : NUOPC_CompAttributeGet use NUOPC_Model , only : NUOPC_ModelGet - use esmFlds , only : compatm, complnd, compocn, compice, comprof, compglc, ncomps, compname, ncomps + use esmFlds , only : compatm, complnd, compocn, compice, comprof, compglc, ncomps, compname use esmFlds , only : fldListFr, fldListTo use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_constants_mod , only : SecPerDay => med_constants_SecPerDay + use med_constants_mod , only : czero => med_constants_czero 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 : FB_GetFldPtr => med_methods_FB_GetFldPtr + use med_methods_mod , only : FB_init => med_methods_FB_init use med_methods_mod , only : FB_accum => med_methods_FB_accum + use med_methods_mod , only : FB_average => med_methods_FB_average + use med_methods_mod , only : FB_fldchk => med_methods_FB_fldchk use med_methods_mod , only : State_GetScalar => med_methods_State_GetScalar use med_internalstate_mod , only : InternalState, mastertask, logunit use med_time_mod , only : med_time_alarmInit @@ -65,31 +70,37 @@ module med_phases_history_mod private :: med_phases_history_setauxflds - ! type(ESMF_FieldBundle) :: FBImpAvg(ncomps) ! TODO: fill this in - ! type(ESMF_FieldBundle) :: FBExpAvg(ncomps) ! TODO: fill this in - character(*), parameter :: u_FILE_u = & - __FILE__ + type, public :: avgfile_type + real(r8) :: tbnds(2) ! CF1.0 time bounds + type(ESMF_FieldBundle) :: FBaccum ! field bundle for time averaging + integer :: accumcnt ! field bundle accumulation counter + end type avgfile_type + type(avgfile_type) :: avgfiles(ncomps) integer, parameter :: maxfiles = 20 integer :: nfiles = 0 type, public :: auxfile_type integer :: ncomp ! component index character(CS) :: auxname ! name for history file creation + character(CL) :: histfile ! current history file name character(CS), allocatable :: flds(:) ! array of aux field names - character(CS) :: alarmname ! alarm name for output integer :: deltat ! interval to write out aux data in seconds integer :: ntperfile ! maximum number of time samples per file integer :: nt = 0 ! time in file real(r8) :: tbnds(2) ! CF1.0 time bounds - character(CS) :: avgtype ! instantaneous or time average - type(ESMF_FieldBundle) :: FBavg ! field bundle for time averaging + logical :: useavg ! if true, time average, otherwise instantaneous + type(ESMF_FieldBundle) :: FBaccum ! field bundle for time averaging + integer :: accumcnt ! field bundle accumulation counter end type auxfile_type type(auxfile_type) :: auxfiles(maxfiles) character(CL) :: case_name ! case name character(CS) :: inst_tag ! instance tag + character(*), parameter :: u_FILE_u = & + __FILE__ + !=============================================================================== contains !=============================================================================== @@ -128,7 +139,7 @@ subroutine med_phases_history_alarms_init(gcomp, rc) 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 - integer :: n + integer :: n, ncomp logical :: isPresent logical :: isSet character(*),parameter :: F01 = "(a,2x,i8)" @@ -149,8 +160,10 @@ subroutine med_phases_history_alarms_init(gcomp, 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(logunit,*) - write(logunit,F01) trim(subname)//" history clock timestep = ",timestep_length + if (mastertask) then + write(logunit,*) + write(logunit,F01) trim(subname)//" history clock timestep = ",timestep_length + end if ! Determine instantaneous mediator output frequency and type call NUOPC_CompAttributeGet(gcomp, name='history_option', isPresent=isPresent, isSet=isSet, rc=rc) @@ -199,20 +212,26 @@ subroutine med_phases_history_alarms_init(gcomp, rc) end if end do - ! Initialize field bundles for doing time averaged mediator history output - if (hist_option /= 'none') then - ! TODO: fill this in - end if - ! Determine time average mediator output frequency and type call NUOPC_CompAttributeGet(gcomp, name='histavg_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='hist_option', value=hist_option, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='histavg__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) + call NUOPC_CompAttributeGet(gcomp, name='histavg_n', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) hist_n + ! create avgerage field bundle for every component that is present + do ncomp = 1,ncomps + if (is_local%wrap%comp_present(ncomp)) then + call FB_init(avgfiles(ncomp)%FBaccum, is_local%wrap%flds_scalar_name, & + FBgeom=is_local%wrap%FBImp(ncomp,ncomp), FBflds=is_local%wrap%FBImp(ncomp,ncomp), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + call FB_reset(avgfiles(ncomp)%FBaccum, czero, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + avgfiles(ncomp)%accumcnt = 0 + end do else hist_option = 'none' hist_n = -999 @@ -586,14 +605,19 @@ subroutine med_phases_history_write_aux(gcomp, rc) integer, intent(out) :: rc ! local variables - character(CS) :: alarmname - character(CL) :: auxflds - character(CS) :: cvalue - integer :: n,nf - integer :: ntapes - logical :: first_time = .true. - logical :: isPresent - character(CS) :: prefix + type(InternalState) :: is_local + character(CL) :: auxflds + character(CS) :: cvalue + integer :: n,n1 + integer :: nfcnt + integer :: nfile + logical :: isPresent + logical :: isSet + character(CS) :: prefix + logical :: found + integer :: fieldcount + character(CS), allocatable :: fieldNameList(:) + logical :: first_time = .true. character(len=*), parameter :: subname='(med_phases_history_write_aux)' !--------------------------------------- rc = ESMF_SUCCESS @@ -601,33 +625,95 @@ subroutine med_phases_history_write_aux(gcomp, rc) call t_startf('MED:'//subname) if (first_time) then - nfiles = 0 - ! currently 5 atm2med tapes - do nf = 1,5 - write(prefix,'(a,i0)') 'histaux_atm2med_file',nf - call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_flag', value=cvalue, rc=rc) + ! Get the internal state + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + nfcnt = 0 + do nfile = 1,maxfiles + write(prefix,'(a,i0)') 'histaux_atm2med_file',nfile + call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_flag', isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (trim(cvalue) == 'on') then - nfiles = nfiles + 1 - auxfiles(nfiles)%ncomp = compatm - call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_auxname', value=auxfiles(nfiles)%auxname, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_deltat', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) auxfiles(nfiles)%deltat - call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_ntperfile', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) auxfiles(nfiles)%ntperfile - call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_avgtype', value=auxfiles(nfiles)%avgtype, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_flds', value=auxflds, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_setauxflds(auxflds, auxfiles(nfiles)%flds, rc) + if (isPresent .and. isSet) then + call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_flag', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (trim(cvalue) == 'on') then + ! Increment nfcnt + nfcnt = nfcnt + 1 + + ! Determine content of auxfiles(nfcnt) + auxfiles(nfcnt)%ncomp = compatm + call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_auxname', value=auxfiles(nfcnt)%auxname, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_deltat', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) auxfiles(nfcnt)%deltat + call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_ntperfile', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) auxfiles(nfcnt)%ntperfile + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_useavg', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) auxfiles(nfcnt)%useavg + call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_flds', value=auxflds, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Note that the following call allocates the memory for fieldnamelist + call med_phases_history_setauxflds(auxflds, fieldnamelist, rc) + + ! Remove all fields from auxfiles(nfcnt)%flds that are not in FBImp(compatm,compatm) + fieldCount = size(fieldnamelist) + do n = 1,fieldcount + if (.not. FB_fldchk(is_local%wrap%FBImp(compatm,compatm), trim(fieldnamelist(n)), rc)) then + do n1 = n, fieldCount-1 + fieldnamelist(n1) = fieldnamelist(n1+1) + end do + fieldCount = fieldCount - 1 + end if + end do + allocate(auxfiles(nfcnt)%flds(fieldcount)) + do n = 1,fieldcount + auxfiles(nfcnt)%flds(n) = trim(fieldnamelist(n)) + end do + deallocate(fieldnamelist) ! this was allocated in med_phases_history_setauxflds + + ! Create FBaccum if averaging is on + if (auxfiles(nfcnt)%useavg) then + ! First duplicate all fields in FBImp(compatm,compatm) + call ESMF_LogWrite(trim(subname)// ": calling FB_init for FBaccum(compatm)", ESMF_LOGMSG_INFO) + call FB_init(auxfiles(nfcnt)%FBaccum, is_local%wrap%flds_scalar_name, & + FBgeom=is_local%wrap%FBImp(compatm,compatm), STflds=is_local%wrap%NStateImp(compatm), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Now remove all fields from FBAccum that are not in the input flds list + call ESMF_FieldBundleGet(is_local%wrap%FBImp(compatm,compatm), fieldCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(fieldNameList(fieldCount)) + call ESMF_FieldBundleGet(is_local%wrap%FBImp(compatm,compatm), fieldNameList=fieldNameList, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + do n = 1,size(fieldnamelist) + found = .false. + do n1 = 1,size(auxfiles(nfcnt)%flds) + if (trim(fieldnamelist(n)) == trim(auxfiles(nfcnt)%flds(n1))) then + found = .true. + exit + end if + end do + if (.not. found) then + call ESMF_FieldBundleRemove(auxfiles(nfcnt)%FBaccum, fieldnamelist(n:n), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + end do + deallocate(fieldnameList) + + end if + end if end if end do + nfiles = nfcnt + ! Get file name variables 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) @@ -638,51 +724,51 @@ subroutine med_phases_history_write_aux(gcomp, rc) else inst_tag = "" endif + + first_time = .false. end if do n = 1,nfiles - call med_phases_history_write_aux_file(gcomp, case_name, inst_tag, first_time, n, auxfiles(n), rc=rc) + call med_phases_history_write_aux_file(gcomp, case_name, inst_tag, n, auxfiles(n), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end do - first_time = .false. - call t_stopf('MED:'//subname) end subroutine med_phases_history_write_aux !=============================================================================== - subroutine med_phases_history_write_aux_file(gcomp, case_name, inst_tag, first_time, nfile_index, auxfile, rc) + subroutine med_phases_history_write_aux_file(gcomp, case_name, inst_tag, nfile_index, auxfile, rc) ! input/output variables type(ESMF_GridComp) , intent(inout) :: gcomp character(len=*) , intent(in) :: case_name character(len=*) , intent(in) :: inst_tag - logical , intent(in) :: first_time integer , intent(in) :: nfile_index type(auxfile_type) , intent(inout) :: auxfile integer , intent(out) :: rc ! local variables type(InternalState) :: is_local + type(ESMF_VM) :: vm type(ESMF_Clock) :: mclock type(ESMF_Time) :: starttime type(ESMF_Time) :: currtime type(ESMF_Calendar) :: calendar ! calendar type - type(ESMF_TimeInterval) :: timediff ! Used to calculate curr_time - type(ESMF_VM) :: vm - character(CS) :: timestr + type(ESMF_TimeInterval) :: timediff ! diff between current and start time + character(CS) :: timestr ! yr-mon-day-sec string character(CL) :: time_units ! units of time variable - character(CL) :: hist_file + character(CL) :: hist_file ! name of output file real(r8) :: days_since ! Time interval since reference time integer :: nx,ny ! global grid size logical :: whead,wdata ! for writing restart/history cdf files - integer :: iam ! mpi task + logical :: write_now ! if true, write time sample to file + integer :: iam ! mpi task integer :: start_ymd ! Starting date YYYYMMDD integer :: yr,mon,day,sec ! time units integer :: diff_day,diff_sec ! time units integer :: ncomp - character(len=*), parameter :: subname='(med_phases_history_write_file)' + character(len=*), parameter :: subname='(med_phases_history_write_aux_file)' !--------------------------------------- rc = ESMF_SUCCESS @@ -709,8 +795,29 @@ subroutine med_phases_history_write_aux_file(gcomp, case_name, inst_tag, first_t call ESMF_TimeIntervalGet(timediff, d=diff_day, s=diff_sec, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! If write history data - if (currtime /= starttime .and. mod(sec,auxfile%deltat) == 0) then + ! Set shorthand variables + ncomp = auxfile%ncomp + nx = is_local%wrap%nx(ncomp) + ny = is_local%wrap%ny(ncomp) + + ! Determine if write history data + write_now = (currtime /= starttime .and. mod(sec,auxfile%deltat) == 0) + + ! Do accumulation if needed + if (auxfile%useavg) then + if (write_now) then + call FB_average(auxfile%FBaccum, auxfile%accumcnt, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + auxfile%accumcnt = 0 + else + call FB_accum(auxfile%FBaccum, is_local%wrap%FBImp(ncomp,ncomp), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + auxfile%accumcnt = auxfile%accumcnt + 1 + endif + end if + + ! Write time sample to file + if ( write_now ) then ! Increment number of time samples on file auxfile%nt = auxfile%nt + 1 @@ -728,10 +835,7 @@ subroutine med_phases_history_write_aux_file(gcomp, case_name, inst_tag, first_t days_since = diff_day + diff_sec/real(SecPerDay,R8) auxfile%tbnds(2) = days_since - ! Create history file - ncomp = auxfile%ncomp - nx = is_local%wrap%nx(ncomp) - ny = is_local%wrap%ny(ncomp) + ! Create history file ! Write header if (auxfile%nt == 1) then @@ -742,11 +846,11 @@ subroutine med_phases_history_write_aux_file(gcomp, case_name, inst_tag, first_t call ESMF_TimeGet(currtime,yy=yr, mm=mon, dd=day, s=sec, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return write(timestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec - write(hist_file, "(8a)") & + write(auxfile%histfile, "(8a)") & trim(case_name),'.cpl',trim(inst_tag),'.h', trim(auxfile%auxname),'.',trim(timestr), '.nc' ! open file - call med_io_wopen(hist_file, vm, iam, file_ind=nfile_index, clobber=.true.) + call med_io_wopen(auxfile%histfile, vm, iam, file_ind=nfile_index, clobber=.true.) ! define time units call ESMF_TimeGet(starttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) @@ -756,35 +860,44 @@ subroutine med_phases_history_write_aux_file(gcomp, case_name, inst_tag, first_t if (ChkErr(rc,__LINE__,u_FILE_u)) return ! define time variables - call med_io_write(hist_file, iam, time_units, calendar, days_since, & + call med_io_write(auxfile%histfile, iam, time_units, calendar, days_since, & nt=auxfile%nt, tbnds=auxfile%tbnds, whead=.true., wdata=.false., file_ind=nfile_index, 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(hist_file, iam, is_local%wrap%FBimp(ncomp,ncomp), & + call med_io_write(auxfile%histfile, iam, is_local%wrap%FBimp(ncomp,ncomp), & nx=nx, ny=ny, nt=auxfile%nt, whead=.true., wdata=.false., pre=trim(compname(ncomp))//'Imp', & - flds=auxfile%flds, file_ind=nfile_index, rc=rc) + flds=auxfile%flds, file_ind=nfile_index, use_float=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! end definition phase - call med_io_enddef(hist_file, file_ind=nfile_index) + call med_io_enddef(auxfile%histfile, file_ind=nfile_index) end if ! Write time variables for time nt - call med_io_write(hist_file, iam, time_units, calendar, days_since, & + call med_io_write(auxfile%histfile, iam, time_units, calendar, days_since, & nt=auxfile%nt, tbnds=auxfile%tbnds, whead=.false., wdata=.true., file_ind=nfile_index, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Write data variables for time nt - call med_io_write(hist_file, iam, is_local%wrap%FBimp(ncomp,ncomp), & - nx=nx, ny=ny, nt=auxfile%nt, whead=.false., wdata=.true., pre=trim(compname(ncomp))//'Imp', & - flds=auxfile%flds, file_ind=nfile_index, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (auxfile%useavg) then + call med_io_write(auxfile%histfile, iam, auxfile%FBaccum, & + nx=nx, ny=ny, nt=auxfile%nt, whead=.false., wdata=.true., pre=trim(compname(ncomp))//'Imp', & + flds=auxfile%flds, file_ind=nfile_index, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_reset(auxfile%FBaccum, value=czero, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call med_io_write(auxfile%histfile, iam, is_local%wrap%FBimp(ncomp,ncomp), & + nx=nx, ny=ny, nt=auxfile%nt, whead=.false., wdata=.true., pre=trim(compname(ncomp))//'Imp', & + flds=auxfile%flds, file_ind=nfile_index, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if ! Close file if (auxfile%nt == auxfile%ntperfile) then - call med_io_close(hist_file, iam, file_ind=nfile_index, rc=rc) + call med_io_close(auxfile%histfile, iam, file_ind=nfile_index, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return auxfile%nt = 0 end if @@ -952,7 +1065,7 @@ subroutine med_phases_history_setauxflds(str, auxflds, rc) valid = .false. end if if (.not. valid) then - write(logunit,*) "ERROR: invalid list = ",trim(str) + if (mastertask) write(logunit,*) "ERROR: invalid list = ",trim(str) call ESMF_LogWrite("ERROR: invalid list = "//trim(str), ESMF_LOGMSG_INFO) rc = ESMF_FAILURE return @@ -994,4 +1107,37 @@ subroutine med_phases_history_setauxflds(str, auxflds, rc) end subroutine med_phases_history_setauxflds + !=============================================================================== + subroutine med_phases_history_ymds2rday_offset(currtime, rdays_offset, & + years_offset, months_offset, days_offset, seconds_offset, rc) + + ! Given the current time and optional year, month, day and seconds offsets + ! from the current time: Return an offset from the current time given in fractional days. + ! For example, if day_offset = -2 and seconds_offset = -21600, rday_offset will be -2.25. + ! One or more of the following optional arguments should be provided: + + ! input/output variables + type(ESMF_Time) , intent(in) :: currtime ! current time + real(r8) , intent(out) :: rdays_offset ! offset from current time in fractional days + integer , intent(in), optional :: years_offset ! number of years offset from current time + integer , intent(in), optional :: months_offset ! number of months offset from current time + integer , intent(in), optional :: days_offset ! number of days offset from current time + integer , intent(in), optional :: seconds_offset ! number of seconds offset from current time + integer , intent(out) :: rc + + ! local variables + type(ESMF_TimeInterval) :: timeinterval + !--------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_TimeIntervalSet(timeinterval=timeinterval, startTime=currtime, & + YY=years_offset, MM=months_offset, D=days_offset, S=seconds_offset, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_TimeIntervalGet(timeinterval=timeinterval, d_r8=rdays_offset, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine med_phases_history_ymds2rday_offset + end module med_phases_history_mod From 8e8ae931f41424939be4848e2fefa8d900e877d0 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 7 Sep 2020 15:28:18 -0600 Subject: [PATCH 11/61] added alarms to trigger aux file updates --- cime_config/namelist_definition_drv.xml | 16 ++-- mediator/med_io_mod.F90 | 21 ++--- mediator/med_phases_history_mod.F90 | 119 +++++++++++++++++------- mediator/med_time_mod.F90 | 5 + 4 files changed, 103 insertions(+), 58 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index a790e6c0d..00ddca113 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -1359,7 +1359,7 @@ - + char @@ -1430,7 +1430,7 @@ - + char @@ -1501,7 +1501,7 @@ - + char @@ -1572,7 +1572,7 @@ - + char @@ -1643,7 +1643,7 @@ - + char @@ -1736,7 +1736,7 @@ Auxiliary coupler a2x precipitation history output every 3 hours - Faxa_bcph:Faxa_ocph:Faxa_dstwet:Faxa_dstdry:Sa_co2prog:Sa_co2diag + all @@ -1744,10 +1744,10 @@ aux_hist MED_attributes - Auxiliary coupler a2x instantaneous history output every hour. + Auxiliary coupler l2x instantaneous history output every mediator coupling interval - 86400 + -999 diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index 57acbcd8b..eaebb6570 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -209,14 +209,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) @@ -233,9 +231,7 @@ 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 @@ -243,10 +239,10 @@ subroutine med_io_wopen(filename, vm, iam, clobber, file_ind, model_doi_url) elseif (trim(wfilename(lfile_ind)) /= trim(filename)) then ! filename is open, better match open filename if (iam==0) then - write(logunit,*) subname,' different filename currently open ',trim(filename) - write(logunit,*) subname,' different wfilename currently open ',trim(wfilename(lfile_ind)) + 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(subname//'different file currently open '//trim(filename), ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//'different file currently open '//trim(filename), ESMF_LOGMSG_INFO) rc = ESMF_FAILURE return @@ -280,7 +276,6 @@ subroutine med_io_close(filename, iam, file_ind, rc) lfile_ind = 0 if (present(file_ind)) lfile_ind=file_ind - write(6,*)'DEBUG: lfile_ind = ',lfile_ind if (.not. pio_file_is_open(io_file(lfile_ind))) then ! filename not open, just return @@ -294,7 +289,7 @@ subroutine med_io_close(filename, iam, file_ind, rc) write(logunit,*) subname,' different wfilename and filename currently open, aborting ' write(logunit,*) 'filename = ',trim(filename) write(logunit,*) 'wfilename = ',trim(wfilename(lfile_ind)) - write(logunit,*) 'lfile_ind = ',lfile_ind + write(logunit,*) 'lfile_ind = ',lfile_ind end if call ESMF_LogWrite(subname//'different file currently open, aborting '//trim(filename), ESMF_LOGMSG_INFO) rc = ESMF_FAILURE @@ -611,13 +606,11 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & ! Determine field name if (present(flds)) then itemc = trim(flds(k)) - write(6,*)'DEBUG: using flds itemc = ',trim(itemc) else itemc = trim(fieldNameList(k)) end if ! Determine rank of field with name itemc - write(6,*)' DEBUG: itemc= ',trim(itemc) call ESMF_FieldBundleGet(FB, itemc, field=lfield, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldGet(lfield, rank=rank, rc=rc) diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 6c59b58e3..fbf37e1c3 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -24,13 +24,14 @@ module med_phases_history_mod use ESMF , only : ESMF_Calendar use ESMF , only : 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_Alarm, ESMF_AlarmCreate + use ESMF , only : ESMF_AlarmIsRinging, ESMF_AlarmRingerOff, ESMF_AlarmGet use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet use ESMF , only : ESMF_FieldBundleIsCreated, ESMF_FieldBundleRemove 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(-), operator(/=) + use ESMF , only : operator(==), operator(-), operator(+), operator(/=), operator(<=) use NUOPC , only : NUOPC_CompAttributeGet use NUOPC_Model , only : NUOPC_ModelGet use esmFlds , only : compatm, complnd, compocn, compice, comprof, compglc, ncomps, compname @@ -81,17 +82,18 @@ module med_phases_history_mod integer, parameter :: maxfiles = 20 integer :: nfiles = 0 type, public :: auxfile_type - integer :: ncomp ! component index - character(CS) :: auxname ! name for history file creation - character(CL) :: histfile ! current history file name - character(CS), allocatable :: flds(:) ! array of aux field names - integer :: deltat ! interval to write out aux data in seconds - integer :: ntperfile ! maximum number of time samples per file - integer :: nt = 0 ! time in file - real(r8) :: tbnds(2) ! CF1.0 time bounds - logical :: useavg ! if true, time average, otherwise instantaneous - type(ESMF_FieldBundle) :: FBaccum ! field bundle for time averaging - integer :: accumcnt ! field bundle accumulation counter + integer :: ncomp ! component index + character(CS) :: auxname ! name for history file creation + character(CL) :: histfile = '' ! current history file name + character(CS), allocatable :: flds(:) ! array of aux field names + integer :: deltat ! interval to write out aux data in seconds + character(CS) :: alarmname ! name of write alarm + integer :: ntperfile ! maximum number of time samples per file + integer :: nt = 0 ! time in file + real(r8) :: tbnds(2) ! CF1.0 time bounds + logical :: useavg ! if true, time average, otherwise instantaneous + type(ESMF_FieldBundle) :: FBaccum ! field bundle for time averaging + integer :: accumcnt ! field bundle accumulation counter end type auxfile_type type(auxfile_type) :: auxfiles(maxfiles) @@ -605,19 +607,24 @@ subroutine med_phases_history_write_aux(gcomp, rc) integer, intent(out) :: rc ! local variables - type(InternalState) :: is_local - character(CL) :: auxflds - character(CS) :: cvalue - integer :: n,n1 - integer :: nfcnt - integer :: nfile - logical :: isPresent - logical :: isSet - character(CS) :: prefix - logical :: found - integer :: fieldcount - character(CS), allocatable :: fieldNameList(:) - logical :: first_time = .true. + type(InternalState) :: is_local + type(ESMF_Clock) :: mclock ! mediator clock + type(ESMF_TimeInterval) :: alarmInterval ! alarm interval + type(ESMF_Time) :: nextAlarm ! next restart alarm time + type(ESMF_Alarm) :: alarm ! new alarm + type(ESMF_Time) :: currTime ! current Time + character(CL) :: auxflds ! colon delimited string of field names + character(CS) :: cvalue ! temporary for input attributes + integer :: n,n1 ! field counter + integer :: nfcnt ! file counter + integer :: nfile ! file counter + logical :: isPresent ! is attribute present + logical :: isSet ! is attribute set + character(CS) :: prefix ! prefix for aux history file name + logical :: found ! temporary logical + integer :: fieldcount + character(CS), allocatable :: fieldNameList(:) + logical :: first_time = .true. character(len=*), parameter :: subname='(med_phases_history_write_aux)' !--------------------------------------- rc = ESMF_SUCCESS @@ -631,6 +638,12 @@ subroutine med_phases_history_write_aux(gcomp, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Get the mediator clock and the current time + call NUOPC_ModelGet(gcomp, modelClock=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 + nfcnt = 0 do nfile = 1,maxfiles write(prefix,'(a,i0)') 'histaux_atm2med_file',nfile @@ -647,9 +660,6 @@ subroutine med_phases_history_write_aux(gcomp, rc) auxfiles(nfcnt)%ncomp = compatm call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_auxname', value=auxfiles(nfcnt)%auxname, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_deltat', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) auxfiles(nfcnt)%deltat call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_ntperfile', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) auxfiles(nfcnt)%ntperfile @@ -659,10 +669,32 @@ subroutine med_phases_history_write_aux(gcomp, rc) read(cvalue,*) auxfiles(nfcnt)%useavg call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_flds', value=auxflds, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Set history alarm for this file - advance nextAlarm so it won't ring on the first timestep + call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_deltat', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) auxfiles(nfcnt)%deltat + call ESMF_TimeIntervalSet(AlarmInterval, s=auxfiles(nfcnt)%deltat, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + nextAlarm = currtime - AlarmInterval + do while (nextAlarm <= currtime) + nextAlarm = nextAlarm + AlarmInterval + enddo + write(auxfiles(nfcnt)%alarmname,'(a,i0)') 'alarm_auxhist_'//trim(auxfiles(nfcnt)%auxname)//'_', & + auxfiles(nfcnt)%deltat + if (mastertask) then + write(logunit,'(a)') trim(subname) //' creating auxiliary history alarm '//& + trim(auxfiles(nfcnt)%alarmname) + end if + alarm = ESMF_AlarmCreate( name=auxfiles(nfcnt)%alarmname, clock=mclock, & + ringTime=nextAlarm, ringInterval=alarmInterval, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Translate the colon deliminted string (auxflds) into a character array (fieldnamelist) ! Note that the following call allocates the memory for fieldnamelist call med_phases_history_setauxflds(auxflds, fieldnamelist, rc) - ! Remove all fields from auxfiles(nfcnt)%flds that are not in FBImp(compatm,compatm) + ! Remove all fields from fieldnamelist that are not in FBImp(compatm,compatm) fieldCount = size(fieldnamelist) do n = 1,fieldcount if (.not. FB_fldchk(is_local%wrap%FBImp(compatm,compatm), trim(fieldnamelist(n)), rc)) then @@ -672,10 +704,14 @@ subroutine med_phases_history_write_aux(gcomp, rc) fieldCount = fieldCount - 1 end if end do + + ! Create auxfiles(nfcnt)%flds array allocate(auxfiles(nfcnt)%flds(fieldcount)) do n = 1,fieldcount auxfiles(nfcnt)%flds(n) = trim(fieldnamelist(n)) end do + + ! Deallocate memory from fieldnamelist deallocate(fieldnamelist) ! this was allocated in med_phases_history_setauxflds ! Create FBaccum if averaging is on @@ -752,14 +788,15 @@ subroutine med_phases_history_write_aux_file(gcomp, case_name, inst_tag, nfile_i type(InternalState) :: is_local type(ESMF_VM) :: vm type(ESMF_Clock) :: mclock + type(ESMF_Alarm) :: alarm type(ESMF_Time) :: starttime type(ESMF_Time) :: currtime type(ESMF_Calendar) :: calendar ! calendar type type(ESMF_TimeInterval) :: timediff ! diff between current and start time character(CS) :: timestr ! yr-mon-day-sec string character(CL) :: time_units ! units of time variable - character(CL) :: hist_file ! name of output file real(r8) :: days_since ! Time interval since reference time + real(r8) :: avg_time ! Time coordinate output integer :: nx,ny ! global grid size logical :: whead,wdata ! for writing restart/history cdf files logical :: write_now ! if true, write time sample to file @@ -800,8 +837,17 @@ subroutine med_phases_history_write_aux_file(gcomp, case_name, inst_tag, nfile_i nx = is_local%wrap%nx(ncomp) ny = is_local%wrap%ny(ncomp) - ! Determine if write history data - write_now = (currtime /= starttime .and. mod(sec,auxfile%deltat) == 0) + write_now = .false. + call ESMF_ClockGetAlarm(mclock, alarmname=trim(auxfile%alarmname), alarm=alarm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (ESMF_AlarmIsRinging(alarm, rc=rc)) then + if (mastertask .and. dbug_flag > 1) then + write(logunit,'(a)') trim(subname) // 'alarm '//trim(auxfile%alarmname) //' is ringing' + end if + write_now = .true. + call ESMF_AlarmRingerOff( alarm, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if ! Do accumulation if needed if (auxfile%useavg) then @@ -835,7 +881,8 @@ subroutine med_phases_history_write_aux_file(gcomp, case_name, inst_tag, nfile_i days_since = diff_day + diff_sec/real(SecPerDay,R8) auxfile%tbnds(2) = days_since - ! Create history file + ! Determine time coordinate value + avg_time = 0.5_r8 * (auxfile%tbnds(1) + auxfile%tbnds(2)) ! Write header if (auxfile%nt == 1) then @@ -860,7 +907,7 @@ subroutine med_phases_history_write_aux_file(gcomp, case_name, inst_tag, nfile_i if (ChkErr(rc,__LINE__,u_FILE_u)) return ! define time variables - call med_io_write(auxfile%histfile, iam, time_units, calendar, days_since, & + call med_io_write(auxfile%histfile, iam, time_units, calendar, avg_time, & nt=auxfile%nt, tbnds=auxfile%tbnds, whead=.true., wdata=.false., file_ind=nfile_index, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -876,7 +923,7 @@ subroutine med_phases_history_write_aux_file(gcomp, case_name, inst_tag, nfile_i end if ! Write time variables for time nt - call med_io_write(auxfile%histfile, iam, time_units, calendar, days_since, & + call med_io_write(auxfile%histfile, iam, time_units, calendar, avg_time, & nt=auxfile%nt, tbnds=auxfile%tbnds, whead=.false., wdata=.true., file_ind=nfile_index, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/mediator/med_time_mod.F90 b/mediator/med_time_mod.F90 index b6c9d653b..dc65ae666 100644 --- a/mediator/med_time_mod.F90 +++ b/mediator/med_time_mod.F90 @@ -17,6 +17,7 @@ module med_time_mod use ESMF , only : operator(<=), operator(>), operator(==) 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 @@ -236,6 +237,10 @@ subroutine med_time_alarmInit( clock, alarm, option, & enddo endif + if (mastertask) then + write(logunit,*)trim(subname) //' creating alarm '// trim(alarmname) + end if + alarm = ESMF_AlarmCreate( name=lalarmname, clock=clock, ringTime=NextAlarm, & ringInterval=AlarmInterval, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return From 69291a379f93d18ffa5cca07fbe66166ea9dcaa0 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 8 Sep 2020 09:44:45 -0600 Subject: [PATCH 12/61] updates for getting average history files to work --- cime_config/namelist_definition_drv.xml | 4163 +++++++++++------------ mediator/med_phases_history_mod.F90 | 2084 ++++++++---- 2 files changed, 3360 insertions(+), 2887 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 00ddca113..d7e0d170d 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -107,3553 +107,3407 @@ - - - + + + - - char - expdef - DRIVER_attributes - cesm,ufs - cime model + + integer + cime_pes + PELAYOUT_attributes + + The number of model instances in the executable + - cesm - ufs + $NINST - - char - expdef - DRIVER_attributes + + integer + cime_pes + PELAYOUT_attributes - location of timing output. + the number of mpi tasks assigned to the atm components. + set by NTASKS_ATM in env_configure.xml. - ./timing + $NTASKS_ATM - - char - expdef - DRIVER_attributes + + integer + cime_pes + PELAYOUT_attributes - location of timing checkpoint output. + the number of threads per mpi task for the atm component. + set by NTHRDS_ATM in env_configure.xml. - ./timing/checkpoints + $NTHRDS_ATM - - - - - - - - - - - - - - - real - control - DRIVER_attributes + + integer + cime_pes + PELAYOUT_attributes - Wall time limit for run - default: -1.0 + the global mpi task rank of the root processor assigned to the atm component. + set by ROOTPE_ATM in env_configure.xml. - -1.0 + $ROOTPE_ATM - - char - control - DRIVER_attributes - day,month,year + + integer + cime_pes + PELAYOUT_attributes - Force stop at the next month, day, etc when wall_time_limit is hit - default: month + the mpi global processors stride associated with the mpi tasks for the atm component. + set by PSTRID_ATM in env_configure.xml. - month + $PSTRID_ATM - - - - - - - - - - - - - - logical - performance - DRIVER_attributes + + integer + cime_pes + PELAYOUT_attributes - turn on run time control of threading per pe per component by the driver - default: false + the number of mpi tasks assigned to the lnd components. + set by NTASKS_LND in env_configure.xml. - $DRV_THREADING + $NTASKS_LND - - logical - performance - DRIVER_attributes + + integer + cime_pes + PELAYOUT_attributes - default: .false. + the number of threads per mpi task for the lnd component. + set by NTHRDS_LND in env_configure.xml. - $COMP_RUN_BARRIERS + $NTHRDS_LND - - logical - reprosum - DRIVER_attributes + + integer + cime_pes + PELAYOUT_attributes - Use faster method for reprosum, but one where reproducibility is not always guaranteed. - default: .false. + the global mpi task rank of the root processor assigned to the lnd component. + set by ROOTPE_LND in env_configure.xml. - .false. + $ROOTPE_LND - - real - reprosum - DRIVER_attributes + + integer + cime_pes + PELAYOUT_attributes - Tolerance for relative error - default: -1.0e-8 + the mpi global processors stride associated with the mpi tasks for the lnd component. + set by PSTRID_LND in env_configure.xml. - -1.0e-8 + $PSTRID_LND - - logical - reprosum - DRIVER_attributes + + integer + cime_pes + PELAYOUT_attributes - Recompute with non-scalable algorithm if reprosum_diffmax is exceeded. - default: .false. + the number of mpi tasks assigned to the ice components. + set by NTASKS_ICE in env_configure.xml. - .false. + $NTASKS_ICE - - char - expdef - DRIVER_attributes + + integer + cime_pes + PELAYOUT_attributes - Ending suffix "postfix" for output log files. + the number of threads per mpi task for the ice component. + set by NTHRDS_ICE in env_configure.xml. - .log + $NTHRDS_ICE - - char - expdef - DRIVER_attributes + + integer + cime_pes + PELAYOUT_attributes - Root for output log files. + the global mpi task rank of the root processor assigned to the ice component. + set by ROOTPE_ICE in env_configure.xml. - ./ + $ROOTPE_ICE - - real - expdef - DRIVER_attributes + + integer + cime_pes + PELAYOUT_attributes - Abort if cplstep time exceeds this value + the mpi global processors stride associated with the mpi tasks for the ice component. + set by PSTRID_ICE in env_configure.xml. - 0. + $PSTRID_ICE - - char - nuopc - nuopc_var + + integer + cime_pes + PELAYOUT_attributes - Model components that are active + the number of mpi tasks assigned to the ocn components. + set by NTASKS_OCN in env_configure.xml. - ATM OCN ICE LND ROF GLC WAV MED + $NTASKS_OCN - - char - expdef - DRIVER_attributes + + integer + cime_pes + PELAYOUT_attributes - Driver restart pointer file to initialize time info + the number of threads per mpi task for the ocn component. + set by NTHRDS_OCN in env_configure.xml. - rpointer.cpl + $NTHRDS_OCN - - - - - - char - wv_sat - DRIVER_attributes - GoffGratch,MurphyKoop,Bolton,Flatau + + integer + cime_pes + PELAYOUT_attributes - Type of water vapor saturation vapor pressure scheme employed. 'GoffGratch' for - Goff and Gratch (1946); 'MurphyKoop' for Murphy and Koop (2005); 'Bolton' for - Bolton (1980); 'Flatau' for Flatau, Walko, and Cotton (1992). - Default: GoffGratch + the global mpi task rank of the root processor assigned to the ocn component. + set by ROOTPE_OCN in env_configure.xml. - GoffGratch + $ROOTPE_OCN - - real - wv_sat - DRIVER_attributes + + integer + cime_pes + PELAYOUT_attributes - Width of the liquid-ice transition range in mixed-phase water saturation vapor - pressure calculations. The range always ends at 0 degrees Celsius, so this - variable only affects the start of the transition. - Default: 20K - WARNING: CAM is tuned to the default value of this variable. Because it affects - so many different parameterizations, changes to this variable may require a - significant retuning of CAM's cloud physics to give reasonable results. + the mpi global processors stride associated with the mpi tasks for the ocn component. + set by PSTRID_OCN in env_configure.xml. default: 1 - 20.0D0 + $PSTRID_OCN - - logical - wv_sat - DRIVER_attributes + + integer + cime_pes + PELAYOUT_attributes - Whether or not to produce lookup tables at init time to use as a cache for - saturation vapor pressure. - Default: .false. + the number of mpi tasks assigned to the glc components. + set by NTASKS_GLC in env_configure.xml. - .false. + $NTASKS_GLC - - real - wv_sat - DRIVER_attributes + + integer + cime_pes + PELAYOUT_attributes - Temperature resolution of saturation vapor pressure lookup tables in Kelvin. - (This is only used if wv_sat_use_tables is .true.) - Default: 1.0 + the number of threads per mpi task for the glc component. + set by NTHRDS_GLC in env_configure.xml. - 1.0D0 + $NTHRDS_GLC - - - - - - char - orbital - ALLCOMP_attributes - fixed_year,variable_year,fixed_parameters + + integer + cime_pes + PELAYOUT_attributes - orbital model setting. this sets how the orbital mode will be - configured. - "fixed_year" uses the orb_iyear and other orb inputs are ignored. In - this mode, the orbital parameters are constant and based on the year. - "variable_year" uses the orb_iyear and orb_iyear_align. In this mode, - the orbital parameters vary as the model year advances and the model - year orb_iyear_align has the equivalent orbital year of orb_iyear. - "fixed_parameters" uses the orb_eccen, orb_mvelp, and orb_obliq to set - the orbital parameters which then remain constant through the model - integration. [fixed_year, variable_year, fixed_parameters] (default: 'fixed_year'.) + the global mpi task rank of the root processor assigned to the glc component. + set by ROOTPE_GLC in env_configure.xml. - fixed_year - variable_year + $ROOTPE_GLC - + integer - orbital - ALLCOMP_attributes + cime_pes + PELAYOUT_attributes - model year associated with orb_iyear when orb_mode is variable_year. (default: 1990) + the mpi global processors stride associated with the mpi tasks for the glc component. + set by PSTRID_GLC in env_configure.xml. - 1990 - 1850 - 2000 - 1850 + $PSTRID_GLC - + integer - orbital - ALLCOMP_attributes + cime_pes + PELAYOUT_attributes - year of orbit, used when orb_mode is fixed_year or variable_year. (default: 1990) + the number of mpi tasks assigned to the wav components. + set by NTASKS_WAV in env_configure.xml. - 1990 - 1850 - 2000 - 1850 + $NTASKS_WAV - - real - orbital - ALLCOMP_attributes + + integer + cime_pes + PELAYOUT_attributes - eccentricity of orbit, used when orb_mode is fixed_parameters. - default: SHR_ORB_UNDEF_REAL (1.e36) (Not currently used in build-namelist) + the number of threads per mpi task for the wav component. + set by NTHRDS_WAV in env_configure.xml. - 1.e36 + $NTHRDS_WAV - - real - orbital - ALLCOMP_attributes + + integer + cime_pes + PELAYOUT_attributes - location of vernal equinox in longitude degrees, used when orb_mode is fixed_parameters. - default: SHR_ORB_UNDEF_REAL (1.e36)(Not currently used in build-namelist) + the global mpi task rank of the root processor assigned to the wav component. + set by ROOTPE_WAV in env_configure.xml. - 1.e36 + $ROOTPE_WAV - - real - orbital - ALLCOMP_attributes + + integer + cime_pes + PELAYOUT_attributes - obliquity of orbit in degrees, used when orb_mode is fixed_parameters. - default: SHR_ORB_UNDEF_REAL (1.e36) (Not currently used in build-namelist) + the mpi global processors stride associated with the mpi tasks for the wav component. + set by PSTRID_WAV in env_configure.xml. - 1.e36 + $PSTRID_WAV - - - - - - char - nuopc - ALLCOMP_attributes + + integer + cime_pes + PELAYOUT_attributes + + the number of mpi tasks assigned to the lnd components. + set by NTASKS_LND in env_configure.xml. + - cesm + $NTASKS_ROF - - char - nuopc - ALLCOMP_attributes + + + integer + cime_pes + PELAYOUT_attributes + + the number of threads per mpi task for the lnd component. + set by NTHRDS_ROF in env_configure.xml. + - $COMP_ATM + $NTHRDS_ROF - - char - nuopc - ALLCOMP_attributes + + + integer + cime_pes + PELAYOUT_attributes + + the global mpi task rank of the root processor assigned to the lnd component. + set by ROOTPE_LND in env_configure.xml. + - $COMP_OCN + $ROOTPE_ROF - - char - nuopc - ALLCOMP_attributes + + + integer + cime_pes + PELAYOUT_attributes + + the mpi global processors stride associated with the mpi tasks for the lnd component. + set by PSTRID_LND in env_configure.xml. + - $COMP_ICE + $PSTRID_ROF - - char - nuopc - ALLCOMP_attributes + + + integer + cime_pes + PELAYOUT_attributes + + the number of mpi tasks assigned to the esp components. + set by NTASKS_ESP in env_configure.xml. + - $COMP_ROF - srof + $NTASKS_ESP - - char - nuopc - ALLCOMP_attributes + + + integer + cime_pes + PELAYOUT_attributes + + the number of threads per mpi task for the esp component. + set by NTHRDS_ESP in env_configure.xml. + - $COMP_LND + $NTHRDS_ESP - - char - nuopc - ALLCOMP_attributes + + + integer + cime_pes + PELAYOUT_attributes + + the global mpi task rank of the root processor assigned to the esp component. + set by ROOTPE_ESP in env_configure.xml. + - $COMP_GLC + $ROOTPE_ESP - - char - nuopc - ALLCOMP_attributes + + + integer + cime_pes + PELAYOUT_attributes + + the mpi global processors stride associated with the mpi tasks for the esp component. + set by PSTRID_ESP in env_configure.xml. + - $COMP_WAV + $PSTRID_ESP - - logical - nuopc - ALLCOMP_attributes + + integer + cime_pes + PELAYOUT_attributes + + the number of mpi tasks assigned to the cpl components. + set by NTASKS_CPL in env_configure.xml. + - true + $NTASKS_CPL - if true, mediator is present in run - - char - expdef - ALLCOMP_attributes + + integer + cime_pes + PELAYOUT_attributes - Model version + the number of threads per mpi task for the cpl component. + set by NTHRDS_CPL in env_configure.xml. - unknown + $NTHRDS_CPL - - char - expdef - ALLCOMP_attributes - startup,branch,continue + + integer + cime_pes + PELAYOUT_attributes - mode to start the run up, [startup,branch,continue], - automatically derived from RUN_TYPE in env_run.xml + the global mpi task rank of the root processor assigned to the cpl component. + set by ROOTPE_CPL in env_configure.xml. - startup - startup - branch - continue - continue - continue + $ROOTPE_CPL - - logical - expdef - DRIVER_attributes + + integer + cime_pes + PELAYOUT_attributes - only have the mediator reads the restart file regardless of start type + the mpi global processors stride associated with the mpi tasks for the cpl component. + set by PSTRID_CPL in env_configure.xml. + + $PSTRID_CPL + - + char - expdef - ALLCOMP_attributes + cime_pes + PELAYOUT_attributes - case name. + 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. - $CASE + $ESMF_LOGFILE_KIND - + + + + + char expdef - ALLCOMP_attributes - - case description. - + DRIVER_attributes + cesm,ufs + cime model - $CASESTR + cesm + ufs - + char expdef - seq_infodata_inparm + DRIVER_attributes - model doi url + location of timing output. - $MODEL_DOI_URL + ./timing - + char expdef - ALLCOMP_attributes + DRIVER_attributes - username documentation + location of timing checkpoint output. - $USER + ./timing/checkpoints - - char - expdef - ALLCOMP_attributes + + + + + + + + + + + + + + + real + control + DRIVER_attributes - hostname information, + Wall time limit for run + default: -1.0 - $MACH + -1.0 - - logical - expdef - ALLCOMP_attributes + + char + control + DRIVER_attributes + day,month,year - Allow same branch casename as reference casename. If $CASE and $REFCASE are the same and the start_type is - not startup, then the value of brnch_retain_casename is set to .true. + Force stop at the next month, day, etc when wall_time_limit is hit + default: month - .false. + month - + + + + + + + + + + + + + logical - expdef - ALLCOMP_attributes + performance + DRIVER_attributes - Perpetual flag + turn on run time control of threading per pe per component by the driver + default: false - .false. + $DRV_THREADING - - integer - expdef - ALLCOMP_attributes + + logical + performance + DRIVER_attributes - Perpetual date + default: .false. - -999 + $COMP_RUN_BARRIERS - + logical - single_column - ALLCOMP_attributes + reprosum + DRIVER_attributes - turns on single column mode. set by PTS_MODE in env_case.xml, default: false + Use faster method for reprosum, but one where reproducibility is not always guaranteed. + default: .false. .false. - .true. - + real - single_column - ALLCOMP_attributes + reprosum + DRIVER_attributes - grid point latitude associated with single column mode. - if set to -999, ignore this value + Tolerance for relative error + default: -1.0e-8 - -999. - $PTS_LAT + -1.0e-8 - - real - single_column - ALLCOMP_attributes + + logical + reprosum + DRIVER_attributes - grid point longitude associated with single column mode. - set by PTS_LON in env_run.xml. + Recompute with non-scalable algorithm if reprosum_diffmax is exceeded. + default: .false. - -999. - $PTS_LON + .false. - - logical + + char expdef - ALLCOMP_attributes - - true => turn on aquaplanet mode in cam - - - - - logical - flds - ALLCOMP_attributes + DRIVER_attributes - .true. if select per ice thickness category fields are passed to the ocean. - Set by the xml variable CPL_I2O_PER_CAT in env_run.xml + Ending suffix "postfix" for output log files. - $CPL_I2O_PER_CAT + .log - + char - control - ALLCOMP_attributes - Freezing point calculation for salt water. + expdef + DRIVER_attributes + + Root for output log files. + - $TFREEZE_SALTWATER_OPTION + ./ - - - - - + real - control - ALLCOMP_attributes + expdef + DRIVER_attributes - Iterate atmocn flux calculation to this % difference - Setting this to zero will always do flux_max_iteration + Abort if cplstep time exceeds this value - 0.01 - 0.0 + 0. - - integer - control - ALLCOMP_attributes + + char + nuopc + nuopc_var - Iterate atmocn flux calculation a max of this value + Model components that are active - 5 + ATM OCN ICE LND ROF GLC WAV MED - - logical - control - ALLCOMP_attributes + + char + expdef + DRIVER_attributes - if true use Mahrt and Sun 1995,MWR modification to surface flux calculation + Driver restart pointer file to initialize time info - .true. - .false. - .false. + rpointer.cpl - + - + char - control - MED_attributes + wv_sat + DRIVER_attributes + GoffGratch,MurphyKoop,Bolton,Flatau - Type of coupling mode to use in the mediator + Type of water vapor saturation vapor pressure scheme employed. 'GoffGratch' for + Goff and Gratch (1946); 'MurphyKoop' for Murphy and Koop (2005); 'Bolton' for + Bolton (1980); 'Flatau' for Flatau, Walko, and Cotton (1992). + Default: GoffGratch - $COUPLING_MODE + GoffGratch - - char - control - MED_attributes - on,off,on_if_glc_coupled_fluxes + + real + wv_sat + DRIVER_attributes - Whether to renormalize the surface mass balance (smb) sent from lnd to glc so that the - global integral on the glc grid agrees with the global integral on the lnd grid. - - Unlike most fluxes, smb is remapped with bilinear rather than conservative mapping weights, - so this option is needed for conservation. However, conservation is not required in many - cases, since we often run glc as a diagnostic (one-way-coupled) component. - - Allowable values are: - 'on': always do this renormalization - 'off': never do this renormalization (see WARNING below) - 'on_if_glc_coupled_fluxes': Determine at runtime whether to do this renormalization. - Does the renormalization if we're running a two-way-coupled glc that sends fluxes - to other components (which is the case where we need conservation). - Does NOT do the renormalization if we're running a one-way-coupled glc, or if - we're running a glc-only compset (T compsets). - (In these cases, conservation is not important.) - - Only used if running with a prognostic GLC component. - - WARNING: Setting this to 'off' will break conservation when running with an - evolving, two-way-coupled glc. + Width of the liquid-ice transition range in mixed-phase water saturation vapor + pressure calculations. The range always ends at 0 degrees Celsius, so this + variable only affects the start of the transition. + Default: 20K + WARNING: CAM is tuned to the default value of this variable. Because it affects + so many different parameterizations, changes to this variable may require a + significant retuning of CAM's cloud physics to give reasonable results. - on_if_glc_coupled_fluxes - off + 20.0D0 - - integer - expdef - MED_attributes + + logical + wv_sat + DRIVER_attributes - Level of debug output, 0=minimum, 1=normal, 2=more, 3=too much (default: 1) + Whether or not to produce lookup tables at init time to use as a cache for + saturation vapor pressure. + Default: .false. - $INFO_DBUG + .false. - - char - mapping - ATM_attributes + + real + wv_sat + DRIVER_attributes - MESH description of atm grid + Temperature resolution of saturation vapor pressure lookup tables in Kelvin. + (This is only used if wv_sat_use_tables is .true.) + Default: 1.0 - $ATM_DOMAIN_MESH + 1.0D0 - + + + + + char - mapping - ATM_attributes + orbital + ALLCOMP_attributes + fixed_year,variable_year,fixed_parameters - DOMAIN description of atm grid + orbital model setting. this sets how the orbital mode will be + configured. + "fixed_year" uses the orb_iyear and other orb inputs are ignored. In + this mode, the orbital parameters are constant and based on the year. + "variable_year" uses the orb_iyear and orb_iyear_align. In this mode, + the orbital parameters vary as the model year advances and the model + year orb_iyear_align has the equivalent orbital year of orb_iyear. + "fixed_parameters" uses the orb_eccen, orb_mvelp, and orb_obliq to set + the orbital parameters which then remain constant through the model + integration. [fixed_year, variable_year, fixed_parameters] (default: 'fixed_year'.) - $ATM_DOMAIN_PATH/$ATM_DOMAIN_FILE + fixed_year + variable_year - - char - mapping - LND_attributes + + integer + orbital + ALLCOMP_attributes - MESH description of lnd grid + model year associated with orb_iyear when orb_mode is variable_year. (default: 1990) - $LND_DOMAIN_MESH + 1990 + 1850 + 2000 + 1850 - - char - mapping - LND_attributes + + integer + orbital + ALLCOMP_attributes - DOMAIN description of lnd grid + year of orbit, used when orb_mode is fixed_year or variable_year. (default: 1990) - $LND_DOMAIN_PATH/$LND_DOMAIN_FILE + 1990 + 1850 + 2000 + 1850 - - char - mapping - OCN_attributes + + real + orbital + ALLCOMP_attributes - MESH description of ocn grid + eccentricity of orbit, used when orb_mode is fixed_parameters. + default: SHR_ORB_UNDEF_REAL (1.e36) (Not currently used in build-namelist) - $OCN_DOMAIN_MESH + 1.e36 - - char - mapping - ICE_attributes + + real + orbital + ALLCOMP_attributes - MESH description of ice grid + location of vernal equinox in longitude degrees, used when orb_mode is fixed_parameters. + default: SHR_ORB_UNDEF_REAL (1.e36)(Not currently used in build-namelist) - $ICE_DOMAIN_MESH + 1.e36 - - char - mapping - ROF_attributes + + real + orbital + ALLCOMP_attributes - MESH description of rof grid + obliquity of orbit in degrees, used when orb_mode is fixed_parameters. + default: SHR_ORB_UNDEF_REAL (1.e36) (Not currently used in build-namelist) - $ROF_DOMAIN_MESH + 1.e36 - + + + + + char - mapping - GLC_attributes - - MESH description of glc grid - + nuopc + ALLCOMP_attributes - $GLC_DOMAIN_MESH + cesm - - + char - mapping - WAV_attributes - - MESH description of wav grid - + nuopc + ALLCOMP_attributes - $WAV_DOMAIN_MESH + $COMP_ATM + + + + char + nuopc + ALLCOMP_attributes + + $COMP_OCN + + + + char + nuopc + ALLCOMP_attributes + + $COMP_ICE + + + + char + nuopc + ALLCOMP_attributes + + $COMP_ROF + srof + + + + char + nuopc + ALLCOMP_attributes + + $COMP_LND + + + + char + nuopc + ALLCOMP_attributes + + $COMP_GLC + + + + char + nuopc + ALLCOMP_attributes + + $COMP_WAV - - real - domain_check - MED_attributes - - Error tolerance for differences in fractions in domain checking - default: 1.0e-02 - + + logical + nuopc + ALLCOMP_attributes - $EPS_FRAC + true + if true, mediator is present in run - - real - domain_check - MED_attributes + + char + expdef + ALLCOMP_attributes - Error tolerance for differences in atm/land masks in domain checking - default: 1.0e-13 + Model version - $EPS_AMASK + unknown - - real - domain_check - MED_attributes + + char + expdef + ALLCOMP_attributes + startup,branch,continue - Error tolerance for differences in atm/land lat/lon in domain checking - default: 1.0e-12 + mode to start the run up, [startup,branch,continue], + automatically derived from RUN_TYPE in env_run.xml - $EPS_AGRID + startup + startup + branch + continue + continue + continue - - real - domain_check - MED_attributes + + logical + expdef + DRIVER_attributes - Error tolerance for differences in atm/land areas in domain checking - default: 1.0e-07 + only have the mediator reads the restart file regardless of start type - - $EPS_AAREA - - - real - domain_check - MED_attributes + + char + expdef + ALLCOMP_attributes - Error tolerance for differences in ocean/ice masks in domain checking - default: 1.0e-06 + case name. - $EPS_OMASK + $CASE - - real - domain_check - MED_attributes + + char + expdef + ALLCOMP_attributes - Error tolerance for differences in ocean/ice lon/lat in domain checking - default: 1.0e-2 + case description. - $EPS_OGRID + $CASESTR - - real - domain_check - MED_attributes + + char + expdef + seq_infodata_inparm - Error tolerance for differences in ocean/ice lon/lat in domain checking - default: 1.0e-1 + model doi url - $EPS_OAREA + $MODEL_DOI_URL - - logical - control - MED_attributes + + char + expdef + ALLCOMP_attributes - Only used for C,G compsets: if true, compute albedos to work with daily avg SW down + username documentation - $CPL_ALBAV + $USER - + char - mapping - MED_attributes - ocn,atm,exch + expdef + ALLCOMP_attributes - Grid for atm ocn flux calc (untested) - default: ocn + hostname information, - ocn + $MACH - - real - control - MED_attributes + + logical + expdef + ALLCOMP_attributes - wind gustiness factor + Allow same branch casename as reference casename. If $CASE and $REFCASE are the same and the start_type is + not startup, then the value of brnch_retain_casename is set to .true. - 0.0D0 + .false. - + logical - budget - MED_attributes + expdef + ALLCOMP_attributes - logical that turns on diagnostic budgets, false means budgets will never be written + Perpetual flag - $BUDGETS + .false. - + integer - budget - MED_attributes - 0,1,2,3 + expdef + ALLCOMP_attributes - sets the diagnotics level of the instantaneous budgets. [0,1,2,3], - written only if BUDGETS variable is true - 0=none, - 1=+net summary budgets, - 2=+detailed lnd/ocn/ice component budgets, - 3=+detailed atm budgets - default: 0 + Perpetual date - 0 + -999 - - integer - budget - MED_attributes - 0,1,2,3 + + logical + single_column + ALLCOMP_attributes - sets the diagnotics level of the daily budgets. [0,1,2,3], - written only if do_budgets variable is .true., - 0=none, - 1=+net summary budgets, - 2=+detailed lnd/ocn/ice component budgets, - 3=+detailed atm budgets - default: 0 + turns on single column mode. set by PTS_MODE in env_case.xml, default: false - 0 + .false. + .true. - - integer - expdef - MED_attributes - 0,1,2,3 + + real + single_column + ALLCOMP_attributes - sets the diagnotics level of the monthy budgets. [0,1,2,3], - written only if do_budgets variable is .true., - 0=none, - 1=+net summary budgets, - 2=+detailed lnd/ocn/ice component budgets, - 3=+detailed atm budgets - default: 1 + grid point latitude associated with single column mode. + if set to -999, ignore this value - 1 + -999. + $PTS_LAT - - integer - budget - MED_attributes - 0,1,2,3 + + real + single_column + ALLCOMP_attributes - sets the diagnotics level of the annual budgets. [0,1,2,3], - written only if do_budgets variable is .true., - 0=none, - 1=+net summary budgets, - 2=+detailed lnd/ocn/ice component budgets, - 3=+detailed atm budgets - default: 1 + grid point longitude associated with single column mode. + set by PTS_LON in env_run.xml. - 1 + -999. + $PTS_LON - - integer - budget - MED_attributes - 0,1,2,3 + + logical + expdef + ALLCOMP_attributes - sets the diagnotics level of the longterm budgets written at the end - of the year. [0,1,2,3], - written only if do_budgets variable is .true., - 0=none, - 1=+net summary budgets, - 2=+detailed lnd/ocn/ice component budgets, - 3=+detailed atm budgets, - default: 1 + true => turn on aquaplanet mode in cam - - 1 - - - integer - budget - MED_attributes - 0,1,2,3 + + logical + flds + ALLCOMP_attributes - sets the diagnotics level of the longterm budgets written at the end - of each run. [0,1,2,3], - written only if do_budgets variable is .true., - 0=none, - 1=+net summary budgets, - 2=+detailed lnd/ocn/ice component budgets, - 3=+detailed atm budgets, - default: 0 + .true. if select per ice thickness category fields are passed to the ocean. + Set by the xml variable CPL_I2O_PER_CAT in env_run.xml - 0 + $CPL_I2O_PER_CAT - - - - - - logical - history - MED_attributes - - logical to write an extra initial coupler history file - + + char + control + ALLCOMP_attributes + Freezing point calculation for salt water. - .false. + $TFREEZE_SALTWATER_OPTION - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + char - aux_hist - MED_attributes + expdef + ALLCOMP_attributes - Auxiliary coupler a2x instantaneous history output every hour. + name of the coupling field with scalar information - off,on - off + cpl_scalars - - char - aux_hist - MED_attributes + + + integer + expdef + ALLCOMP_attributes - Auxiliary coupler a2x instantaneous history output every hour. + total number of scalars in the scalar coupling field - Faxa_swndr:Faxa_swvdr:Faxa_swndf:Faxa_swvdf + 5 - - char - aux_hist - MED_attributes + + + integer + expdef + ALLCOMP_attributes - Auxiliary coupler a2x instantaneous history output every hour. + index of scalar containing global grid cell count in X dimension - 3600 + 1 - - char - aux_hist - MED_attributes + + + integer + expdef + ALLCOMP_attributes - Auxiliary name identifier in history name + index of scalar containing global grid cell count in Y dimension - a2x1hi + 2 - - logical - aux_hist - MED_attributes + + + integer + expdef + ALLCOMP_attributes - Averaging type (inst or time average) + index of scalar containing calendar day of nextsw computation from atm - .false. + 3 - + + integer - aux_hist - MED_attributes + expdef + ALLCOMP_attributes - Number of time sames per file. + index of scalar containing epbal precipitation factor from ocn (only for POP) - 24 + 0 + 5 - - - - - char - aux_hist - MED_attributes + + + + + + real + control + ALLCOMP_attributes - Auxiliary a2x history output averaged over 1 hour. + Iterate atmocn flux calculation to this % difference + Setting this to zero will always do flux_max_iteration - off,on - off + 0.01 + 0.0 - - char - aux_hist - MED_attributes + + + integer + control + ALLCOMP_attributes - Auxiliary a2x history output averaged over 1 hour. + Iterate atmocn flux calculation a max of this value - Sa_u:Sa_v + 5 - - char - aux_hist - MED_attributes + + + logical + control + ALLCOMP_attributes - Auxiliary coupler a2x instantaneous history output every hour. + if true use Mahrt and Sun 1995,MWR modification to surface flux calculation - 3600 + .true. + .false. + .false. - - char - aux_hist - MED_attributes + + + logical + flds + ALLCOMP_attributes - Auxiliary name identifier in history name + Previously, new fields that were needed to be passed between components + for certain compsets were specified by cpp-variables. This has been + modified to now be use cases. This use cases are specified in the + namelist cpl_flds_inparm and are currently triggered by the xml variable CCSM_BGC. + If CCSM_BGC is set to 'CO2A', then flds_co2a will be set to .true. - a2x1h + .false. + .true. - + + logical - aux_hist - MED_attributes + flds + ALLCOMP_attributes - Averaging type (inst or time average) + Previously, new fields that were needed to be passed between components + for certain compsets were specified by cpp-variables. This has been + modified to now be use cases. This use cases are specified in the + namelist cpl_flds_inparm and are currently triggered by the xml variable CCSM_BGC. + If CCSM_BGC is set to 'CO2B', then flds_co2b will be set to .true. - .true. + .false. + .true. - - char - aux_hist - MED_attributes + + + logical + flds + ALLCOMP_attributes - Number of time sames per file. + Previously, new fields that were needed to be passed between components + for certain compsets were specified by cpp-variables. This has been + modified to now be use cases. This use cases are specified in the + namelist cpl_flds_inparm and are currently triggered by the xml variable CCSM_BGC. + If CCSM_BGC is set to 'CO2C', then flds_co2c will be set to .true. - 24 + .false. + .true. - - - - - char - aux_hist - MED_attributes + + logical + seq_flds + ALLCOMP_attributes - Auxiliary coupler a2x precipitation history output every 3 hours + If set to .true. BGC fields will be passed back and forth between the ocean and seaice + via the mediator. - off,on - off + .false. + .true. - - char - aux_hist - MED_attributes + + + + logical + flds + ALLCOMP_attributes - Auxiliary coupler a2x precipitation history output every 3 hours + Pass water isotopes between components - Faxa_rainc:Faxa_rainl:Faxa_snowc:Faxa_snowl + $FLDS_WISO - - char - aux_hist - MED_attributes + + + integer + flds + ALLCOMP_attributes - Auxiliary coupler a2x instantaneous history output every hour. + Number of cism elevation classes. Set by the xml variable GLC_NEC in env_run.xml - 10800 + $GLC_NEC - - char - aux_hist - MED_attributes + + + integer + flds + ALLCOMP_attributes - Auxiliary name identifier in history name + Number of sea ice thickness categories. Set by the xml variable ICE_NCAT in env_build.xml - a2x3h_prec + $ICE_NCAT - + + logical - aux_hist - MED_attributes + flds + ALLCOMP_attributes - Averaging type (inst or time average) + False => CISM does not evolve but only sends initial information back to CTSM - .true. + .false. + $CISM_EVOLVE - + + + + + + char - aux_hist + control MED_attributes - Number of time sames per file. + Type of coupling mode to use in the mediator - 8 + $COUPLING_MODE - - - - + char - aux_hist + control MED_attributes + on,off,on_if_glc_coupled_fluxes - Auxiliary coupler a2x precipitation history output every 3 hours + Whether to renormalize the surface mass balance (smb) sent from lnd to glc so that the + global integral on the glc grid agrees with the global integral on the lnd grid. + + Unlike most fluxes, smb is remapped with bilinear rather than conservative mapping weights, + so this option is needed for conservation. However, conservation is not required in many + cases, since we often run glc as a diagnostic (one-way-coupled) component. + + Allowable values are: + 'on': always do this renormalization + 'off': never do this renormalization (see WARNING below) + 'on_if_glc_coupled_fluxes': Determine at runtime whether to do this renormalization. + Does the renormalization if we're running a two-way-coupled glc that sends fluxes + to other components (which is the case where we need conservation). + Does NOT do the renormalization if we're running a one-way-coupled glc, or if + we're running a glc-only compset (T compsets). + (In these cases, conservation is not important.) + + Only used if running with a prognostic GLC component. + + WARNING: Setting this to 'off' will break conservation when running with an + evolving, two-way-coupled glc. - off,on - off + on_if_glc_coupled_fluxes + off - - char - aux_hist + + + integer + expdef MED_attributes - Auxiliary coupler a2x precipitation history output every 3 hours + Level of debug output, 0=minimum, 1=normal, 2=more, 3=too much (default: 1) - 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 + $INFO_DBUG - + + char - aux_hist - MED_attributes + mapping + ATM_attributes - Auxiliary coupler a2x instantaneous history output every hour. + MESH description of atm grid - 10800 + $ATM_DOMAIN_MESH - + + char - aux_hist - MED_attributes + mapping + ATM_attributes - Auxiliary name identifier in history name + DOMAIN description of atm grid - a2x3h + $ATM_DOMAIN_PATH/$ATM_DOMAIN_FILE - - logical - aux_hist - MED_attributes + + + char + mapping + LND_attributes - Averaging type (inst or time average) + MESH description of lnd grid - .true. + $LND_DOMAIN_MESH - + + char - aux_hist - MED_attributes + mapping + LND_attributes - Number of time sames per file. + DOMAIN description of lnd grid - 8 + $LND_DOMAIN_PATH/$LND_DOMAIN_FILE - - - - + char - aux_hist - MED_attributes + mapping + OCN_attributes - Auxiliary coupler a2x precipitation history output every 3 hours + MESH description of ocn grid - off,on - off + $OCN_DOMAIN_MESH - + + char - aux_hist - MED_attributes + mapping + ICE_attributes - Auxiliary coupler a2x precipitation history output every 3 hours + MESH description of ice grid - Faxa_bcph:Faxa_ocph:Faxa_dstwet:Faxa_dstdry:Sa_co2prog:Sa_co2diag + $ICE_DOMAIN_MESH - + + char - aux_hist - MED_attributes + mapping + ROF_attributes - Auxiliary coupler a2x instantaneous history output every hour. + MESH description of rof grid - 86400 + $ROF_DOMAIN_MESH - + + char - aux_hist - MED_attributes + mapping + GLC_attributes - Auxiliary name identifier in history name + MESH description of glc grid - a2x24h - - - - logical - aux_hist - MED_attributes - - Averaging type (inst or time average) - - - .true. + $GLC_DOMAIN_MESH - + + char - aux_hist - MED_attributes + mapping + WAV_attributes - Number of time sames per file. + MESH description of wav grid - 1 + $WAV_DOMAIN_MESH - - - - - char - aux_hist + + real + domain_check MED_attributes - Auxiliary coupler l2x fields every year + Error tolerance for differences in fractions in domain checking + default: 1.0e-02 - off,on - off + $EPS_FRAC - - char - aux_hist + + + real + domain_check MED_attributes - Auxiliary coupler a2x precipitation history output every 3 hours + Error tolerance for differences in atm/land masks in domain checking + default: 1.0e-13 - all + $EPS_AMASK - - char - aux_hist + + + real + domain_check MED_attributes - Auxiliary coupler l2x instantaneous history output every mediator coupling interval + Error tolerance for differences in atm/land lat/lon in domain checking + default: 1.0e-12 - -999 + $EPS_AGRID - - char - aux_hist + + + real + domain_check MED_attributes - Auxiliary name identifier in history name + Error tolerance for differences in atm/land areas in domain checking + default: 1.0e-07 - a2x24h + $EPS_AAREA - - logical - aux_hist + + + real + domain_check MED_attributes - Averaging type (inst or time average) + Error tolerance for differences in ocean/ice masks in domain checking + default: 1.0e-06 - .true. + $EPS_OMASK - - char - aux_hist + + + real + domain_check MED_attributes - Number of time sames per file. + Error tolerance for differences in ocean/ice lon/lat in domain checking + default: 1.0e-2 - 1 + $EPS_OGRID - - - - - char - aux_hist + + real + domain_check MED_attributes - turns on coupler history stream for annual sno to coupler fields. + Error tolerance for differences in ocean/ice lon/lat in domain checking + default: 1.0e-1 - none,all - none + $EPS_OAREA - - - - - - char - aux_hist + + logical + control MED_attributes - Auxiliary coupler a2x precipitation history output every 3 hours + Only used for C,G compsets: if true, compute albedos to work with daily avg SW down - off,on - off + $CPL_ALBAV - + + char - aux_hist + mapping MED_attributes + ocn,atm,exch - Auxiliary coupler a2x precipitation history output every 3 hours + Grid for atm ocn flux calc (untested) + default: ocn - Forr_rofr,Forr_rofi + ocn - - char - aux_hist + + + real + control MED_attributes - Auxiliary coupler a2x instantaneous history output every hour. + wind gustiness factor - 86400 + 0.0D0 - - char - aux_hist + + + logical + budget MED_attributes - Auxiliary name identifier in history name + logical that turns on diagnostic budgets, false means budgets will never be written - r2x24h + $BUDGETS - - char - aux_hist + + + integer + budget MED_attributes + 0,1,2,3 - Averaging type (inst or time average) + sets the diagnotics level of the instantaneous budgets. [0,1,2,3], + written only if BUDGETS variable is true + 0=none, + 1=+net summary budgets, + 2=+detailed lnd/ocn/ice component budgets, + 3=+detailed atm budgets + default: 0 - .true. + 0 - - char - aux_hist + + + integer + budget MED_attributes + 0,1,2,3 - Number of time sames per file. + sets the diagnotics level of the daily budgets. [0,1,2,3], + written only if do_budgets variable is .true., + 0=none, + 1=+net summary budgets, + 2=+detailed lnd/ocn/ice component budgets, + 3=+detailed atm budgets + default: 0 - 1 + 0 - - - - - - char + + integer expdef - ALLCOMP_attributes + MED_attributes + 0,1,2,3 - name of the coupling field with scalar information + sets the diagnotics level of the monthy budgets. [0,1,2,3], + written only if do_budgets variable is .true., + 0=none, + 1=+net summary budgets, + 2=+detailed lnd/ocn/ice component budgets, + 3=+detailed atm budgets + default: 1 - cpl_scalars + 1 - + integer - expdef - ALLCOMP_attributes + budget + MED_attributes + 0,1,2,3 - total number of scalars in the scalar coupling field + sets the diagnotics level of the annual budgets. [0,1,2,3], + written only if do_budgets variable is .true., + 0=none, + 1=+net summary budgets, + 2=+detailed lnd/ocn/ice component budgets, + 3=+detailed atm budgets + default: 1 - 5 + 1 - + integer - expdef - ALLCOMP_attributes + budget + MED_attributes + 0,1,2,3 - index of scalar containing global grid cell count in X dimension + sets the diagnotics level of the longterm budgets written at the end + of the year. [0,1,2,3], + written only if do_budgets variable is .true., + 0=none, + 1=+net summary budgets, + 2=+detailed lnd/ocn/ice component budgets, + 3=+detailed atm budgets, + default: 1 1 - + integer - expdef - ALLCOMP_attributes + budget + MED_attributes + 0,1,2,3 - index of scalar containing global grid cell count in Y dimension + sets the diagnotics level of the longterm budgets written at the end + of each run. [0,1,2,3], + written only if do_budgets variable is .true., + 0=none, + 1=+net summary budgets, + 2=+detailed lnd/ocn/ice component budgets, + 3=+detailed atm budgets, + default: 0 - 2 + 0 - - 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 calendar day of nextsw computation from atm + 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 - 3 + $HIST_OPTION - + integer - expdef - ALLCOMP_attributes + time + MED_attributes - index of scalar containing epbal precipitation factor from ocn (only for POP) + sets mediator snapshot history file frequency (like restart_n) + set by HIST_N in env_run.xml. - 0 - 5 + $HIST_N - - logical - mapping + + + + + + integer + time MED_attributes - used for atm->ocn and atm-ice mapping of u and v; rotate u,v to 3d cartesian space, map from src->dest, then rotate back + + Sets mediator time-average history file frequency (like restart_option) + set by AVGHIST_N in env_run.xml. + - .false. + $AVGHIST_N - + char - mapping - abs + time MED_attributes - atm to ocn flux mapping file for fluxes + 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) + set by AVGHIST_OPTION in env_run.xml. + histavg_option alarms are: + [none/never], turns option off + [nstep/s] , history snapshot every histavg_n nsteps , relative to current run start time + [nsecond/s] , history snapshot every histavg_n nseconds, relative to current run start time + [nminute/s] , history snapshot every histavg_n nminutes, relative to current run start time + [nhour/s] , history snapshot every histavg_n nhours , relative to current run start time + [nday/s] , history snapshot every histavg_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 histavg_n nmonths , relative to current run start time + [nyear/s] , history snapshot every histavg_n nyears , relative to current run start time + [date] , history snapshot at histavg_ymd value + [ifdays0] , history snapshot at histavg_n calendar day value and seconds equal 0 + [end] , history snapshot at end + - $ATM2OCN_FMAPNAME + $AVGHIST_OPTION - + + + + char - mapping - abs + aux_hist MED_attributes - atm to ocn state mapping file for states + Auxiliary mediator atm2med instantaneous history output every hour. + off,on - $ATM2OCN_SMAPNAME + off - - + char - mapping - abs + aux_hist MED_attributes - atm to ocn state mapping file for velocity + Auxiliary mediator atm2med instantaneous history output every hour. - $ATM2OCN_VMAPNAME + Faxa_swndr:Faxa_swvdr:Faxa_swndf:Faxa_swvdf - - + char - mapping - abs + aux_hist MED_attributes - ocn to atm mapping file for fluxes + Auxiliary mediator atm2med interval. - $OCN2ATM_FMAPNAME + 3600 - - + char - mapping - abs + aux_hist MED_attributes - ocn to atm mapping file for states + Auxiliary name identifier in history name - $OCN2ATM_SMAPNAME + a2x1hi - - - char - mapping - abs + + logical + aux_hist MED_attributes - atm to ice flux mapping file for fluxes + If true, use time average for aux file output. - $ATM2OCN_FMAPNAME + .false. - - - char - mapping - abs + + integer + aux_hist MED_attributes - atm to ice state mapping file for states + Number of time sames per file. - $ATM2OCN_SMAPNAME + 24 - + + + + char - mapping - abs + aux_hist MED_attributes - atm to ice state mapping file for velocity + Auxiliary atm2med history output averaged over 1 hour. + off,on - $ATM2OCN_VMAPNAME + off - - + char - mapping - abs + aux_hist MED_attributes - ice to atm mapping file for fluxes + Auxiliary atm2med history output averaged over 1 hour. - $OCN2ATM_FMAPNAME + Sa_u:Sa_v - - + char - mapping - abs + aux_hist MED_attributes - ice to atm mapping file for states + Auxiliary mediator atm2med instantaneous history output every hour. - $OCN2ATM_SMAPNAME + 3600 - - + char - mapping - abs + aux_hist MED_attributes - atm to land mapping file for fluxes + Auxiliary name identifier in history name - $ATM2LND_FMAPNAME + a2x1h - - - char - mapping - abs + + logical + aux_hist MED_attributes - atm to land mapping file for states + If true, use time average for aux file output. - $ATM2LND_SMAPNAME + .true. - - + char - mapping - abs + aux_hist MED_attributes - atm to land mapping file for states + Number of time sames per file. - $ATM2LND_SMAPNAME + 24 - + + + + char - mapping - abs + aux_hist MED_attributes - land to atm mapping file for fluxes + Auxiliary mediator atm2med precipitation history output every 3 hours + off,on - $LND2ATM_FMAPNAME + off - - + char - mapping - abs + aux_hist MED_attributes - land to atm mapping file for states + Auxiliary mediator atm2med precipitation history output every 3 hours - $LND2ATM_SMAPNAME + Faxa_rainc:Faxa_rainl:Faxa_snowc:Faxa_snowl - - + char - mapping - abs + aux_hist MED_attributes - lnd to runoff conservative mapping file + Auxiliary mediator atm2med interval. - $LND2ROF_FMAPNAME + 10800 - - + char - mapping - abs + aux_hist MED_attributes - runoff to lnd conservative mapping file + Auxiliary name identifier in history name. - $ROF2LND_FMAPNAME + a2x3h_prec - - - char - mapping - abs + + logical + aux_hist MED_attributes - runoff to lnd conservative mapping file + If true, use time average for aux file output. - $ROF2LND_FMAPNAME + .true. - - + char - mapping - abs + aux_hist MED_attributes - runoff to ocn area overlap conservative mapping file + Number of time sames per file. - $ROF2OCN_FMAPNAME + 8 - + + + + char - mapping - abs + aux_hist MED_attributes - glc2ocn runoff mapping file for liquid runoff + Auxiliary mediator a2x precipitation history output every 3 hours + off,on - $GLC2OCN_LIQ_RMAPNAME + off - - + char - mapping - abs + aux_hist MED_attributes - glc to ice runoff conservative mapping file + Auxiliary mediator a2x precipitation history output every 3 hours - $GLC2ICE_RMAPNAME + 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 - mapping - abs + aux_hist MED_attributes - glc2ocn runoff mapping file for ice runoff + Auxiliary mediator a2x instantaneous history output every hour. - $GLC2OCN_ICE_RMAPNAME + 10800 - - + char - mapping - abs + aux_hist MED_attributes - runoff to ocn nearest neighbor plus smoothing conservative mapping file + Auxiliary name identifier in history name - $ROF2OCN_LIQ_RMAPNAME + a2x3h - - - char - mapping - abs + + logical + aux_hist MED_attributes - runoff to ocn nearest neighbor plus smoothing conservative mapping file + If true, use time average for aux file output. - $ROF2OCN_ICE_RMAPNAME + .true. - - + char - mapping - abs + aux_hist MED_attributes - land to glc mapping file for fluxes + Number of time sames per file. - $LND2GLC_FMAPNAME + 8 - + + + + char - mapping - abs + aux_hist MED_attributes - land to glc mapping file for states + Auxiliary mediator a2x precipitation history output every 3 hours + off,on - $LND2GLC_SMAPNAME + off - - + char - mapping - abs + aux_hist MED_attributes - glc to land mapping file for fluxes + Auxiliary mediator a2x precipitation history output every 3 hours - $GLC2LND_FMAPNAME + Faxa_bcph:Faxa_ocph:Faxa_dstwet:Faxa_dstdry:Sa_co2prog:Sa_co2diag - - + char - mapping - abs + aux_hist MED_attributes - glc to land mapping file for states + Auxiliary mediator a2x instantaneous history output every hour. - $GLC2LND_SMAPNAME + 86400 - - + char - mapping - abs + aux_hist MED_attributes - atm to wav state mapping file for states + Auxiliary name identifier in history name - $ATM2WAV_SMAPNAME + a2x24h - - + + logical + aux_hist + MED_attributes + + If true, use time average for aux file output. + + + .true. + + + char - mapping - abs + aux_hist MED_attributes - atm to wav state mapping file for states + Number of time sames per file. - $ATM2WAV_SMAPNAME + 1 - + + + + char - mapping - abs + aux_hist MED_attributes - ocn to wav state mapping file for states + Auxiliary mediator l2x fields every year + off,on - $OCN2WAV_SMAPNAME + off - - + char - mapping - abs + aux_hist MED_attributes - ice to wav state mapping file for states + Auxiliary mediator a2x precipitation history output every 3 hours - $ICE2WAV_SMAPNAME + all - - + char - mapping - abs + aux_hist MED_attributes - wav to ocn state mapping file for states + Auxiliary mediator l2x instantaneous history output every mediator coupling interval - $WAV2OCN_SMAPNAME + every_nstep - - - logical - flds - ALLCOMP_attributes + + char + aux_hist + MED_attributes - Previously, new fields that were needed to be passed between components - for certain compsets were specified by cpp-variables. This has been - modified to now be use cases. This use cases are specified in the - namelist cpl_flds_inparm and are currently triggered by the xml variable CCSM_BGC. - If CCSM_BGC is set to 'CO2A', then flds_co2a will be set to .true. + Auxiliary name identifier in history name - .false. - .true. + a2x24h - - + logical - flds - ALLCOMP_attributes + aux_hist + MED_attributes - Previously, new fields that were needed to be passed between components - for certain compsets were specified by cpp-variables. This has been - modified to now be use cases. This use cases are specified in the - namelist cpl_flds_inparm and are currently triggered by the xml variable CCSM_BGC. - If CCSM_BGC is set to 'CO2B', then flds_co2b will be set to .true. + If true, use time average for aux file output. - .false. - .true. + .true. - - - logical - flds - ALLCOMP_attributes + + char + aux_hist + MED_attributes - Previously, new fields that were needed to be passed between components - for certain compsets were specified by cpp-variables. This has been - modified to now be use cases. This use cases are specified in the - namelist cpl_flds_inparm and are currently triggered by the xml variable CCSM_BGC. - If CCSM_BGC is set to 'CO2C', then flds_co2c will be set to .true. + Number of time sames per file. - .false. - .true. + 1 - - logical - seq_flds - ALLCOMP_attributes + + + + + char + aux_hist + MED_attributes - If set to .true. BGC fields will be passed back and forth between the ocean and seaice - via the coupler. + turns on mediator history stream for annual sno to mediator. + none,all - .false. - .true. + none - - logical - flds - ALLCOMP_attributes + + + + + char + aux_hist + MED_attributes - Pass water isotopes between components + Auxiliary mediator rof2med precipitation history output every 3 hours + off,on - $FLDS_WISO + off - - - integer - flds - ALLCOMP_attributes + + char + aux_hist + MED_attributes - Number of cism elevation classes. Set by the xml variable GLC_NEC in env_run.xml + Auxiliary mediator rof2med precipitation history output. - $GLC_NEC + all - - - integer - flds - ALLCOMP_attributes + + char + aux_hist + MED_attributes - Number of sea ice thickness categories. Set by the xml variable ICE_NCAT in env_build.xml + Auxiliary mediator rof2med history output time interval. - $ICE_NCAT + 86400 - - - logical - flds - ALLCOMP_attributes + + char + aux_hist + MED_attributes - False => CISM does not evolve but only sends initial information back to CTSM + Auxiliary name identifier in history name - .false. - $CISM_EVOLVE + r2x24h - - - - - - - integer - time - CLOCK_attributes + + char + aux_hist + MED_attributes - atm coupling interval in seconds - set via ATM_NCPL in env_run.xml. - ATM_NCPL is the number of times the atm is coupled per NCPL_BASE_PERIOD - NCPL_BASE_PERIOD is also set in env_run.xml and is the base period - associated with NCPL coupling frequency, and has valid values: hour,day,year,decade + If true, use time average for aux file output. + + .true. + - - - integer - time - CLOCK_attributes + + char + aux_hist + MED_attributes - lnd coupling interval in seconds - set via LND_NCPL in env_run.xml. - LND_NCPL is the number of times the lnd is coupled per NCPL_BASE_PERIOD - NCPL_BASE_PERIOD is also set in env_run.xml and is the base period - associated with NCPL coupling frequency, nad has valid values: hour,day,year,decade + Number of time sames per file. + + 1 + - - integer - time - CLOCK_attributes - - river runoff coupling interval in seconds - currently set by default to 10800 seconds. - default: 10800 - - + + + - - integer - time - CLOCK_attributes - - ice coupling interval in seconds - set via ICE_NCPL in env_run.xml. - ICE_NCPL is the number of times the ice is coupled per NCPL_BASE_PERIOD - NCPL_BASE_PERIOD is also set in env_run.xml and is the base period - associated with NCPL coupling frequency, nad has valid values: hour,day,year,decade - + + logical + mapping + MED_attributes + used for atm->ocn and atm-ice mapping of u and v; rotate u,v to 3d cartesian space, map from src->dest, then rotate back + + .false. + - - integer - time - CLOCK_attributes - - ocn coupling interval in seconds - set via OCN_NCPL in env_run.xml. - OCN_NCPL is the number of times the ocn is coupled per NCPL_BASE_PERIOD - NCPL_BASE_PERIOD is also set in env_run.xml and is the base period - associated with NCPL coupling frequency, nad has valid values: hour,day,year,decade - + + char + mapping + abs + MED_attributes + atm to ocn flux mapping file for fluxes + + $ATM2OCN_FMAPNAME + - - integer - time - CLOCK_attributes + + char + mapping + abs + MED_attributes - glc coupling interval in seconds - set via GLC_NCPL in env_run.xml. - GLC_NCPL is the number of times the glc is coupled per NCPL_BASE_PERIOD - NCPL_BASE_PERIOD is also set in env_run.xml and is the base period - associated with NCPL coupling frequency, nad has valid values: hour,day,year,decade + atm to ocn state mapping file for states - - - - char - time - CLOCK_attributes - glc_coupling_period,yearly - $GLC_AVG_PERIOD + $ATM2OCN_SMAPNAME - - Period at which coupler averages fields sent to GLC. - This supports doing the averaging to GLC less frequently than GLC is called - (i.e., separating the averaging frequency from the calling frequency). - This is useful because there are benefits to only averaging the GLC inputs - as frequently as they are really needed (yearly for CISM), but GLC needs to - still be called more frequently than that in order to support mid-year restarts. - - Setting glc_avg_period to 'glc_coupling_period' means that the averaging is - done exactly when the GLC is called (governed by GLC_NCPL). - - - integer - time - CLOCK_attributes + + char + mapping + abs + MED_attributes - wav coupling interval in seconds - set via WAV_NCPL in env_run.xml. - WAV_NCPL is the number of times the wav is coupled per NCPL_BASE_PERIOD - NCPL_BASE_PERIOD is also set in env_run.xml and is the base period - associated with NCPL coupling frequency, nad has valid values: hour,day,year,decade + atm to ocn state mapping file for velocity + + $ATM2OCN_VMAPNAME + - - integer - time - CLOCK_attributes + + char + mapping + abs + MED_attributes - esp run interval in seconds - esp_cpl_dt is the number of times the esp is run per NCPL_BASE_PERIOD - NCPL_BASE_PERIOD is set in env_run.xml and is the base period - associated with NCPL coupling frequency, nad has valid values: hour,day,year,decade - default value set by buildnml to be the pause interval if pause is active - otherwise, it is set to the shortest component coupling time + ocn to atm mapping file for fluxes - -999 + $OCN2ATM_FMAPNAME - - - - - - - - - - - - - - - - - - - + char - time - CLOCK_attributes - NO_LEAP,GREGORIAN + mapping + abs + MED_attributes - calendar in use. [NO_LEAP, GREOGORIAN]. - set by CALENDAR in env_build.xml + ocn to atm mapping file for states - $CALENDAR + $OCN2ATM_SMAPNAME - - integer - time - CLOCK_attributes + + char + mapping + abs + MED_attributes - Run start date in yyyymmdd format, only used for startup and hybrid runs. - default: 00010101 + atm to ice flux mapping file for fluxes - 00010101 + $ATM2OCN_FMAPNAME - - integer - time - CLOCK_attributes + + char + mapping + abs + MED_attributes - Start time-of-day in universal time (seconds), should be between zero and 86400 - default: 0 + atm to ice state mapping file for states - $START_TOD + $ATM2OCN_SMAPNAME - + char - time - CLOCK_attributes - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + mapping + abs + MED_attributes - sets the run length with stop_n and stop_ymd - stop_option alarms are: - [none/never], turns option off - [nstep/s] , stops every stop_n nsteps , relative to current run start time - [nsecond/s] , stops every stop_n nseconds, relative to current run start time - [nminute/s] , stops every stop_n nminutes, relative to current run start time - [nhour/s] , stops every stop_n nhours , relative to current run start time - [nday/s] , stops every stop_n ndays , relative to current run start time - [nmonth/s] , stops every stop_n nmonths , relative to current run start time - [monthly/s] , stops every month , relative to current run start time - [nyear/s] , stops every stop_n nyears , relative to current run start time - [date] , stops at stop_ymd value - [ifdays0] , stops at stop_n calendar day value and seconds equal 0 - [end] , stops at end + atm to ice state mapping file for velocity - $STOP_OPTION + $ATM2OCN_VMAPNAME - - integer - time - CLOCK_attributes + + char + mapping + abs + MED_attributes - Sets the run length with stop_option and stop_ymd + ice to atm mapping file for fluxes - $STOP_N + $OCN2ATM_FMAPNAME - - integer - time - CLOCK_attributes - - date in yyyymmdd format, sets the run length with stop_option and stop_n, - can be in addition to stop_option and stop_n, negative value implies off - - - $STOP_DATE - - - - - integer - time - CLOCK_attributes - - Stop time-of-day in universal time (seconds), should be between zero and 86400 - default: 0 - - - 0 - - - - + 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 restart frequency with restart_n and restart_ymd - restart_option alarms are: - [none/never], turns option off - [nstep/s] , restarts every restart_n nsteps , relative to current run start time - [nsecond/s] , restarts every restart_n nseconds, relative to current run start time - [nminute/s] , restarts every restart_n nminutes, relative to current run start time - [nhour/s] , restarts every restart_n nhours , relative to current run start time - [nday/s] , restarts every restart_n ndays , relative to current run start time - [monthly/s] , restarts every month , relative to current run start time - [nmonth/s] , restarts every restart_n nmonths , relative to current run start time - [nyear/s] , restarts every restart_n nyears , relative to current run start time - [date] , restarts at restart_ymd value - [ifdays0] , restarts at restart_n calendar day value and seconds equal 0 - [end] , restarts at end - - - $REST_OPTION - - - - - integer - time - CLOCK_attributes - - Sets model restart writes with restart_option and restart_ymd (same options as stop_n) - - - $REST_N - - - - - integer - time - CLOCK_attributes - - Date in yyyymmdd format, sets model restart write date with rest_option and restart_n - default: STOP_N - - - $REST_DATE - - - - - logical - time - CLOCK_attributes + mapping + abs + MED_attributes - true => write restarts at end of run - forces a restart write at the end of the run in addition to any - setting associated with rest_option. default=true. this setting - will be set to false if restart_option is none or never. - default: false + ice to atm mapping file for states - .false. + $OCN2ATM_SMAPNAME - + 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 + mapping + abs + MED_attributes - sets coupler snapshot history file frequency (like restart_n) - set by HIST_N in env_run.xml. + atm to land mapping file for fluxes - $HIST_N + $ATM2LND_FMAPNAME - - integer - time - CLOCK_attributes + + char + mapping + abs + MED_attributes - date associated with history_option date. yyyymmdd format. - set by HIST_DATE in env_run.xml. + atm to land mapping file for states - $HIST_DATE + $ATM2LND_SMAPNAME - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + char - time - CLOCK_attributes - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,nmonths,monthly,nmonth,nyears,nyear,date,ifdays0,end + mapping + abs + MED_attributes - 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 + atm to land mapping file for states - $BARRIER_OPTION + $ATM2LND_SMAPNAME - - integer - time - CLOCK_attributes + + char + mapping + abs + MED_attributes - Sets model barriers with barrier_option and barrier_ymd (same options as stop_n) - default: 1 + land to atm mapping file for fluxes - $BARRIER_N + $LND2ATM_FMAPNAME - - integer - time - CLOCK_attributes + + char + mapping + abs + MED_attributes - Date in yyyymmdd format, sets model barriers date with barrier_option and barrier_n + land to atm mapping file for states - $BARRIER_DATE + $LND2ATM_SMAPNAME - + char - time - CLOCK_attributes - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + mapping + abs + MED_attributes - Sets timing output file frequency (like rest_option but relative to run start date) - tprof_option alarms are: - [none/never], turns option off - [nstep/s] , every tprof_n nsteps , relative to current run start time - [nsecond/s] , every tprof_n nseconds, relative to current run start time - [nminute/s] , every tprof_n nminutes, relative to current run start time - [nhour/s] , every tprof_n nhours , relative to current run start time - [nday/s] , every tprof_n ndays , relative to current run start time - [monthly/s] , every month , relative to current run start time - [nmonth/s] , every tprof_n nmonths , relative to current run start time - [nyear/s] , every tprof_n nyears , relative to current run start time - [date] , at tprof_ymd value - [ifdays0] , at tprof_n calendar day value and seconds equal 0 - [end] , at end + lnd to runoff conservative mapping file - never + $LND2ROF_FMAPNAME - - integer - time - CLOCK_attributes + + char + mapping + abs + MED_attributes - Sets timing output file frequency (like restart_n) + runoff to lnd conservative mapping file - -999 + $ROF2LND_FMAPNAME - - integer - time - CLOCK_attributes + + char + mapping + abs + MED_attributes - yyyymmdd format, sets timing output file date (like restart_date) + runoff to lnd conservative mapping file - -999 + $ROF2LND_FMAPNAME - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + char + mapping + abs + MED_attributes + + runoff to ocn area overlap conservative mapping file + + + $ROF2OCN_FMAPNAME + + - - integer - cime_pes - PELAYOUT_attributes + + char + mapping + abs + MED_attributes - The number of model instances in the executable + glc2ocn runoff mapping file for liquid runoff - $NINST + $GLC2OCN_LIQ_RMAPNAME - - integer - cime_pes - PELAYOUT_attributes + + char + mapping + abs + MED_attributes - the number of mpi tasks assigned to the atm components. - set by NTASKS_ATM in env_configure.xml. + glc to ice runoff conservative mapping file - $NTASKS_ATM + $GLC2ICE_RMAPNAME - - integer - cime_pes - PELAYOUT_attributes + + char + mapping + abs + MED_attributes - the number of threads per mpi task for the atm component. - set by NTHRDS_ATM in env_configure.xml. + glc2ocn runoff mapping file for ice runoff - $NTHRDS_ATM + $GLC2OCN_ICE_RMAPNAME - - integer - cime_pes - PELAYOUT_attributes + + char + mapping + abs + MED_attributes - the global mpi task rank of the root processor assigned to the atm component. - set by ROOTPE_ATM in env_configure.xml. + runoff to ocn nearest neighbor plus smoothing conservative mapping file - $ROOTPE_ATM + $ROF2OCN_LIQ_RMAPNAME - - integer - cime_pes - PELAYOUT_attributes + + char + mapping + abs + MED_attributes - the mpi global processors stride associated with the mpi tasks for the atm component. - set by PSTRID_ATM in env_configure.xml. + runoff to ocn nearest neighbor plus smoothing conservative mapping file - $PSTRID_ATM + $ROF2OCN_ICE_RMAPNAME - - integer - cime_pes - PELAYOUT_attributes + + char + mapping + abs + MED_attributes - the number of mpi tasks assigned to the lnd components. - set by NTASKS_LND in env_configure.xml. + land to glc mapping file for fluxes - $NTASKS_LND + $LND2GLC_FMAPNAME - - integer - cime_pes - PELAYOUT_attributes + + char + mapping + abs + MED_attributes - the number of threads per mpi task for the lnd component. - set by NTHRDS_LND in env_configure.xml. + land to glc mapping file for states - $NTHRDS_LND + $LND2GLC_SMAPNAME - - integer - cime_pes - PELAYOUT_attributes + + char + mapping + abs + MED_attributes - the global mpi task rank of the root processor assigned to the lnd component. - set by ROOTPE_LND in env_configure.xml. + glc to land mapping file for fluxes - $ROOTPE_LND + $GLC2LND_FMAPNAME - - integer - cime_pes - PELAYOUT_attributes + + char + mapping + abs + MED_attributes - the mpi global processors stride associated with the mpi tasks for the lnd component. - set by PSTRID_LND in env_configure.xml. + glc to land mapping file for states - $PSTRID_LND + $GLC2LND_SMAPNAME - - integer - cime_pes - PELAYOUT_attributes + + char + mapping + abs + MED_attributes - the number of mpi tasks assigned to the ice components. - set by NTASKS_ICE in env_configure.xml. + atm to wav state mapping file for states - $NTASKS_ICE + $ATM2WAV_SMAPNAME - - integer - cime_pes - PELAYOUT_attributes + + char + mapping + abs + MED_attributes - the number of threads per mpi task for the ice component. - set by NTHRDS_ICE in env_configure.xml. + atm to wav state mapping file for states - $NTHRDS_ICE + $ATM2WAV_SMAPNAME - - integer - cime_pes - PELAYOUT_attributes + + char + mapping + abs + MED_attributes - the global mpi task rank of the root processor assigned to the ice component. - set by ROOTPE_ICE in env_configure.xml. + ocn to wav state mapping file for states - $ROOTPE_ICE + $OCN2WAV_SMAPNAME - - integer - cime_pes - PELAYOUT_attributes + + char + mapping + abs + MED_attributes - the mpi global processors stride associated with the mpi tasks for the ice component. - set by PSTRID_ICE in env_configure.xml. + ice to wav state mapping file for states - $PSTRID_ICE + $ICE2WAV_SMAPNAME - - integer - cime_pes - PELAYOUT_attributes + + char + mapping + abs + MED_attributes - the number of mpi tasks assigned to the ocn components. - set by NTASKS_OCN in env_configure.xml. + wav to ocn state mapping file for states - $NTASKS_OCN + $WAV2OCN_SMAPNAME - - integer - cime_pes - PELAYOUT_attributes + + char + time + CLOCK_attributes + none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,nmonths,monthly,nmonth,nyears,nyear,date,ifdays0,end - the number of threads per mpi task for the ocn component. - set by NTHRDS_OCN in env_configure.xml. + 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 - $NTHRDS_OCN + $BARRIER_OPTION - + + + + + + + integer + time + CLOCK_attributes + + atm coupling interval in seconds + set via ATM_NCPL in env_run.xml. + ATM_NCPL is the number of times the atm is coupled per NCPL_BASE_PERIOD + NCPL_BASE_PERIOD is also set in env_run.xml and is the base period + associated with NCPL coupling frequency, and has valid values: hour,day,year,decade + + + + + integer + time + CLOCK_attributes + + lnd coupling interval in seconds + set via LND_NCPL in env_run.xml. + LND_NCPL is the number of times the lnd is coupled per NCPL_BASE_PERIOD + NCPL_BASE_PERIOD is also set in env_run.xml and is the base period + associated with NCPL coupling frequency, nad has valid values: hour,day,year,decade + + + + integer - cime_pes - PELAYOUT_attributes + time + CLOCK_attributes - the global mpi task rank of the root processor assigned to the ocn component. - set by ROOTPE_OCN in env_configure.xml. + river runoff coupling interval in seconds + currently set by default to 10800 seconds. + default: 10800 - - $ROOTPE_OCN - - + integer - cime_pes - PELAYOUT_attributes + time + CLOCK_attributes - the mpi global processors stride associated with the mpi tasks for the ocn component. - set by PSTRID_OCN in env_configure.xml. default: 1 + ice coupling interval in seconds + set via ICE_NCPL in env_run.xml. + ICE_NCPL is the number of times the ice is coupled per NCPL_BASE_PERIOD + NCPL_BASE_PERIOD is also set in env_run.xml and is the base period + associated with NCPL coupling frequency, nad has valid values: hour,day,year,decade - - $PSTRID_OCN - - + integer - cime_pes - PELAYOUT_attributes + time + CLOCK_attributes - the number of mpi tasks assigned to the glc components. - set by NTASKS_GLC in env_configure.xml. + ocn coupling interval in seconds + set via OCN_NCPL in env_run.xml. + OCN_NCPL is the number of times the ocn is coupled per NCPL_BASE_PERIOD + NCPL_BASE_PERIOD is also set in env_run.xml and is the base period + associated with NCPL coupling frequency, nad has valid values: hour,day,year,decade - - $NTASKS_GLC - - + integer - cime_pes - PELAYOUT_attributes + time + CLOCK_attributes - the number of threads per mpi task for the glc component. - set by NTHRDS_GLC in env_configure.xml. + glc coupling interval in seconds + set via GLC_NCPL in env_run.xml. + GLC_NCPL is the number of times the glc is coupled per NCPL_BASE_PERIOD + NCPL_BASE_PERIOD is also set in env_run.xml and is the base period + associated with NCPL coupling frequency, nad has valid values: hour,day,year,decade - - $NTHRDS_GLC - - - integer - cime_pes - PELAYOUT_attributes - - the global mpi task rank of the root processor assigned to the glc component. - set by ROOTPE_GLC in env_configure.xml. - + + char + time + CLOCK_attributes + glc_coupling_period,yearly - $ROOTPE_GLC + $GLC_AVG_PERIOD + + Period at which mediator averages fields sent to GLC. + This supports doing the averaging to GLC less frequently than GLC is called + (i.e., separating the averaging frequency from the calling frequency). + This is useful because there are benefits to only averaging the GLC inputs + as frequently as they are really needed (yearly for CISM), but GLC needs to + still be called more frequently than that in order to support mid-year restarts. + + Setting glc_avg_period to 'glc_coupling_period' means that the averaging is + done exactly when the GLC is called (governed by GLC_NCPL). + - + integer - cime_pes - PELAYOUT_attributes + time + CLOCK_attributes - the mpi global processors stride associated with the mpi tasks for the glc component. - set by PSTRID_GLC in env_configure.xml. + wav coupling interval in seconds + set via WAV_NCPL in env_run.xml. + WAV_NCPL is the number of times the wav is coupled per NCPL_BASE_PERIOD + NCPL_BASE_PERIOD is also set in env_run.xml and is the base period + associated with NCPL coupling frequency, nad has valid values: hour,day,year,decade - - $PSTRID_GLC - - + integer - cime_pes - PELAYOUT_attributes + time + CLOCK_attributes - the number of mpi tasks assigned to the wav components. - set by NTASKS_WAV in env_configure.xml. + esp run interval in seconds + esp_cpl_dt is the number of times the esp is run per NCPL_BASE_PERIOD + NCPL_BASE_PERIOD is set in env_run.xml and is the base period + associated with NCPL coupling frequency, nad has valid values: hour,day,year,decade + default value set by buildnml to be the pause interval if pause is active + otherwise, it is set to the shortest component coupling time - $NTASKS_WAV + -999 - - integer - cime_pes - PELAYOUT_attributes + + + + + + + + + + + + + + + + + + + + char + time + CLOCK_attributes + NO_LEAP,GREGORIAN - the number of threads per mpi task for the wav component. - set by NTHRDS_WAV in env_configure.xml. + calendar in use. [NO_LEAP, GREOGORIAN]. + set by CALENDAR in env_build.xml - $NTHRDS_WAV + $CALENDAR - + integer - cime_pes - PELAYOUT_attributes + time + CLOCK_attributes - the global mpi task rank of the root processor assigned to the wav component. - set by ROOTPE_WAV in env_configure.xml. + Run start date in yyyymmdd format, only used for startup and hybrid runs. + default: 00010101 - $ROOTPE_WAV + 00010101 - + integer - cime_pes - PELAYOUT_attributes + time + CLOCK_attributes - the mpi global processors stride associated with the mpi tasks for the wav component. - set by PSTRID_WAV in env_configure.xml. + Start time-of-day in universal time (seconds), should be between zero and 86400 + default: 0 - $PSTRID_WAV + $START_TOD - - integer - cime_pes - PELAYOUT_attributes + + char + time + CLOCK_attributes + none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end - the number of mpi tasks assigned to the lnd components. - set by NTASKS_LND in env_configure.xml. + sets the run length with stop_n and stop_ymd + stop_option alarms are: + [none/never], turns option off + [nstep/s] , stops every stop_n nsteps , relative to current run start time + [nsecond/s] , stops every stop_n nseconds, relative to current run start time + [nminute/s] , stops every stop_n nminutes, relative to current run start time + [nhour/s] , stops every stop_n nhours , relative to current run start time + [nday/s] , stops every stop_n ndays , relative to current run start time + [nmonth/s] , stops every stop_n nmonths , relative to current run start time + [monthly/s] , stops every month , relative to current run start time + [nyear/s] , stops every stop_n nyears , relative to current run start time + [date] , stops at stop_ymd value + [ifdays0] , stops at stop_n calendar day value and seconds equal 0 + [end] , stops at end - $NTASKS_ROF + $STOP_OPTION - + integer - cime_pes - PELAYOUT_attributes + time + CLOCK_attributes - the number of threads per mpi task for the lnd component. - set by NTHRDS_ROF in env_configure.xml. + Sets the run length with stop_option and stop_ymd - $NTHRDS_ROF + $STOP_N - + integer - cime_pes - PELAYOUT_attributes + time + CLOCK_attributes - the global mpi task rank of the root processor assigned to the lnd component. - set by ROOTPE_LND in env_configure.xml. + date in yyyymmdd format, sets the run length with stop_option and stop_n, + can be in addition to stop_option and stop_n, negative value implies off - $ROOTPE_ROF + $STOP_DATE - + integer - cime_pes - PELAYOUT_attributes + time + CLOCK_attributes - the mpi global processors stride associated with the mpi tasks for the lnd component. - set by PSTRID_LND in env_configure.xml. + Stop time-of-day in universal time (seconds), should be between zero and 86400 + default: 0 - $PSTRID_ROF + 0 - - integer - cime_pes - PELAYOUT_attributes + + char + time + CLOCK_attributes + none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,nmonths,monthly,nmonth,nyears,nyear,date,ifdays0,end - the number of mpi tasks assigned to the esp components. - set by NTASKS_ESP in env_configure.xml. + sets the restart frequency with restart_n and restart_ymd + restart_option alarms are: + [none/never], turns option off + [nstep/s] , restarts every restart_n nsteps , relative to current run start time + [nsecond/s] , restarts every restart_n nseconds, relative to current run start time + [nminute/s] , restarts every restart_n nminutes, relative to current run start time + [nhour/s] , restarts every restart_n nhours , relative to current run start time + [nday/s] , restarts every restart_n ndays , relative to current run start time + [monthly/s] , restarts every month , relative to current run start time + [nmonth/s] , restarts every restart_n nmonths , relative to current run start time + [nyear/s] , restarts every restart_n nyears , relative to current run start time + [date] , restarts at restart_ymd value + [ifdays0] , restarts at restart_n calendar day value and seconds equal 0 + [end] , restarts at end - $NTASKS_ESP + $REST_OPTION - + integer - cime_pes - PELAYOUT_attributes + time + CLOCK_attributes - the number of threads per mpi task for the esp component. - set by NTHRDS_ESP in env_configure.xml. + Sets model restart writes with restart_option and restart_ymd (same options as stop_n) - $NTHRDS_ESP + $REST_N - + integer - cime_pes - PELAYOUT_attributes + time + CLOCK_attributes - the global mpi task rank of the root processor assigned to the esp component. - set by ROOTPE_ESP in env_configure.xml. + Date in yyyymmdd format, sets model restart write date with rest_option and restart_n + default: STOP_N - $ROOTPE_ESP + $REST_DATE - + integer - cime_pes - PELAYOUT_attributes + time + CLOCK_attributes - the mpi global processors stride associated with the mpi tasks for the esp component. - set by PSTRID_ESP in env_configure.xml. + Sets model barriers with barrier_option and barrier_ymd (same options as stop_n) + default: 1 - $PSTRID_ESP + $BARRIER_N - + integer - cime_pes - PELAYOUT_attributes + time + CLOCK_attributes - the number of mpi tasks assigned to the cpl components. - set by NTASKS_CPL in env_configure.xml. + Date in yyyymmdd format, sets model barriers date with barrier_option and barrier_n - $NTASKS_CPL + $BARRIER_DATE - - integer - cime_pes - PELAYOUT_attributes + + char + time + CLOCK_attributes + none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end - the number of threads per mpi task for the cpl component. - set by NTHRDS_CPL in env_configure.xml. + Sets timing output file frequency (like rest_option but relative to run start date) + tprof_option alarms are: + [none/never], turns option off + [nstep/s] , every tprof_n nsteps , relative to current run start time + [nsecond/s] , every tprof_n nseconds, relative to current run start time + [nminute/s] , every tprof_n nminutes, relative to current run start time + [nhour/s] , every tprof_n nhours , relative to current run start time + [nday/s] , every tprof_n ndays , relative to current run start time + [monthly/s] , every month , relative to current run start time + [nmonth/s] , every tprof_n nmonths , relative to current run start time + [nyear/s] , every tprof_n nyears , relative to current run start time + [date] , at tprof_ymd value + [ifdays0] , at tprof_n calendar day value and seconds equal 0 + [end] , at end - $NTHRDS_CPL + never - + integer - cime_pes - PELAYOUT_attributes + time + CLOCK_attributes - the global mpi task rank of the root processor assigned to the cpl component. - set by ROOTPE_CPL in env_configure.xml. + Sets timing output file frequency (like restart_n) - $ROOTPE_CPL + -999 - + integer - cime_pes - PELAYOUT_attributes + time + CLOCK_attributes - the mpi global processors stride associated with the mpi tasks for the cpl component. - set by PSTRID_CPL in env_configure.xml. + yyyymmdd format, sets timing output file date (like restart_date) - $PSTRID_CPL + -999 - - 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 @@ -3666,10 +3520,9 @@ - - - - + + + logical diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index fbf37e1c3..03062d504 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -11,7 +11,7 @@ module med_phases_history_mod ! 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 + ! 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. @@ -20,11 +20,12 @@ module med_phases_history_mod 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_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_Clock, ESMF_ClockGet, ESMF_ClockSet, ESMF_ClockAdvance, ESMF_ClockCreate + use ESMF , only : ESMF_ClockGetNextTime, ESMF_ClockGetAlarm use ESMF , only : ESMF_Calendar use ESMF , only : ESMF_Time, ESMF_TimeGet use ESMF , only : ESMF_TimeInterval, ESMF_TimeIntervalGet, ESMF_TimeIntervalSet - use ESMF , only : ESMF_Alarm, ESMF_AlarmCreate + use ESMF , only : ESMF_Alarm, ESMF_AlarmCreate, ESMF_AlarmSet use ESMF , only : ESMF_AlarmIsRinging, ESMF_AlarmRingerOff, ESMF_AlarmGet use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet use ESMF , only : ESMF_FieldBundleIsCreated, ESMF_FieldBundleRemove @@ -34,9 +35,9 @@ module med_phases_history_mod use ESMF , only : operator(==), operator(-), operator(+), operator(/=), operator(<=) use NUOPC , only : NUOPC_CompAttributeGet use NUOPC_Model , only : NUOPC_ModelGet - use esmFlds , only : compatm, complnd, compocn, compice, comprof, compglc, ncomps, compname + use esmFlds , only : compmed, compatm, complnd, compocn, compice, comprof, compglc, compwav + use esmFlds , only : ncomps, compname use esmFlds , only : fldListFr, fldListTo - use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_constants_mod , only : SecPerDay => med_constants_SecPerDay use med_constants_mod , only : czero => med_constants_czero use med_utils_mod , only : chkerr => med_utils_ChkErr @@ -47,7 +48,6 @@ module med_phases_history_mod use med_methods_mod , only : FB_accum => med_methods_FB_accum use med_methods_mod , only : FB_average => med_methods_FB_average use med_methods_mod , only : FB_fldchk => med_methods_FB_fldchk - use med_methods_mod , only : State_GetScalar => med_methods_State_GetScalar 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 @@ -58,48 +58,80 @@ module med_phases_history_mod implicit none private - public :: med_phases_history_alarms_init - public :: med_phases_history_write - public :: med_phases_history_write_atm - public :: med_phases_history_write_ice - public :: med_phases_history_write_glc - public :: med_phases_history_write_lnd - public :: med_phases_history_write_ocn - public :: med_phases_history_write_rof - public :: med_phases_history_write_wav - public :: med_phases_history_write_aux - - private :: med_phases_history_setauxflds - + ! Public routines called from the run sequence + public :: med_phases_history_write_inst_all + public :: med_phases_history_write_inst_med + public :: med_phases_history_write_inst_atm + public :: med_phases_history_write_inst_ice + public :: med_phases_history_write_inst_glc + public :: med_phases_history_write_inst_lnd + public :: med_phases_history_write_inst_ocn + public :: med_phases_history_write_inst_rof + public :: med_phases_history_write_inst_wav + + public :: med_phases_history_write_avg_atm + public :: med_phases_history_write_avg_ice + public :: med_phases_history_write_avg_glc + public :: med_phases_history_write_avg_lnd + public :: med_phases_history_write_avg_ocn + public :: med_phases_history_write_avg_rof + public :: med_phases_history_write_avg_wav + + public :: med_phases_history_write_aux_atm + public :: med_phases_history_write_aux_ice + public :: med_phases_history_write_aux_glc + public :: med_phases_history_write_aux_lnd + public :: med_phases_history_write_aux_ocn + public :: med_phases_history_write_aux_rof + public :: med_phases_history_write_aux_wav + + ! Private routines + private :: med_phases_history_init_inst + private :: med_phases_history_init_avg + private :: med_phases_history_init_aux + private :: med_phases_history_write_hfile + private :: med_phases_history_write_hfileaux + private :: med_phases_history_get_filename + private :: med_phases_history_get_auxflds + private :: med_phases_history_output_alarminfo + private :: med_phases_history_ymds2rday_offset type, public :: avgfile_type - real(r8) :: tbnds(2) ! CF1.0 time bounds type(ESMF_FieldBundle) :: FBaccum ! field bundle for time averaging integer :: accumcnt ! field bundle accumulation counter end type avgfile_type - type(avgfile_type) :: avgfiles(ncomps) - - integer, parameter :: maxfiles = 20 - integer :: nfiles = 0 + type(avgfile_type) :: avgfiles_import(ncomps) + type(avgfile_type) :: avgfiles_export(ncomps) + type(avgfile_type) :: avgfiles_aoflux_ocn + type(avgfile_type) :: avgfiles_ocnalb_ocn + type(avgfile_type) :: avgfiles_aoflux_atm + type(avgfile_type) :: avgfiles_ocnalb_atm + + integer, parameter :: max_auxfiles = 10 type, public :: auxfile_type - integer :: ncomp ! component index + character(CS), allocatable :: flds(:) ! array of aux field names character(CS) :: auxname ! name for history file creation character(CL) :: histfile = '' ! current history file name - character(CS), allocatable :: flds(:) ! array of aux field names - integer :: deltat ! interval to write out aux data in seconds character(CS) :: alarmname ! name of write alarm integer :: ntperfile ! maximum number of time samples per file integer :: nt = 0 ! time in file - real(r8) :: tbnds(2) ! CF1.0 time bounds logical :: useavg ! if true, time average, otherwise instantaneous type(ESMF_FieldBundle) :: FBaccum ! field bundle for time averaging integer :: accumcnt ! field bundle accumulation counter + type(ESMF_Clock) :: hclock ! auxiliary history clock end type auxfile_type - type(auxfile_type) :: auxfiles(maxfiles) + integer , public :: num_auxfiles(ncomps) = 0 + type(auxfile_type) , public :: auxfiles(max_auxfiles,ncomps) character(CL) :: case_name ! case name character(CS) :: inst_tag ! instance tag + type(ESMF_Clock) :: hclock_inst_all + type(ESMF_Clock) :: hclock_inst_comp(ncomps) + + type(ESMF_Clock) :: hclock_avg_comp(ncomps) + + logical :: debug_alarms = .true. character(*), parameter :: u_FILE_u = & __FILE__ @@ -107,65 +139,46 @@ module med_phases_history_mod contains !=============================================================================== - subroutine med_phases_history_alarms_init(gcomp, rc) + ! TODO: remove this when no longer needed + subroutine med_phases_history_init(gcomp, rc) + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + end subroutine med_phases_history_init + + subroutine med_phases_history_init_inst(gcomp, alarmname, hclock, rc) ! -------------------------------------- - ! Initialize mediator history file alarms + ! Initialize instantaneous history file ! -------------------------------------- - 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 ESMF , only : operator(==), operator(-) - use NUOPC , only : NUOPC_CompAttributeGet - use NUOPC_Model , only : NUOPC_ModelGet - ! input/output variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc + type(ESMF_GridComp) , intent(inout) :: gcomp + character(len=*) , intent(in) :: alarmname ! alarm name + type(ESMF_Clock) , intent(inout) :: hclock + integer , intent(out) :: rc ! local variables - type(InternalState) :: is_local - type(ESMF_VM) :: vm - type(ESMF_Alarm) :: alarm - type(ESMF_Clock) :: mclock - type(ESMF_TimeInterval) :: mtimestep - type(ESMF_Time) :: mCurrTime - type(ESMF_Time) :: mStartTime - type(ESMF_TimeInterval) :: timestep - integer :: timestep_length - character(CS) :: alarmname ! alarm name - 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 - integer :: n, ncomp - logical :: isPresent - logical :: isSet - character(*),parameter :: F01 = "(a,2x,i8)" - character(len=*), parameter :: subname='(med_phases_history_alarms_init)' + type(ESMF_Clock) :: mclock + type(ESMF_Alarm) :: alarm + type(ESMF_Time) :: CurrTime + type(ESMF_Time) :: StartTime + type(ESMF_TimeInterval) :: timestep + integer :: timestep_length + 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 + logical :: isPresent + logical :: isSet + character(len=*), parameter :: subname=' (med_phases_history_init_inst)' !--------------------------------------- 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 - - ! Get model clock, start time, current time and time step + ! First create hclock from mclock - THIS CALL DOES NOT COPY ALARMS call NUOPC_ModelGet(gcomp, modelClock=mclock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockGet(mclock, startTime=mStartTime, currTime=mCurrTime, timeStep=mtimestep, rc=rc) + hclock = ESMF_ClockCreate(mclock, 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 - if (mastertask) then - write(logunit,*) - write(logunit,F01) trim(subname)//" history clock timestep = ",timestep_length - end if ! Determine instantaneous mediator output frequency and type call NUOPC_CompAttributeGet(gcomp, name='history_option', isPresent=isPresent, isSet=isSet, rc=rc) @@ -177,298 +190,428 @@ subroutine med_phases_history_alarms_init(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) hist_n else + ! If attribute is not present - don't write histoyr output hist_option = 'none' hist_n = -999 end if - ! Set alarms for instantaneous mediator history output - ! Advance model clock to trigger alarms then reset model clock back to currtime - alarmname = 'alarm_history_inst_all' - call med_time_alarmInit(mclock, alarm, option=hist_option, opt_n=hist_n, & - reftime=mStartTime, alarmname=trim(alarmname), rc=rc) - call ESMF_AlarmSet(alarm, clock=mclock, rc=rc) + ! Set alarm for instantaneous history output + ! Advance history clock to trigger alarms then reset history clock back to mcurrtime + call ESMF_ClockGet(hclock, startTime=StartTime, currTime=CurrTime, timeStep=timestep, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockAdvance(mclock,rc=rc) + call med_time_alarmInit(hclock, alarm, option=hist_option, opt_n=hist_n, & + reftime=StartTime, alarmname=trim(alarmname), rc=rc) + call ESMF_AlarmSet(alarm, clock=hclock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockSet(mclock, currTime=mcurrtime, rc=rc) + call ESMF_ClockAdvance(hclock,rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (mastertask) then - write(logunit,F01) trim(subname)//" set instantaneous mediator history alarm "//& - trim(alarmname)//" with option "//trim(hist_option)//" and frequency ",hist_n - end if - do n = 1,ncomps - if (is_local%wrap%comp_present(n)) then - alarmname = 'alarm_history_inst_' // trim(compname(n)) - call med_time_alarmInit(mclock, alarm, option=hist_option, opt_n=hist_n, & - reftime=mStartTime, alarmname=trim(alarmname), rc=rc) - call ESMF_AlarmSet(alarm, clock=mclock, 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=mcurrtime, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (mastertask) then - write(logunit,F01) trim(subname)//" set instantaneous mediator history alarm "//& - trim(alarmname)//" with option "//trim(hist_option)//" and frequency ",hist_n - end if - end if - end do - - ! Determine time average mediator output frequency and type - call NUOPC_CompAttributeGet(gcomp, name='histavg_option', isPresent=isPresent, isSet=isSet, rc=rc) + call ESMF_ClockSet(hclock, currTime=currtime) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - call NUOPC_CompAttributeGet(gcomp, name='histavg__option', value=hist_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,*) hist_n - ! create avgerage field bundle for every component that is present - do ncomp = 1,ncomps - if (is_local%wrap%comp_present(ncomp)) then - call FB_init(avgfiles(ncomp)%FBaccum, is_local%wrap%flds_scalar_name, & - FBgeom=is_local%wrap%FBImp(ncomp,ncomp), FBflds=is_local%wrap%FBImp(ncomp,ncomp), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end if - call FB_reset(avgfiles(ncomp)%FBaccum, czero, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - avgfiles(ncomp)%accumcnt = 0 - end do - else - hist_option = 'none' - hist_n = -999 - end if - ! Set alarm for time averaged mediator history output - alarmname = 'alarm_history_avg_all' - call med_time_alarmInit(mclock, alarm, option=hist_option, opt_n=hist_n, & - reftime=mStartTime, alarmname=trim(alarmname), rc=rc) - call ESMF_AlarmSet(alarm, clock=mclock, 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=mcurrtime, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Write diagnostic info if (mastertask) then - write(logunit,F01) trim(subname)//" set average mediator history alarm "//& + call ESMF_TimeIntervalGet(timestep, s=timestep_length, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(logunit,*) + write(logunit,'(a,2x,i8)') trim(subname)//" Initialized instantaneous history alarm "//& trim(alarmname)//" with option "//trim(hist_option)//" and frequency ",hist_n + write(logunit,'(a,2x,i8)') trim(subname)//" history clock timestep = ",timestep_length end if - do n = 1,ncomps - if (is_local%wrap%comp_present(n)) then - alarmname = 'alarm_history_avg_' // trim(compname(n)) - call med_time_alarmInit(mclock, alarm, option=hist_option, opt_n=hist_n, & - reftime=mStartTime, alarmname=trim(alarmname), rc=rc) - call ESMF_AlarmSet(alarm, clock=mclock, 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=mcurrtime, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (mastertask) then - write(logunit,F01) trim(subname)//" set average mediator history alarm "//& - trim(alarmname)//" with option "//trim(hist_option)//" and frequency ",hist_n - end if - end if - end do - if (mastertask) write(logunit,*) - - end subroutine med_phases_history_alarms_init + end subroutine med_phases_history_init_inst !=============================================================================== - subroutine med_phases_history_write(gcomp, rc) - ! -------------------------------------- - ! Write mediator history file for all variables - ! -------------------------------------- + subroutine med_phases_history_init_avg(gcomp, alarmname, hclock, rc) + + ! ----------------------------- + ! Initialize time average history file + ! ----------------------------- ! input/output variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc + type(ESMF_GridComp) , intent(inout) :: gcomp + character(len=*) , intent(in) :: alarmname ! alarm name + type(ESMF_Clock) , intent(inout) :: hclock + integer , intent(out) :: rc ! local variables - character(len=*), parameter :: subname='(med_phases_history_write)' + character(len=*), parameter :: subname=' (med_phases_history_init)' !--------------------------------------- - rc = ESMF_SUCCESS - call t_startf('MED:'//subname) - call med_phases_history_write_file_inst(gcomp, 'all', 'alarm_history_inst_all', rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call t_stopf('MED:'//subname) - end subroutine med_phases_history_write + ! ! Determine time average mediator output frequency and type + ! hist_option = 'none' + ! hist_n = -999 + ! call NUOPC_CompAttributeGet(gcomp, name='history_avg_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_avg_option', value=hist_option, rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! call NUOPC_CompAttributeGet(gcomp, name='history_avg_n', value=cvalue, rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! read(cvalue,*) hist_n + ! end if + + ! ! Set alarm for time averaged mediator history output + ! alarmname = 'alarm_history_avg_all' + ! call med_time_alarmInit(mclock, alarm, option=hist_option, opt_n=hist_n, & + ! reftime=mStartTime, alarmname=trim(alarmname), rc=rc) + ! call ESMF_AlarmSet(alarm, clock=mclock, rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! if (mastertask) then + ! write(logunit,*) + ! write(logunit,'(a)') trim(subname) // 'Initialize time averaged history alarms' + ! write(logunit,'(a,2x,i8)') trim(subname)//" set average mediator history alarm "//& + ! trim(alarmname)//" with option "//trim(hist_option)//" and frequency ",hist_n + ! end if + ! do n = 1,ncomps + ! if (is_local%wrap%comp_present(n)) then + ! alarmname = 'alarm_history_avg_' // trim(compname(n)) + ! call med_time_alarmInit(mclock, alarm, option=hist_option, opt_n=hist_n, & + ! reftime=mStartTime, alarmname=trim(alarmname), rc=rc) + ! call ESMF_AlarmSet(alarm, clock=mclock, rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! if (mastertask) then + ! write(logunit,'(a,2x,i8)') trim(subname)//" set average mediator history alarm "//& + ! trim(alarmname)//" with option "//trim(hist_option)//" and frequency ",hist_n + ! end if + ! end if + ! end do + + ! ! Create time average field bundles (module variables) + ! if (hist_option /= 'never' .and. hist_option /= 'none') then + ! call NUOPC_CompAttributeGet(gcomp, name='history_avg_n', value=cvalue, rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! read(cvalue,*) hist_n + ! do n = 1,ncomps + ! ! accumulated import fields + ! if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(n,n),rc=rc)) then + ! call FB_init(avgfiles_import(n)%FBaccum, is_local%wrap%flds_scalar_name, & + ! FBgeom=is_local%wrap%FBImp(n,n), STflds=is_local%wrap%NStateImp(n), rc=rc) + ! if (chkerr(rc,__LINE__,u_FILE_u)) return + ! call FB_reset(avgfiles_import(n)%FBaccum, czero, rc) + ! if (chkerr(rc,__LINE__,u_FILE_u)) return + ! avgfiles_import(n)%accumcnt = 0 + ! end if + ! ! accumulated export fields + ! if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(n), rc=rc)) then + ! call FB_init(avgfiles_export(n)%FBaccum, is_local%wrap%flds_scalar_name, & + ! FBgeom=is_local%wrap%FBExp(n), STflds=is_local%wrap%NstateExp(n), rc=rc) + ! if (chkerr(rc,__LINE__,u_FILE_u)) return + ! call FB_reset(avgfiles_export(n)%FBaccum, czero, rc) + ! if (chkerr(rc,__LINE__,u_FILE_u)) return + ! avgfiles_export(n)%accumcnt = 0 + ! end if + ! ! accumulated atm/ocn flux on ocn mesh + ! if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_o, rc=rc)) then + ! call FB_init(avgfiles_aoflux_ocn%FBaccum, is_local%wrap%flds_scalar_name, & + ! FBgeom=is_local%wrap%FBMed_aoflux_o, FBflds=is_local%wrap%FBMed_aoflux_o, rc=rc) + ! if (chkerr(rc,__LINE__,u_FILE_u)) return + ! call FB_reset(avgfiles_aoflux_ocn%FBaccum, czero, rc) + ! if (chkerr(rc,__LINE__,u_FILE_u)) return + ! avgfiles_aoflux_ocn%accumcnt = 0 + ! end if + ! ! accumulated atm/ocn flux on atm mesh + ! if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a, rc=rc)) then + ! call FB_init(avgfiles_aoflux_atm%FBaccum, is_local%wrap%flds_scalar_name, & + ! FBgeom=is_local%wrap%FBMed_aoflux_a, FBflds=is_local%wrap%FBMed_aoflux_a, rc=rc) + ! if (chkerr(rc,__LINE__,u_FILE_u)) return + ! call FB_reset(avgfiles_aoflux_atm%FBaccum, czero, rc) + ! if (chkerr(rc,__LINE__,u_FILE_u)) return + ! avgfiles_aoflux_atm%accumcnt = 0 + ! end if + ! ! accumulated ocean albedo on ocn mesh + ! if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o, rc=rc)) then + ! call FB_init(avgfiles_ocnalb_ocn%FBaccum, is_local%wrap%flds_scalar_name, & + ! FBgeom=is_local%wrap%FBMed_ocnalb_o, FBflds=is_local%wrap%FBMed_ocnalb_o, rc=rc) + ! if (chkerr(rc,__LINE__,u_FILE_u)) return + ! call FB_reset(avgfiles_ocnalb_ocn%FBaccum, czero, rc) + ! if (chkerr(rc,__LINE__,u_FILE_u)) return + ! avgfiles_ocnalb_ocn%accumcnt = 0 + ! end if + ! ! accumulated ocean albedo on atm mesh + ! if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_a, rc=rc)) then + ! call FB_init(avgfiles_ocnalb_atm%FBaccum, is_local%wrap%flds_scalar_name, & + ! FBgeom=is_local%wrap%FBMed_ocnalb_a, FBflds=is_local%wrap%FBMed_ocnalb_a, rc=rc) + ! if (chkerr(rc,__LINE__,u_FILE_u)) return + ! call FB_reset(avgfiles_ocnalb_atm%FBaccum, czero, rc) + ! if (chkerr(rc,__LINE__,u_FILE_u)) return + ! avgfiles_ocnalb_atm%accumcnt = 0 + ! end if + ! end do + ! end if + + end subroutine med_phases_history_init_avg !=============================================================================== - subroutine med_phases_history_write_atm(gcomp, rc) - ! -------------------------------------- - ! Write mediator history file for atm variables - ! -------------------------------------- + subroutine med_phases_history_init_aux(gcomp, ncomp, auxfile, rc) + + ! ----------------------------- + ! Initialize auxiliary history file + ! NOTE: + ! 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 + ! ----------------------------- ! input/output variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc + type(ESMF_GridComp) , intent(inout) :: gcomp + integer , intent(in) :: ncomp + type(auxfile_type) , intent(inout) :: auxfile(:) + integer , intent(out) :: rc ! local variables - character(len=*), parameter :: subname='(med_phases_history_write_atm)' + type(InternalState) :: is_local + type(ESMF_Clock) :: mclock ! mediator clock + type(ESMF_Time) :: starttime + type(ESMF_Time) :: currtime + type(ESMF_TimeInterval) :: timestep + type(ESMF_Alarm) :: alarm + 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 + character(CL) :: prefix + character(CL) :: cvalue + character(CL) :: auxflds + integer :: fieldCount + logical :: found + character(CS), allocatable :: fieldNameList(:) + character(len=*), parameter :: subname=' (med_phases_history_init_aux)' !--------------------------------------- + rc = ESMF_SUCCESS - call t_startf('MED:'//subname) - call med_phases_history_write_file_inst(gcomp, 'atm', 'alarm_history_inst_atm', rc) + ! Get the internal state + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call t_stopf('MED:'//subname) - end subroutine med_phases_history_write_atm - !=============================================================================== - subroutine med_phases_history_write_ice(gcomp, rc) - ! -------------------------------------- - ! Write mediator history file for ice variables - ! -------------------------------------- + ! Initialize number of aux files for this component to zero + nfcnt = 0 + do nfile = 1,max_auxfiles - ! input/output variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc + ! Determine attribute prefix + write(prefix,'(a,i0)') 'histaux_'//trim(compname(ncomp))//'2med_file',nfile - ! local variables - character(len=*), parameter :: subname='(med_phases_history_write_ice)' - !--------------------------------------- - rc = ESMF_SUCCESS + ! Determine if on/off flag is enabled for this 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 + end if - call t_startf('MED:'//subname) - call med_phases_history_write_file_inst(gcomp, 'ice', 'alarm_history_inst_ice', rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call t_stopf('MED:'//subname) - end subroutine med_phases_history_write_ice + ! If enabled is on - then initailize auxfile(nfcnt) + if (isPresent .and. isSet .and. (trim(cvalue) == 'on')) then - !=============================================================================== - subroutine med_phases_history_write_glc(gcomp, rc) - ! -------------------------------------- - ! Write mediator history file for glc variables - ! -------------------------------------- + ! Increment nfcnt + nfcnt = nfcnt + 1 - ! input/output variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc + ! 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,*) auxfile(nfcnt)%ntperfile + if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! local variables - character(len=*), parameter :: subname='(med_phases_history_write_glc)' - !--------------------------------------- - rc = ESMF_SUCCESS + ! Determine if will do time average + call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_useavg', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) auxfile(nfcnt)%useavg - call t_startf('MED:'//subname) - call med_phases_history_write_file_inst(gcomp, 'glc', 'alarm_history_inst_glc', rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call t_stopf('MED:'//subname) - end subroutine med_phases_history_write_glc + ! 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 - !=============================================================================== - subroutine med_phases_history_write_lnd(gcomp, rc) - ! -------------------------------------- - ! Write mediator history file for lnd variables - ! -------------------------------------- + ! Determine fields that will be output to auxhist files + if (trim(auxflds) == 'all') then - ! input/output variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc + ! Output all fields sent to the mediator from ncomp to the auxhist files + call ESMF_FieldBundleGet(is_local%wrap%FBImp(ncomp,ncomp), & + fieldCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(auxfile(nfcnt)%flds(fieldcount)) + call ESMF_FieldBundleGet(is_local%wrap%FBImp(ncomp,ncomp), & + fieldNameList=auxfile(nfcnt)%flds, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - ! local variables - character(len=*), parameter :: subname='(med_phases_history_write_lnd)' - !--------------------------------------- - rc = ESMF_SUCCESS + else - call t_startf('MED:'//subname) - call med_phases_history_write_file_inst(gcomp, 'lnd', 'alarm_history_inst_lnd', rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call t_stopf('MED:'//subname) - end subroutine med_phases_history_write_lnd + ! Translate the colon deliminted string (auxflds) into a character array (fieldnamelist) + ! Note that the following call allocates the memory for fieldnamelist + call med_phases_history_get_auxflds(auxflds, fieldnamelist, rc) - !=============================================================================== - subroutine med_phases_history_write_ocn(gcomp, rc) - ! -------------------------------------- - ! Write mediator history file for ocn variables - ! -------------------------------------- + ! Remove all fields from fieldnamelist that are not in FBImp(ncomp,ncomp) + fieldCount = size(fieldnamelist) + do n = 1,fieldcount + if (.not. FB_fldchk(is_local%wrap%FBImp(ncomp,ncomp), trim(fieldnamelist(n)), rc)) then + do n1 = n, fieldCount-1 + fieldnamelist(n1) = fieldnamelist(n1+1) + end do + fieldCount = fieldCount - 1 + end if + end do - ! input/output variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc + ! Create auxfile(nfcnt)%flds array + allocate(auxfile(nfcnt)%flds(fieldcount)) + do n = 1,fieldcount + auxfile(nfcnt)%flds(n) = trim(fieldnamelist(n)) + end do - ! local variables - character(len=*), parameter :: subname='(med_phases_history_write_ocn)' - !--------------------------------------- - rc = ESMF_SUCCESS + ! Deallocate memory from fieldnamelist + deallocate(fieldnamelist) ! this was allocated in med_phases_history_get_auxflds + end if + if (mastertask) then + write(logunit,*) + write(logunit,'(a,i4,a)') trim(subname)//' Writing the following fields to auxfile ',nfcnt,& + ' for component '//trim(compname(ncomp)) + do nfld = 1,size(auxfile(nfcnt)%flds) + write(logunit,'(4x,a)') trim(auxfile(nfcnt)%flds(nfld)) + end do + end if - call t_startf('MED:'//subname) - call med_phases_history_write_file_inst(gcomp, 'ocn', 'alarm_history_inst_ocn', rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call t_stopf('MED:'//subname) - end subroutine med_phases_history_write_ocn + ! Create FBaccum if averaging is on + if (auxfile(nfcnt)%useavg) then - !=============================================================================== - subroutine med_phases_history_write_rof(gcomp, rc) - ! -------------------------------------- - ! Write mediator history file for rof variables - ! -------------------------------------- + ! First duplicate all fields in FBImp(ncomp,ncomp) + call ESMF_LogWrite(trim(subname)// ": calling FB_init for FBaccum(ncomp)", ESMF_LOGMSG_INFO) + call FB_init(auxfile(nfcnt)%FBaccum, is_local%wrap%flds_scalar_name, & + FBgeom=is_local%wrap%FBImp(ncomp,ncomp), STflds=is_local%wrap%NStateImp(ncomp), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - ! input/output variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc + ! Now remove all fields from FBAccum that are not in the input flds list + call ESMF_FieldBundleGet(is_local%wrap%FBImp(ncomp,ncomp), & + fieldCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(fieldNameList(fieldCount)) + call ESMF_FieldBundleGet(is_local%wrap%FBImp(ncomp,ncomp), & + fieldNameList=fieldNameList, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + do n = 1,size(fieldnamelist) + found = .false. + do n1 = 1,size(auxfile(nfcnt)%flds) + if (trim(fieldnamelist(n)) == trim(auxfile(nfcnt)%flds(n1))) then + found = .true. + exit + end if + end do + if (.not. found) then + call ESMF_FieldBundleRemove(auxfile(nfcnt)%FBaccum, & + fieldnamelist(n:n), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + end do + deallocate(fieldnameList) - ! local variables - character(len=*), parameter :: subname='(med_phases_history_write_rof)' - !--------------------------------------- + ! Check that FBAccum has at least one field left - if not exit + call ESMF_FieldBundleGet(auxfile(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(auxfile(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 - rc = ESMF_SUCCESS + end if - call t_startf('MED:'//subname) - call med_phases_history_write_file_inst(gcomp, 'rof', 'alarm_history_inst_rof', rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call t_stopf('MED:'//subname) - end subroutine med_phases_history_write_rof + ! 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 - !=============================================================================== - subroutine med_phases_history_write_wav(gcomp, rc) - ! -------------------------------------- - ! Write mediator history file for wav variables - ! -------------------------------------- + ! First create hclock from mclock - THIS CALL DOES NOT COPY ALARMS + call NUOPC_ModelGet(gcomp, modelClock=mclock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + auxfile(nfcnt)%hclock = ESMF_ClockCreate(mclock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! input/output variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc + ! Set alarm for auxiliary history output + ! Advance history clock to trigger alarms then reset history clock back to mcurrtime + call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_auxname', value=auxfile(nfcnt)%auxname, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(auxfile(nfcnt)%alarmname,'(a,i0)') 'alarm_'//trim(prefix) + call ESMF_ClockGet(auxfile(nfcnt)%hclock, startTime=starttime, currTime=currtime, timeStep=timestep, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_time_alarmInit(auxfile(nfcnt)%hclock, alarm, option=hist_option, opt_n=hist_n, & + reftime=starttime, alarmname=trim(auxfile(nfcnt)%alarmname), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_AlarmSet(alarm, clock=auxfile(nfcnt)%hclock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockAdvance(auxfile(nfcnt)%hclock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockSet(auxfile(nfcnt)%hclock, currtime=currtime) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (mastertask) then + write(logunit,'(a,2x,i8)') trim(subname)//" created auxiliary history alarm "//& + trim(auxfile(nfcnt)%alarmname)//" with option "//trim(hist_option)//" and frequency ",hist_n + end if - ! local variables - character(len=*), parameter :: subname='(med_phases_history_write_wav)' - !--------------------------------------- - rc = ESMF_SUCCESS + end if ! end of isPresent and isSet and if flag is on for file n + end do ! end of loop over files (1->max_auxfiles) - call t_startf('MED:'//subname) - call med_phases_history_write_file_inst(gcomp, 'wav', 'alarm_history_inst_wav', rc) + ! Set number of aux files for this component + num_auxfiles(ncomp) = nfcnt + + ! Get file name variables + ! TODO: these are general settings that should be set outside of this system + ! These should be moved outside of this modeul + call NUOPC_CompAttributeGet(gcomp, name='case_name', value=case_name, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call t_stopf('MED:'//subname) - end subroutine med_phases_history_write_wav + 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 + + if (mastertask) write(logunit,*) + + end subroutine med_phases_history_init_aux !=============================================================================== - subroutine med_phases_history_write_file_inst(gcomp, type, alarmname, rc) + subroutine med_phases_history_write_hfile(gcomp, comptype, hclock, alarmname, doavg, rc) ! input/output variables type(ESMF_GridComp) , intent(inout) :: gcomp - character(len=*) , intent(in) :: type + character(len=*) , intent(in) :: comptype + type(ESMF_Clock) , intent(in) :: hclock character(len=*) , intent(in) :: alarmname + logical , intent(in) :: doavg integer , intent(out) :: rc ! local variables + type(InternalState) :: is_local + type(ESMF_VM) :: vm type(ESMF_Clock) :: mclock type(ESMF_Alarm) :: alarm - type(ESMF_VM) :: vm - type(ESMF_Calendar) :: calendar ! calendar type - type(InternalState) :: is_local + type(ESMF_Time) :: starttime + type(ESMF_Time) :: currtime + type(ESMF_Time) :: nexttime + type(ESMF_Calendar) :: calendar ! calendar type + type(ESMF_TimeInterval) :: timediff(2) ! time bounds upper and lower relative to start + type(ESMF_TimeInterval) :: ringInterval ! alarm interval + real(r8) :: tbnds(2) ! CF1.0 time bounds integer :: i,j,m,n - integer :: nx,ny ! global grid size - character(CL) :: time_units ! units of time variable + integer :: nx,ny ! global grid size + character(CL) :: time_units ! units of time variable character(CL) :: hist_file - real(r8) :: days_since ! Time interval since reference time - real(r8) :: tbnds(2) ! CF1.0 time bounds - logical :: whead,wdata ! for writing restart/history cdf files + real(r8) :: days_since ! Time interval since reference time + real(r8) :: avg_time ! Time coordinate output + logical :: whead,wdata ! for writing restart/history cdf files integer :: iam - character(len=*), parameter :: subname='(med_phases_history_write_file)' + logical :: write_now + integer :: yr,mon,day,sec ! time units + character(len=*), parameter :: subname='(med_phases_history_write_hfile)' !--------------------------------------- rc = ESMF_SUCCESS @@ -484,32 +627,85 @@ subroutine med_phases_history_write_file_inst(gcomp, type, alarmname, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Get the history file alarm - call NUOPC_ModelGet(gcomp, modelClock=mclock, rc=rc) + ! Get the history file alarm and determine if alarm is ringing + ! call NUOPC_ModelGet(gcomp, modelClock=mclock, rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockGetAlarm(hclock, alarmname=trim(alarmname), alarm=alarm, 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 - if (dbug_flag > 2) then - call med_phases_history_output_alarminfo(mclock, alarm, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - ! Check if history alarm is ringing - and if so write the mediator history file if (ESMF_AlarmIsRinging(alarm, rc=rc)) then if (ChkErr(rc,__LINE__,u_FILE_u)) return - + if (debug_alarms) then + call med_phases_history_output_alarminfo(hclock, alarm, alarmname, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + ! Set write_now flag + write_now = .true. ! Turn ringer off call ESMF_AlarmRingerOff(alarm, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + write_now = .false. + end if - ! Determine history file name and time units - call med_phases_history_get_filename(gcomp, type, hist_file, time_units, days_since, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! Create history file + ! Accumulate if alarm is not on - other wise average + if (doavg) then + do n = 1,ncomps + if (comptype == 'all' .or. comptype == trim(compname(n))) then + ! accumulate + if (ESMF_FieldBundleIsCreated(avgfiles_import(n)%FBaccum)) then + call FB_accum(avgfiles_import(n)%FBaccum, is_local%wrap%FBImp(n,n), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + avgfiles_import(n)%accumcnt = avgfiles_import(n)%accumcnt + 1 + end if + if (ESMF_FieldBundleIsCreated(avgfiles_export(n)%FBaccum)) then + call FB_accum(avgfiles_export(n)%FBaccum, is_local%wrap%FBExp(n), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + avgfiles_export(n)%accumcnt = avgfiles_export(n)%accumcnt + 1 + end if + if (write_now) then + if (ESMF_FieldBundleIsCreated(avgfiles_import(n)%FBaccum)) then + call FB_average(avgfiles_import(n)%FBaccum, avgfiles_import(n)%accumcnt, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + avgfiles_import(n)%accumcnt = 0 + end if + if (ESMF_FieldBundleIsCreated(avgfiles_export(n)%FBaccum)) then + call FB_average(avgfiles_export(n)%FBaccum, avgfiles_export(n)%accumcnt, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + avgfiles_export(n)%accumcnt = 0 + end if + end if + end if + end do + end if + + ! Check if history alarm is ringing - and if so write the mediator history file + if (write_now) then + + ! Determine history file name and time units + call med_phases_history_get_filename(gcomp, doavg, comptype, hist_file, time_units, days_since, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Set tbnds and avg_time if doing averaging + if (doavg) then + call ESMF_ClockGet(hclock, currtime=currtime, starttime=starttime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockGetNextTime(hclock, nextTime=nexttime, 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 - ringinterval - starttime + call ESMF_TimeIntervalGet(timediff(2), d_r8=tbnds(2), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeIntervalGet(timediff(1), d_r8=tbnds(1), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + avg_time = 0.5_r8 * (tbnds(1) + tbnds(2)) + end if + + ! Create history file call med_io_wopen(hist_file, vm, iam, clobber=.true.) do m = 1,2 - if (m == 1) then whead = .true. wdata = .false. @@ -519,73 +715,96 @@ subroutine med_phases_history_write_file_inst(gcomp, type, alarmname, rc) call med_io_enddef(hist_file) end if - ! write time values (tbnds does not appear in instantaneous output) - call ESMF_ClockGet(mclock, calendar=calendar, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_write(hist_file, iam, time_units=time_units, calendar=calendar, time_val=days_since, & - nt=1, whead=whead, wdata=wdata, rc=rc) + ! Write time values (tbnds does not appear in instantaneous output) + call ESMF_ClockGet(hclock, calendar=calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (doavg) then + call med_io_write(hist_file, iam, time_units=time_units, calendar=calendar, time_val=avg_time, & + nt=1, tbnds=tbnds, whead=whead, wdata=wdata, 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=days_since, & + nt=1, whead=whead, wdata=wdata, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if - ! write field bundles - do n = 1,ncomps - if (type == 'all' .or. type == trim(compname(n))) then + ! Write import and export field bundles + do n = 2,ncomps ! skip the mediator here + if (comptype == 'all' .or. comptype == trim(compname(n))) then if (is_local%wrap%comp_present(n)) then + nx = is_local%wrap%nx(n) + ny = is_local%wrap%ny(n) 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) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (doavg) then + call med_io_write(hist_file, iam, avgfiles_import(n)%FBaccum, & + nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, & + pre=trim(compname(n))//'Imp', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + 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) + 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 (ChkErr(rc,__LINE__,u_FILE_u)) return + if (doavg) then + call med_io_write(hist_file, iam, avgfiles_export(n)%FBaccum, & + nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, & + pre=trim(compname(n))//'Exp', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + 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 (ChkErr(rc,__LINE__,u_FILE_u)) return + end if endif + endif + end if + enddo + + ! Write mediator fractions + ! Also write atm/ocn fluxes and ocean albedoes if field bundles are created + if (.not. doavg) then + if (comptype == 'all' .or. comptype == 'med') then + do n = 2,ncomps ! skip the mediator here + nx = is_local%wrap%nx(n) + ny = is_local%wrap%ny(n) 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) + 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 - endif - 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) - 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) - 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 - if (type == 'all' .or. type == 'atm') then - 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 - 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) + end do + 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) + 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) + 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 + 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) + end if end if end if + end do ! end of loop over m ! Close file @@ -594,371 +813,766 @@ subroutine med_phases_history_write_file_inst(gcomp, type, alarmname, rc) end if ! end of if-alarm is ringingblock - end subroutine med_phases_history_write_file_inst + end subroutine med_phases_history_write_hfile !=============================================================================== - subroutine med_phases_history_write_aux(gcomp, rc) + subroutine med_phases_history_write_hfileaux(gcomp, case_name, inst_tag, & + nfile_index, comp_index, auxfile, rc) + + ! input/output variables + type(ESMF_GridComp) , intent(inout) :: gcomp + character(len=*) , intent(in) :: case_name + character(len=*) , intent(in) :: inst_tag + integer , intent(in) :: nfile_index + integer , intent(in) :: comp_index + type(auxfile_type) , intent(inout) :: auxfile + integer , intent(out) :: rc + + ! local variables + type(InternalState) :: is_local + type(ESMF_VM) :: vm + type(ESMF_Clock) :: mclock + type(ESMF_Alarm) :: alarm + type(ESMF_Time) :: starttime + type(ESMF_Time) :: currtime + type(ESMF_Time) :: nexttime + type(ESMF_Calendar) :: calendar ! calendar type + type(ESMF_TimeInterval) :: timediff(2) ! time bounds upper and lower relative to start + type(ESMF_TimeInterval) :: ringInterval ! alarm interval + character(CS) :: timestr ! yr-mon-day-sec string + character(CL) :: time_units ! units of time variable + real(r8) :: avg_time ! Time coordinate output + integer :: nx,ny ! global grid size + logical :: whead,wdata ! for writing restart/history cdf files + logical :: write_now ! if true, write time sample to file + integer :: iam ! mpi task + integer :: start_ymd ! Starting date YYYYMMDD + integer :: yr,mon,day,sec ! time units + real(r8) :: tbnds(2) ! CF1.0 time bounds + character(len=*), parameter :: subname='(med_phases_history_write_hfileaux)' + !--------------------------------------- + + rc = ESMF_SUCCESS + + ! Get the communicator and localpet + 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 the internal state + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Determine time info + ! Use nexttime rather than currtime for the time difference form + ! start since that is the time at the end of the time step + call ESMF_ClockGet(auxfile%hclock, currtime=currtime, starttime=starttime, calendar=calendar, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockGetNextTime(auxfile%hclock, nextTime=nexttime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockGetAlarm(auxfile%hclock, alarmname=trim(auxfile%alarmname), alarm=alarm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + write_now = .false. + if (ESMF_AlarmIsRinging(alarm, rc=rc)) then + write_now = .true. + call ESMF_AlarmRingerOff( alarm, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (debug_alarms) then + call med_phases_history_output_alarminfo(auxfile%hclock, alarm, auxfile%alarmname, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + call ESMF_AlarmGet(alarm, ringInterval=ringInterval, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + timediff(2) = currtime - starttime + timediff(1) = currtime - starttime - ringinterval + call ESMF_TimeIntervalGet(timediff(2), d_r8=tbnds(2), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeIntervalGet(timediff(1), d_r8=tbnds(1), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + avg_time = 0.5_r8 * (tbnds(1) + tbnds(2)) + end if + + if (mastertask .and. debug_alarms) then + if (write_now) then + write(logunit,'(a)')' alarmname = '//trim(auxfile%alarmname)//' is ringing' + write(logunit,'(a,f13.5,a,f13.5)')' tbnds(1) = ',tbnds(1),' tbnds(2) = ',tbnds(2) + else + write(logunit,'(a)')' alarmname = '//trim(auxfile%alarmname)//' is not ringing' + 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(logunit,'(a,4(i6,2x))')' nexttime is ',yr,mon,day,sec + call ESMF_TimeGet(currtime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(logunit,'(a,4(i6,2x))')' currtime is ',yr,mon,day,sec + call ESMF_TimeGet(starttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(logunit,'(a,4(i6,2x))')' starttime is ',yr,mon,day,sec + end if + + ! Do accumulation and average if required + if (auxfile%useavg) then + call FB_accum(auxfile%FBaccum, is_local%wrap%FBImp(comp_index,comp_index), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + auxfile%accumcnt = auxfile%accumcnt + 1 + + if (write_now) then + call FB_average(auxfile%FBaccum, auxfile%accumcnt, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + auxfile%accumcnt = 0 + endif + end if + + ! Write time sample to file + if ( write_now ) then + + ! Increment number of time samples on file + auxfile%nt = auxfile%nt + 1 + + ! Set shorthand variables + nx = is_local%wrap%nx(comp_index) + ny = is_local%wrap%ny(comp_index) + + ! Write header + if (auxfile%nt == 1) then + + ! determine history file name + call ESMF_ClockGet(auxfile%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(timestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + write(auxfile%histfile, "(8a)") & + trim(case_name),'.cpl',trim(inst_tag),'.hx.', trim(auxfile%auxname),'.',trim(timestr), '.nc' + + ! open file + call med_io_wopen(auxfile%histfile, vm, iam, file_ind=nfile_index, clobber=.true.) + + ! define 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 + + ! define time variables + call med_io_write(auxfile%histfile, iam, time_units, calendar, avg_time, & + nt=auxfile%nt, tbnds=tbnds, whead=.true., wdata=.false., file_ind=nfile_index, 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(auxfile%histfile, iam, is_local%wrap%FBimp(comp_index,comp_index), & + nx=nx, ny=ny, nt=auxfile%nt, whead=.true., wdata=.false., pre=trim(compname(comp_index))//'Imp', & + flds=auxfile%flds, file_ind=nfile_index, use_float=.true., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! end definition phase + call med_io_enddef(auxfile%histfile, file_ind=nfile_index) + + end if + + ! Write time variables for time nt + call med_io_write(auxfile%histfile, iam, time_units, calendar, avg_time, & + nt=auxfile%nt, tbnds=tbnds, whead=.false., wdata=.true., file_ind=nfile_index, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Write data variables for time nt + if (auxfile%useavg) then + call med_io_write(auxfile%histfile, iam, auxfile%FBaccum, & + nx=nx, ny=ny, nt=auxfile%nt, whead=.false., wdata=.true., pre=trim(compname(comp_index))//'Imp', & + flds=auxfile%flds, file_ind=nfile_index, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_reset(auxfile%FBaccum, value=czero, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call med_io_write(auxfile%histfile, iam, is_local%wrap%FBimp(comp_index,comp_index), & + nx=nx, ny=ny, nt=auxfile%nt, whead=.false., wdata=.true., pre=trim(compname(comp_index))//'Imp', & + flds=auxfile%flds, file_ind=nfile_index, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + ! Close file + if (auxfile%nt == auxfile%ntperfile) then + call med_io_close(auxfile%histfile, iam, file_ind=nfile_index, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + auxfile%nt = 0 + end if + + end if ! end of write_now if-block + + end subroutine med_phases_history_write_hfileaux + + !=============================================================================== + subroutine med_phases_history_write_inst_all(gcomp, rc) ! -------------------------------------- - ! Write mediator history file for wav variables + ! Write mediator history file for all variables + ! This is a phase called by the run sequence ! -------------------------------------- + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + ! local variables + logical :: first_time = .true. + character(len=*), parameter :: subname='(med_phases_history_write)' + !--------------------------------------- + rc = ESMF_SUCCESS + call t_startf('MED:'//subname) + if (first_time) then + call med_phases_history_init_inst(gcomp, 'alarm_history_inst_all', hclock_inst_all, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + first_time = .false. + end if + call ESMF_ClockAdvance(hclock_inst_all, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_phases_history_write_hfile(gcomp, 'all', hclock_inst_all, & + 'alarm_history_inst_all', .false., rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call t_stopf('MED:'//subname) + end subroutine med_phases_history_write_inst_all + + subroutine med_phases_history_write_inst_med(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 ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc + ! local variables + logical :: first_time = .true. + character(CL) :: alarmname + character(len=*), parameter :: subname='(med_phases_history_write_med)' + !--------------------------------------- + rc = ESMF_SUCCESS + call t_startf('MED:'//subname) + alarmname = 'alarm_history_inst_'//trim(compname(compmed)) + if (first_time) then + call med_phases_history_init_inst(gcomp, trim(alarmname), hclock_inst_comp(compmed), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + first_time = .false. + end if + call ESMF_ClockAdvance(hclock_inst_comp(compmed), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_phases_history_write_hfile(gcomp, trim(compname(compmed)), hclock_inst_comp(compmed), & + trim(alarmname), .false., rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call t_stopf('MED:'//subname) + end subroutine med_phases_history_write_inst_med + subroutine med_phases_history_write_inst_atm(gcomp, rc) + ! Write mediator history file for atm variables + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc ! local variables - type(InternalState) :: is_local - type(ESMF_Clock) :: mclock ! mediator clock - type(ESMF_TimeInterval) :: alarmInterval ! alarm interval - type(ESMF_Time) :: nextAlarm ! next restart alarm time - type(ESMF_Alarm) :: alarm ! new alarm - type(ESMF_Time) :: currTime ! current Time - character(CL) :: auxflds ! colon delimited string of field names - character(CS) :: cvalue ! temporary for input attributes - integer :: n,n1 ! field counter - integer :: nfcnt ! file counter - integer :: nfile ! file counter - logical :: isPresent ! is attribute present - logical :: isSet ! is attribute set - character(CS) :: prefix ! prefix for aux history file name - logical :: found ! temporary logical - integer :: fieldcount - character(CS), allocatable :: fieldNameList(:) - logical :: first_time = .true. - character(len=*), parameter :: subname='(med_phases_history_write_aux)' + logical :: first_time = .true. + character(CL) :: alarmname + character(len=*), parameter :: subname='(med_phases_history_write_inst_atm)' !--------------------------------------- rc = ESMF_SUCCESS + call t_startf('MED:'//subname) + alarmname = 'alarm_history_inst_'//trim(compname(compatm)) + if (first_time) then + call med_phases_history_init_inst(gcomp, trim(alarmname), hclock_inst_comp(compatm), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + first_time = .false. + end if + call ESMF_ClockAdvance(hclock_inst_comp(compatm), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_phases_history_write_hfile(gcomp, trim(compname(compatm)), hclock_inst_comp(compatm), & + trim(alarmname), .false., rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call t_stopf('MED:'//subname) + end subroutine med_phases_history_write_inst_atm + subroutine med_phases_history_write_inst_ice(gcomp, rc) + ! Write mediator history file for ice variables + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + ! local variables + logical :: first_time = .true. + character(CL) :: alarmname + character(len=*), parameter :: subname='(med_phases_history_write_inst_ice)' + !--------------------------------------- + rc = ESMF_SUCCESS call t_startf('MED:'//subname) + alarmname = 'alarm_history_inst_'//trim(compname(compice)) + if (first_time) then + call med_phases_history_init_inst(gcomp, trim(alarmname), hclock_inst_comp(compice), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + first_time = .false. + end if + call ESMF_ClockAdvance(hclock_inst_comp(compice), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_phases_history_write_hfile(gcomp, trim(compname(compice)), hclock_inst_comp(compice),& + trim(alarmname), .false., rc) + call t_stopf('MED:'//subname) + end subroutine med_phases_history_write_inst_ice + subroutine med_phases_history_write_inst_glc(gcomp, rc) + ! Write mediator history file for glc variables + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + ! local variables + logical :: first_time = .true. + character(CL) :: alarmname + character(len=*), parameter :: subname='(med_phases_history_write_inst_glc)' + !--------------------------------------- + rc = ESMF_SUCCESS + call t_startf('MED:'//subname) + alarmname = 'alarm_history_inst_'//trim(compname(compglc)) if (first_time) then + call med_phases_history_init_inst(gcomp, trim(alarmname), hclock_inst_comp(compglc), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + first_time = .false. + end if + call ESMF_ClockAdvance(hclock_inst_comp(compglc), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_phases_history_write_hfile(gcomp, trim(compname(compglc)), hclock_inst_comp(compglc), & + trim(alarmname), .false., rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call t_stopf('MED:'//subname) + end subroutine med_phases_history_write_inst_glc - ! Get the internal state - nullify(is_local%wrap) - call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + subroutine med_phases_history_write_inst_lnd(gcomp, rc) + ! Write mediator history file for lnd variables + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + ! local variables + logical :: first_time = .true. + character(CL) :: alarmname + character(len=*), parameter :: subname='(med_phases_history_write_inst_lnd)' + !--------------------------------------- + rc = ESMF_SUCCESS + call t_startf('MED:'//subname) + alarmname = 'alarm_history_inst_'//trim(compname(complnd)) + if (first_time) then + call med_phases_history_init_inst(gcomp, trim(alarmname), hclock_inst_comp(complnd), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + first_time = .false. + end if + call ESMF_ClockAdvance(hclock_inst_comp(complnd), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_phases_history_write_hfile(gcomp, trim(compname(complnd)), hclock_inst_comp(complnd), & + trim(alarmname), .false., rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call t_stopf('MED:'//subname) + end subroutine med_phases_history_write_inst_lnd - ! Get the mediator clock and the current time - call NUOPC_ModelGet(gcomp, modelClock=mclock, rc=rc) + subroutine med_phases_history_write_inst_ocn(gcomp, rc) + ! Write mediator history file for ocn variables + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + ! local variables + logical :: first_time = .true. + character(CL) :: alarmname + character(len=*), parameter :: subname='(med_phases_history_write_inst_ocn)' + !--------------------------------------- + rc = ESMF_SUCCESS + call t_startf('MED:'//subname) + alarmname = 'alarm_history_inst_'//trim(compname(compocn)) + if (first_time) then + call med_phases_history_init_inst(gcomp, trim(alarmname), hclock_inst_comp(compocn), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockGet(mclock, currtime=currtime, rc=rc) + first_time = .false. + end if + call ESMF_ClockAdvance(hclock_inst_comp(compocn), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_phases_history_write_hfile(gcomp, trim(compname(compocn)), hclock_inst_comp(compocn), & + trim(alarmname), .false., rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call t_stopf('MED:'//subname) + end subroutine med_phases_history_write_inst_ocn + + subroutine med_phases_history_write_inst_rof(gcomp, rc) + ! Write mediator history file for rof variables + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + ! local variables + logical :: first_time = .true. + character(CL) :: alarmname + character(len=*), parameter :: subname='(med_phases_history_write_inst_rof)' + !--------------------------------------- + rc = ESMF_SUCCESS + call t_startf('MED:'//subname) + alarmname = 'alarm_history_inst_'//trim(compname(comprof)) + if (first_time) then + call med_phases_history_init_inst(gcomp, trim(alarmname), hclock_inst_comp(comprof), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + first_time = .false. + end if + call ESMF_ClockAdvance(hclock_inst_comp(comprof), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_phases_history_write_hfile(gcomp, trim(compname(comprof)), hclock_inst_comp(comprof), & + trim(alarmname), .false., rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call t_stopf('MED:'//subname) + end subroutine med_phases_history_write_inst_rof - nfcnt = 0 - do nfile = 1,maxfiles - write(prefix,'(a,i0)') 'histaux_atm2med_file',nfile - call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_flag', 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)//'_flag', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (trim(cvalue) == 'on') then - ! Increment nfcnt - nfcnt = nfcnt + 1 + subroutine med_phases_history_write_inst_wav(gcomp, rc) + ! Write mediator history file for wav variables + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + ! local variables + logical :: first_time = .true. + character(CL) :: alarmname + character(len=*), parameter :: subname='(med_phases_history_write_inst_wav)' + !--------------------------------------- + rc = ESMF_SUCCESS + call t_startf('MED:'//subname) + alarmname = 'alarm_history_inst_'//trim(compname(compwav)) + if (first_time) then + call med_phases_history_init_inst(gcomp, trim(alarmname), hclock_inst_comp(compwav), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + first_time = .false. + end if + call ESMF_ClockAdvance(hclock_inst_comp(compwav), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_phases_history_write_hfile(gcomp, trim(compname(compwav)), hclock_inst_comp(compwav), & + trim(alarmname), .false., rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call t_stopf('MED:'//subname) + rc = ESMF_SUCCESS + end subroutine med_phases_history_write_inst_wav - ! Determine content of auxfiles(nfcnt) - auxfiles(nfcnt)%ncomp = compatm - call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_auxname', value=auxfiles(nfcnt)%auxname, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_ntperfile', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) auxfiles(nfcnt)%ntperfile - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_useavg', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) auxfiles(nfcnt)%useavg - call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_flds', value=auxflds, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + !=============================================================================== + subroutine med_phases_history_write_avg_atm(gcomp, rc) + ! Write mediator history file for atm variables + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + ! local variables + integer :: n + character(len=*), parameter :: subname='(med_phases_history_write_avg_atm)' + !--------------------------------------- + rc = ESMF_SUCCESS + call t_startf('MED:'//subname) + call med_phases_history_write_hfile(gcomp, 'atm', hclock_avg_comp(compatm), & + 'alarm_history_avg_atm', .true., rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call t_stopf('MED:'//subname) + end subroutine med_phases_history_write_avg_atm - ! Set history alarm for this file - advance nextAlarm so it won't ring on the first timestep - call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_deltat', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) auxfiles(nfcnt)%deltat - call ESMF_TimeIntervalSet(AlarmInterval, s=auxfiles(nfcnt)%deltat, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - nextAlarm = currtime - AlarmInterval - do while (nextAlarm <= currtime) - nextAlarm = nextAlarm + AlarmInterval - enddo - write(auxfiles(nfcnt)%alarmname,'(a,i0)') 'alarm_auxhist_'//trim(auxfiles(nfcnt)%auxname)//'_', & - auxfiles(nfcnt)%deltat - if (mastertask) then - write(logunit,'(a)') trim(subname) //' creating auxiliary history alarm '//& - trim(auxfiles(nfcnt)%alarmname) - end if - alarm = ESMF_AlarmCreate( name=auxfiles(nfcnt)%alarmname, clock=mclock, & - ringTime=nextAlarm, ringInterval=alarmInterval, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + subroutine med_phases_history_write_avg_ice(gcomp, rc) + ! Write mediator history file for ice variables + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + ! local variables + character(len=*), parameter :: subname='(med_phases_history_write_avg_ice)' + !--------------------------------------- + rc = ESMF_SUCCESS + call t_startf('MED:'//subname) + call med_phases_history_write_hfile(gcomp, 'ice', hclock_avg_comp(compice), & + 'alarm_history_avg_ice', .true., rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call t_stopf('MED:'//subname) + end subroutine med_phases_history_write_avg_ice - ! Translate the colon deliminted string (auxflds) into a character array (fieldnamelist) - ! Note that the following call allocates the memory for fieldnamelist - call med_phases_history_setauxflds(auxflds, fieldnamelist, rc) - - ! Remove all fields from fieldnamelist that are not in FBImp(compatm,compatm) - fieldCount = size(fieldnamelist) - do n = 1,fieldcount - if (.not. FB_fldchk(is_local%wrap%FBImp(compatm,compatm), trim(fieldnamelist(n)), rc)) then - do n1 = n, fieldCount-1 - fieldnamelist(n1) = fieldnamelist(n1+1) - end do - fieldCount = fieldCount - 1 - end if - end do + subroutine med_phases_history_write_avg_glc(gcomp, rc) + ! Write mediator history file for glc variables + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + ! local variables + character(len=*), parameter :: subname='(med_phases_history_write_avg_glc)' + !--------------------------------------- + rc = ESMF_SUCCESS + call t_startf('MED:'//subname) + call med_phases_history_write_hfile(gcomp, 'glc', hclock_avg_comp(compglc), & + 'alarm_history_avg_glc', .true., rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call t_stopf('MED:'//subname) + end subroutine med_phases_history_write_avg_glc - ! Create auxfiles(nfcnt)%flds array - allocate(auxfiles(nfcnt)%flds(fieldcount)) - do n = 1,fieldcount - auxfiles(nfcnt)%flds(n) = trim(fieldnamelist(n)) - end do + subroutine med_phases_history_write_avg_lnd(gcomp, rc) + ! Write mediator history file for lnd variables + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + ! local variables + character(len=*), parameter :: subname='(med_phases_history_write_avg_lnd)' + !--------------------------------------- + rc = ESMF_SUCCESS + call t_startf('MED:'//subname) + call med_phases_history_write_hfile(gcomp, 'lnd', hclock_avg_comp(complnd), & + 'alarm_history_avg_lnd', .true., rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call t_stopf('MED:'//subname) + end subroutine med_phases_history_write_avg_lnd - ! Deallocate memory from fieldnamelist - deallocate(fieldnamelist) ! this was allocated in med_phases_history_setauxflds + subroutine med_phases_history_write_avg_ocn(gcomp, rc) + ! Write mediator history file for ocn variables + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + ! local variables + character(len=*), parameter :: subname='(med_phases_history_write_avg_ocn)' + !--------------------------------------- + rc = ESMF_SUCCESS + call t_startf('MED:'//subname) + call med_phases_history_write_hfile(gcomp, 'ocn', hclock_avg_comp(compocn), & + 'alarm_history_avg_ocn', .true., rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call t_stopf('MED:'//subname) + end subroutine med_phases_history_write_avg_ocn - ! Create FBaccum if averaging is on - if (auxfiles(nfcnt)%useavg) then - ! First duplicate all fields in FBImp(compatm,compatm) - call ESMF_LogWrite(trim(subname)// ": calling FB_init for FBaccum(compatm)", ESMF_LOGMSG_INFO) - call FB_init(auxfiles(nfcnt)%FBaccum, is_local%wrap%flds_scalar_name, & - FBgeom=is_local%wrap%FBImp(compatm,compatm), STflds=is_local%wrap%NStateImp(compatm), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + subroutine med_phases_history_write_avg_rof(gcomp, rc) + ! Write mediator history file for rof variables + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + ! local variables + character(len=*), parameter :: subname='(med_phases_history_write_avg_rof)' + !--------------------------------------- + rc = ESMF_SUCCESS + call t_startf('MED:'//subname) + call med_phases_history_write_hfile(gcomp, 'rof', hclock_avg_comp(comprof), & + 'alarm_history_avg_rof', .true., rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call t_stopf('MED:'//subname) + end subroutine med_phases_history_write_avg_rof - ! Now remove all fields from FBAccum that are not in the input flds list - call ESMF_FieldBundleGet(is_local%wrap%FBImp(compatm,compatm), fieldCount=fieldCount, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - allocate(fieldNameList(fieldCount)) - call ESMF_FieldBundleGet(is_local%wrap%FBImp(compatm,compatm), fieldNameList=fieldNameList, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - do n = 1,size(fieldnamelist) - found = .false. - do n1 = 1,size(auxfiles(nfcnt)%flds) - if (trim(fieldnamelist(n)) == trim(auxfiles(nfcnt)%flds(n1))) then - found = .true. - exit - end if - end do - if (.not. found) then - call ESMF_FieldBundleRemove(auxfiles(nfcnt)%FBaccum, fieldnamelist(n:n), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end if - end do - deallocate(fieldnameList) + subroutine med_phases_history_write_avg_wav(gcomp, rc) + ! Write mediator history file for wav variables - end if - end if - end if - end do - nfiles = nfcnt + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc - ! Get file name variables - call NUOPC_CompAttributeGet(gcomp, name='case_name', value=case_name, rc=rc) + ! local variables + logical :: first_time = .true. + character(CL) :: alarmname + character(len=*), parameter :: subname='(med_phases_history_write_avg_wav)' + !--------------------------------------- + rc = ESMF_SUCCESS + call t_startf('MED:'//subname) + call med_phases_history_write_hfile(gcomp, 'wav', hclock_avg_comp(compwav), & + 'alarm_history_avg_wav', .true., rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call t_stopf('MED:'//subname) + end subroutine med_phases_history_write_avg_wav + + !=============================================================================== + subroutine med_phases_history_write_aux_atm(gcomp, rc) + ! Write mediator history file for atm variables + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + ! local variables + logical :: first_time = .true. + integer :: n + character(len=*), parameter :: subname='(med_phases_history_write_aux_atm)' + !--------------------------------------- + rc = ESMF_SUCCESS + call t_startf('MED:'//subname) + if (first_time) then + if (mastertask) then + write(logunit,'(a)') trim(subname) // 'Initialize auxiliary history file and alarms for atm' + end if + call med_phases_history_init_aux(gcomp, compatm, auxfiles(:,compatm), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + first_time = .false. + end if + do n = 1,num_auxfiles(compatm) + call ESMF_ClockAdvance(auxfiles(n,compatm)%hclock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_phases_history_write_hfileaux(gcomp, case_name, inst_tag, n, compatm, auxfiles(n,compatm), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do + call t_stopf('MED:'//subname) + end subroutine med_phases_history_write_aux_atm + + subroutine med_phases_history_write_aux_ice(gcomp, rc) + ! Write mediator history file for ice variables + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + ! local variables + logical :: first_time = .true. + integer :: n + character(len=*), parameter :: subname='(med_phases_history_write_aux_ice)' + !--------------------------------------- + rc = ESMF_SUCCESS + call t_startf('MED:'//subname) + if (first_time) then + if (mastertask) then + write(logunit,'(a)') trim(subname) // 'Initialize auxiliary history file and alarms for ice' + end if + call med_phases_history_init_aux(gcomp, compice, auxfiles(:,compice), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + first_time = .false. + end if + do n = 1,num_auxfiles(compice) + call ESMF_ClockAdvance(auxfiles(n,compice)%hclock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_phases_history_write_hfileaux(gcomp, case_name, inst_tag, n, compice, auxfiles(n,compice), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do + call t_stopf('MED:'//subname) + end subroutine med_phases_history_write_aux_ice + + subroutine med_phases_history_write_aux_glc(gcomp, rc) + ! Write mediator history file for glc variables + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + ! local variables + logical :: first_time = .true. + integer :: n + character(len=*), parameter :: subname='(med_phases_history_write_aux_glc)' + !--------------------------------------- + rc = ESMF_SUCCESS + call t_startf('MED:'//subname) + if (first_time) then + if (mastertask) then + write(logunit,'(a)') trim(subname) // 'Initialize auxiliary history file and alarms for glc' + end if + call med_phases_history_init_aux(gcomp, compglc, auxfiles(:,compglc), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + first_time = .false. + end if + do n = 1,num_auxfiles(compglc) + call ESMF_ClockAdvance(auxfiles(n,compglc)%hclock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_phases_history_write_hfileaux(gcomp, case_name, inst_tag, n, compglc, auxfiles(n,compglc), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do + call t_stopf('MED:'//subname) + end subroutine med_phases_history_write_aux_glc + + subroutine med_phases_history_write_aux_lnd(gcomp, rc) + ! Write mediator history file for lnd variables + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + ! local variables + logical :: first_time = .true. + integer :: n + character(len=*), parameter :: subname='(med_phases_history_write_aux_lnd)' + !--------------------------------------- + rc = ESMF_SUCCESS + call t_startf('MED:'//subname) + if (first_time) then + if (mastertask) then + write(logunit,'(a)') trim(subname) // 'Initialize auxiliary history file and alarms for lnd' + end if + call med_phases_history_init_aux(gcomp, complnd, auxfiles(:,complnd), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + first_time = .false. + end if + do n = 1,num_auxfiles(complnd) + call ESMF_ClockAdvance(auxfiles(n,complnd)%hclock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(gcomp, name='inst_suffix', isPresent=isPresent, rc=rc) + call med_phases_history_write_hfileaux(gcomp, case_name, inst_tag, n, complnd, auxfiles(n,complnd), 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 do + call t_stopf('MED:'//subname) + end subroutine med_phases_history_write_aux_lnd + subroutine med_phases_history_write_aux_ocn(gcomp, rc) + ! Write mediator history file for ocn variables + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + ! local variables + logical :: first_time = .true. + integer :: n + character(len=*), parameter :: subname='(med_phases_history_write_aux_ocn)' + !--------------------------------------- + rc = ESMF_SUCCESS + call t_startf('MED:'//subname) + if (first_time) then + if (mastertask) then + write(logunit,'(a)') trim(subname) // 'Initialize auxiliary history file and alarms for ocn' + end if + call med_phases_history_init_aux(gcomp, compocn, auxfiles(:,compocn), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return first_time = .false. end if - - do n = 1,nfiles - call med_phases_history_write_aux_file(gcomp, case_name, inst_tag, n, auxfiles(n), rc=rc) + do n = 1,num_auxfiles(compocn) + call ESMF_ClockAdvance(auxfiles(n,compocn)%hclock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_phases_history_write_hfileaux(gcomp, case_name, inst_tag, n, compocn, auxfiles(n,compocn), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end do - call t_stopf('MED:'//subname) + end subroutine med_phases_history_write_aux_ocn - end subroutine med_phases_history_write_aux - - !=============================================================================== - subroutine med_phases_history_write_aux_file(gcomp, case_name, inst_tag, nfile_index, auxfile, rc) - + subroutine med_phases_history_write_aux_rof(gcomp, rc) + ! Write mediator history file for rof variables ! input/output variables - type(ESMF_GridComp) , intent(inout) :: gcomp - character(len=*) , intent(in) :: case_name - character(len=*) , intent(in) :: inst_tag - integer , intent(in) :: nfile_index - type(auxfile_type) , intent(inout) :: auxfile - integer , intent(out) :: rc - + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc ! local variables - type(InternalState) :: is_local - type(ESMF_VM) :: vm - type(ESMF_Clock) :: mclock - type(ESMF_Alarm) :: alarm - type(ESMF_Time) :: starttime - type(ESMF_Time) :: currtime - type(ESMF_Calendar) :: calendar ! calendar type - type(ESMF_TimeInterval) :: timediff ! diff between current and start time - character(CS) :: timestr ! yr-mon-day-sec string - character(CL) :: time_units ! units of time variable - real(r8) :: days_since ! Time interval since reference time - real(r8) :: avg_time ! Time coordinate output - integer :: nx,ny ! global grid size - logical :: whead,wdata ! for writing restart/history cdf files - logical :: write_now ! if true, write time sample to file - integer :: iam ! mpi task - integer :: start_ymd ! Starting date YYYYMMDD - integer :: yr,mon,day,sec ! time units - integer :: diff_day,diff_sec ! time units - integer :: ncomp - character(len=*), parameter :: subname='(med_phases_history_write_aux_file)' + logical :: first_time = .true. + integer :: n + character(len=*), parameter :: subname='(med_phases_history_write_aux_rof)' !--------------------------------------- - rc = ESMF_SUCCESS - - ! Get the communicator and localpet - 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 the internal state - nullify(is_local%wrap) - call ESMF_GridCompGetInternalState(gcomp, is_local, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! Determine time info - call NUOPC_ModelGet(gcomp, modelClock=mclock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockGet(mclock, currtime=currtime, starttime=starttime, 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 - timediff = currtime - starttime - call ESMF_TimeIntervalGet(timediff, d=diff_day, s=diff_sec, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! Set shorthand variables - ncomp = auxfile%ncomp - nx = is_local%wrap%nx(ncomp) - ny = is_local%wrap%ny(ncomp) - - write_now = .false. - call ESMF_ClockGetAlarm(mclock, alarmname=trim(auxfile%alarmname), alarm=alarm, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (ESMF_AlarmIsRinging(alarm, rc=rc)) then - if (mastertask .and. dbug_flag > 1) then - write(logunit,'(a)') trim(subname) // 'alarm '//trim(auxfile%alarmname) //' is ringing' + call t_startf('MED:'//subname) + if (first_time) then + if (mastertask) then + write(logunit,'(a)') trim(subname) // 'Initialize auxiliary history file and alarms for rof' end if - write_now = .true. - call ESMF_AlarmRingerOff( alarm, rc=rc ) + call med_phases_history_init_aux(gcomp, comprof, auxfiles(:,comprof), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + first_time = .false. end if - - ! Do accumulation if needed - if (auxfile%useavg) then - if (write_now) then - call FB_average(auxfile%FBaccum, auxfile%accumcnt, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - auxfile%accumcnt = 0 - else - call FB_accum(auxfile%FBaccum, is_local%wrap%FBImp(ncomp,ncomp), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - auxfile%accumcnt = auxfile%accumcnt + 1 - endif - end if - - ! Write time sample to file - if ( write_now ) then - - ! Increment number of time samples on file - auxfile%nt = auxfile%nt + 1 - - ! Set tbnds(1) - if (diff_sec == auxfile%deltat) then - auxfile%tbnds(1) = 0._r8 - else if ( auxfile%nt == 1 ) then - auxfile%tbnds(1) = day + sec/real(SecPerDay,R8) - else - auxfile%tbnds(1) = auxfile%tbnds(2) - end if - - ! Set tbnds(2) - days_since = diff_day + diff_sec/real(SecPerDay,R8) - auxfile%tbnds(2) = days_since - - ! Determine time coordinate value - avg_time = 0.5_r8 * (auxfile%tbnds(1) + auxfile%tbnds(2)) - - ! Write header - if (auxfile%nt == 1) then - - ! determine history file name - 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(timestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec - write(auxfile%histfile, "(8a)") & - trim(case_name),'.cpl',trim(inst_tag),'.h', trim(auxfile%auxname),'.',trim(timestr), '.nc' - - ! open file - call med_io_wopen(auxfile%histfile, vm, iam, file_ind=nfile_index, clobber=.true.) - - ! define 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 - - ! define time variables - call med_io_write(auxfile%histfile, iam, time_units, calendar, avg_time, & - nt=auxfile%nt, tbnds=auxfile%tbnds, whead=.true., wdata=.false., file_ind=nfile_index, 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(auxfile%histfile, iam, is_local%wrap%FBimp(ncomp,ncomp), & - nx=nx, ny=ny, nt=auxfile%nt, whead=.true., wdata=.false., pre=trim(compname(ncomp))//'Imp', & - flds=auxfile%flds, file_ind=nfile_index, use_float=.true., rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! end definition phase - call med_io_enddef(auxfile%histfile, file_ind=nfile_index) - - end if - - ! Write time variables for time nt - call med_io_write(auxfile%histfile, iam, time_units, calendar, avg_time, & - nt=auxfile%nt, tbnds=auxfile%tbnds, whead=.false., wdata=.true., file_ind=nfile_index, rc=rc) + do n = 1,num_auxfiles(comprof) + call ESMF_ClockAdvance(auxfiles(n,comprof)%hclock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_phases_history_write_hfileaux(gcomp, case_name, inst_tag, n, comprof, auxfiles(n,comprof), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do + call t_stopf('MED:'//subname) + end subroutine med_phases_history_write_aux_rof - ! Write data variables for time nt - if (auxfile%useavg) then - call med_io_write(auxfile%histfile, iam, auxfile%FBaccum, & - nx=nx, ny=ny, nt=auxfile%nt, whead=.false., wdata=.true., pre=trim(compname(ncomp))//'Imp', & - flds=auxfile%flds, file_ind=nfile_index, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_reset(auxfile%FBaccum, value=czero, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - call med_io_write(auxfile%histfile, iam, is_local%wrap%FBimp(ncomp,ncomp), & - nx=nx, ny=ny, nt=auxfile%nt, whead=.false., wdata=.true., pre=trim(compname(ncomp))//'Imp', & - flds=auxfile%flds, file_ind=nfile_index, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - - ! Close file - if (auxfile%nt == auxfile%ntperfile) then - call med_io_close(auxfile%histfile, iam, file_ind=nfile_index, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - auxfile%nt = 0 + subroutine med_phases_history_write_aux_wav(gcomp, rc) + ! Write mediator history file for wav variables + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + ! local variables + logical :: first_time = .true. + integer :: n + character(len=*), parameter :: subname='(med_phases_history_write_aux_wav)' + !--------------------------------------- + rc = ESMF_SUCCESS + call t_startf('MED:'//subname) + if (first_time) then + if (mastertask) then + write(logunit,'(a)') trim(subname) // 'Initialize auxiliary history file and alarms for wav' end if - - end if ! end of write_now if-block - - end subroutine med_phases_history_write_aux_file + call med_phases_history_init_aux(gcomp, compwav, auxfiles(:,compwav), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + first_time = .false. + end if + do n = 1,num_auxfiles(compwav) + call ESMF_ClockAdvance(auxfiles(n,compwav)%hclock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_phases_history_write_hfileaux(gcomp, case_name, inst_tag, n, compwav, auxfiles(n,compwav), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do + call t_stopf('MED:'//subname) + end subroutine med_phases_history_write_aux_wav !=============================================================================== - subroutine med_phases_history_get_filename(gcomp, type, hist_file, time_units, days_since, rc) + subroutine med_phases_history_get_filename(gcomp, doavg, comptype, hist_file, time_units, days_since, rc) ! input/output variables type(ESMF_GridComp) , intent(inout) :: gcomp - character(len=*) , intent(in) :: type + logical , intent(in) :: doavg + character(len=*) , intent(in) :: comptype character(len=*) , intent(out) :: hist_file character(len=*) , intent(out) :: time_units real(r8) , intent(out) :: days_since ! Time interval since reference time @@ -978,6 +1592,7 @@ subroutine med_phases_history_get_filename(gcomp, type, hist_file, time_units, d logical :: isPresent character(CL) :: case_name ! case name character(CS) :: inst_tag ! instance tag + character(len=CS) :: histstr character(len=*), parameter :: subname='(med_phases_history_get_timeunits)' !--------------------------------------- @@ -1021,11 +1636,15 @@ subroutine med_phases_history_get_filename(gcomp, type, hist_file, time_units, d ! Determine history file name ! Use nexttimestr rather than currtimestr here since that is the time at the end of ! the timestep and is preferred for history file names - if (trim(type) == 'all') then - write(hist_file,"(6a)") trim(case_name), '.cpl',trim(inst_tag),'.hi.', trim(nexttimestr),'.nc' + if (doavg) then + histstr = 'ha.' else - write(hist_file,"(6a)") trim(case_name), '.cpl.'//trim(type),trim(inst_tag),'.hi.', trim(nexttimestr),'.nc' + histstr = 'hi.' + end if + if (trim(comptype) /= 'all') then + histstr = trim(histstr) // trim(comptype) // '.' end if + write(hist_file,"(6a)") trim(case_name),'.cpl.',trim(inst_tag),trim(histstr),trim(nexttimestr),'.nc' if (mastertask) then write(logunit,*) write(logunit,' (a)') trim(subname)//": writing mediator history file "//trim(hist_file) @@ -1036,60 +1655,16 @@ subroutine med_phases_history_get_filename(gcomp, type, hist_file, time_units, d end subroutine med_phases_history_get_filename !=============================================================================== - subroutine med_phases_history_output_alarminfo(mclock, alarm, rc) - - ! input/output variables - type(ESMF_Clock), intent(in) :: mclock - type(ESMF_Alarm), intent(in) :: alarm - integer , intent(out) :: rc - - ! local variables - type(ESMF_TimeInterval) :: ringInterval - integer :: ringInterval_length - type(ESMF_Time) :: currtime - type(ESMF_Time) :: nexttime - integer :: yr,mon,day,sec ! time units - character(len=CS) :: currtimestr - character(len=CS) :: nexttimestr - character(len=*), parameter :: subname='(med_phases_history_output_alarminfo)' - !--------------------------------------- - - rc = ESMF_SUCCESS - - 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) - 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 - 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) - end if - - end subroutine med_phases_history_output_alarminfo - - !=============================================================================== - subroutine med_phases_history_setauxflds(str, auxflds, rc) + subroutine med_phases_history_get_auxflds(str, flds, rc) ! input/output variables - character(len=*) , intent(in) :: str ! colon deliminted string to search - character(len=*) , allocatable, intent(out) :: auxflds(:) ! memory will be allocate for auxflds - integer , intent(out) :: rc + 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 auxflds + 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) @@ -1113,7 +1688,7 @@ subroutine med_phases_history_setauxflds(str, auxflds, rc) 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_INFO) + call ESMF_LogWrite("ERROR: invalid list = "//trim(str), ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return end if @@ -1128,8 +1703,8 @@ subroutine med_phases_history_setauxflds(str, auxflds, rc) nflds = count + 1 endif - ! allocate memory for auxflds) - allocate(auxflds(nflds)) + ! allocate memory for flds) + allocate(flds(nflds)) do k = 1,nflds ! start with whole list @@ -1148,11 +1723,56 @@ subroutine med_phases_history_setauxflds(str, auxflds, rc) i1 = i0 + i - 2 end if - ! set auxflds(k) - auxflds(k) = str(i0:i1)//" " + ! set flds(k) + flds(k) = str(i0:i1)//" " end do - end subroutine med_phases_history_setauxflds + end subroutine med_phases_history_get_auxflds + + !=============================================================================== + subroutine med_phases_history_output_alarminfo(mclock, alarm, alarmname, rc) + + ! input/output variables + type(ESMF_Clock), intent(in) :: mclock + type(ESMF_Alarm), intent(in) :: alarm + character(len=*), intent(in) :: alarmname + integer , intent(out) :: rc + + ! local variables + type(ESMF_TimeInterval) :: ringInterval + integer :: ringInterval_length + type(ESMF_Time) :: currtime + type(ESMF_Time) :: nexttime + character(len=CS) :: currtimestr + character(len=CS) :: nexttimestr + integer :: yr,mon,day,sec ! time units + character(len=*), parameter :: subname='(med_phases_history_output_alarminfo)' + !--------------------------------------- + + rc = ESMF_SUCCESS + + 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) + 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 + if (mastertask) then + write(nexttimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + write(logunit,*) + write(logunit,'(a,i8)') trim(subname)//": history alarmname "//trim(alarmname)//& + ' is ringing, interval length is ', ringInterval_length + write(logunit,'(a)') trim(subname)//": currtime = "//trim(currtimestr)//" nexttime = "//trim(nexttimestr) + end if + + end subroutine med_phases_history_output_alarminfo !=============================================================================== subroutine med_phases_history_ymds2rday_offset(currtime, rdays_offset, & From 1f40c699076bdc5f0b64f0fad57bae32868a31f2 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 8 Sep 2020 14:29:52 -0600 Subject: [PATCH 13/61] updates for time averaging --- mediator/med.F90 | 56 +++++++++++++++++---------------------- mediator/med_time_mod.F90 | 2 +- 2 files changed, 25 insertions(+), 33 deletions(-) diff --git a/mediator/med.F90 b/mediator/med.F90 index 2972675bb..049a675e8 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -82,7 +82,6 @@ subroutine SetServices(gcomp, rc) use NUOPC_Mediator , only: mediator_label_TimestampExport => label_TimestampExport use NUOPC_Mediator , only: mediator_label_SetRunClock => label_SetRunClock use NUOPC_Mediator , only: mediator_label_Finalize => label_Finalize - use med_phases_history_mod , only: med_phases_history_write use med_phases_history_mod , only: med_phases_history_write_atm use med_phases_history_mod , only: med_phases_history_write_ice use med_phases_history_mod , only: med_phases_history_write_glc @@ -90,7 +89,7 @@ subroutine SetServices(gcomp, rc) use med_phases_history_mod , only: med_phases_history_write_ocn use med_phases_history_mod , only: med_phases_history_write_rof use med_phases_history_mod , only: med_phases_history_write_wav - use med_phases_history_mod , only: med_phases_history_write_aux + use med_phases_history_mod , only: med_phases_history_write use med_phases_restart_mod , only: med_phases_restart_write use med_phases_prep_atm_mod , only: med_phases_prep_atm use med_phases_prep_ice_mod , only: med_phases_prep_ice @@ -247,13 +246,6 @@ subroutine SetServices(gcomp, rc) specPhaseLabel="med_phases_history_write_wav", specRoutine=med_phases_history_write_wav, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_aux"/), userRoutine=mediator_routine_Run, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_aux", specRoutine=med_phases_history_write_aux, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - !------------------ ! setup mediator restart phase !------------------ @@ -703,7 +695,7 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite('coupling_mode = '// trim(coupling_mode), ESMF_LOGMSG_INFO) if (mastertask) then - write(logunit,*)' Mediator Coupling Mode is ',trim(coupling_mode) + write(logunit,'(a)')' Mediator Coupling Mode is ',trim(coupling_mode) end if if (trim(coupling_mode) == 'cesm') then @@ -795,16 +787,16 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (mastertask) then - write(logunit,*) - write(logunit,*) "atm_present="//trim(atm_present) - write(logunit,*) "lnd_present="//trim(lnd_present) - write(logunit,*) "ocn_present="//trim(ocn_present) - write(logunit,*) "ice_present="//trim(ice_present) - write(logunit,*) "rof_present="//trim(rof_present) - write(logunit,*) "wav_present="//trim(wav_present) - write(logunit,*) "glc_present="//trim(glc_present) - write(logunit,*) "med_present="//trim(med_present) - write(logunit,*) + write(logunit,'(a)') + write(logunit,'(a)') "atm_present="//trim(atm_present) + write(logunit,'(a)') "lnd_present="//trim(lnd_present) + write(logunit,'(a)') "ocn_present="//trim(ocn_present) + write(logunit,'(a)') "ice_present="//trim(ice_present) + write(logunit,'(a)') "rof_present="//trim(rof_present) + write(logunit,'(a)') "wav_present="//trim(wav_present) + write(logunit,'(a)') "glc_present="//trim(glc_present) + write(logunit,'(a)') "med_present="//trim(med_present) + write(logunit,'(a)') end if call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldName", value=cvalue, rc=rc) @@ -813,7 +805,7 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldCount", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue, *) is_local%wrap%flds_scalar_num + read(cvalue,*) is_local%wrap%flds_scalar_num call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNX", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1759,8 +1751,8 @@ subroutine DataInitialize(gcomp, rc) if (mastertask) then if (dbug_flag > 5) then write(logunit,*) ' ' - write(logunit,'(A)') subname//' Allowed coupling flags' - write(logunit,'(2x,A10,20(A5))') '|from to->',(compname(n2),n2=1,ncomps) + write(logunit,'(a)') subname//' Allowed coupling flags' + write(logunit,'(2x,a10,20(a5))') '|from to->',(compname(n2),n2=1,ncomps) do n1 = 1,ncomps write(msgString,'(2x,a1,A,5x,20(L5))') '|',trim(compname(n1)),(med_coupling_allowed(n1,n2),n2=1,ncomps) do n2 = 1,len_trim(msgString) @@ -1803,7 +1795,7 @@ subroutine DataInitialize(gcomp, rc) ESMF_StateIsCreated(is_local%wrap%NStateImp(n1),rc=rc) .and. & ESMF_StateIsCreated(is_local%wrap%NStateExp(n1),rc=rc)) then - if (mastertask) write(logunit,*) subname,' initializing FBs for '//trim(compname(n1)) + if (mastertask) write(logunit,'(a)') subname,' initializing FBs for '//trim(compname(n1)) ! Create FBImp(:) with pointers directly into NStateImp(:) call FB_init_pointer(is_local%wrap%NStateImp(n1), is_local%wrap%FBImp(n1,n1), & @@ -1848,7 +1840,7 @@ subroutine DataInitialize(gcomp, rc) ESMF_StateIsCreated(is_local%wrap%NStateImp(n1),rc=rc) .and. & ESMF_StateIsCreated(is_local%wrap%NStateImp(n2),rc=rc)) then - if (mastertask) write(logunit,*) subname,' initializing FBs for '//& + if (mastertask) write(logunit,'(a)') subname,' initializing FBs for '//& trim(compname(n1))//'_'//trim(compname(n2)) call FB_init(is_local%wrap%FBImp(n1,n2), is_local%wrap%flds_scalar_name, & @@ -1900,12 +1892,12 @@ subroutine DataInitialize(gcomp, rc) call FB_init(is_local%wrap%FBMed_ocnalb_a, is_local%wrap%flds_scalar_name, & STgeom=is_local%wrap%NStateImp(compatm), fieldnamelist=fldnames, name='FBMed_ocnalb_a', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit,*) subname,' initializing FB FBMed_ocnalb_a' + if (mastertask) write(logunit,'(a)') subname,' initializing FB FBMed_ocnalb_a' call FB_init(is_local%wrap%FBMed_ocnalb_o, is_local%wrap%flds_scalar_name, & STgeom=is_local%wrap%NStateImp(compocn), fieldnamelist=fldnames, name='FBMed_ocnalb_o', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit,*) subname,' initializing FB FBMed_ocnalb_o' + if (mastertask) write(logunit,'(a)') subname,' initializing FB FBMed_ocnalb_o' deallocate(fldnames) ! The following assumes that the mediator atm/ocn flux calculation will be done on the ocean grid @@ -1917,7 +1909,7 @@ subroutine DataInitialize(gcomp, rc) name='FBImp'//trim(compname(compatm))//'_'//trim(compname(compocn)), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - if (mastertask) write(logunit,*) subname,' initializing FBs for '// & + if (mastertask) write(logunit,'(a)') subname,' initializing FBs for '// & trim(compname(compatm))//'_'//trim(compname(compocn)) end if @@ -1931,12 +1923,12 @@ subroutine DataInitialize(gcomp, rc) call FB_init(is_local%wrap%FBMed_aoflux_a, is_local%wrap%flds_scalar_name, & STgeom=is_local%wrap%NStateImp(compatm), fieldnamelist=fldnames, name='FBMed_aoflux_a', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit,*) subname,' initializing FB FBMed_aoflux_a' + if (mastertask) write(logunit,'(a)') subname,' initializing FB FBMed_aoflux_a' call FB_init(is_local%wrap%FBMed_aoflux_o, is_local%wrap%flds_scalar_name, & STgeom=is_local%wrap%NStateImp(compocn), fieldnamelist=fldnames, name='FBMed_aoflux_o', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit,*) subname,' initializing FB FBMed_aoflux_o' + if (mastertask) write(logunit,'(a)') subname,' initializing FB FBMed_aoflux_o' deallocate(fldnames) end if end if @@ -2171,7 +2163,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 @@ -2429,7 +2421,7 @@ subroutine med_finalize(gcomp, rc) rc = ESMF_SUCCESS call memcheck("med_finalize", 0, mastertask) if (mastertask) then - write(logunit,*)' SUCCESSFUL TERMINATION OF CMEPS' + write(logunit,'(a)')' SUCCESSFUL TERMINATION OF CMEPS' call med_phases_profile_finalize() end if diff --git a/mediator/med_time_mod.F90 b/mediator/med_time_mod.F90 index dc65ae666..040f17b46 100644 --- a/mediator/med_time_mod.F90 +++ b/mediator/med_time_mod.F90 @@ -238,7 +238,7 @@ subroutine med_time_alarmInit( clock, alarm, option, & endif if (mastertask) then - write(logunit,*)trim(subname) //' creating alarm '// trim(alarmname) + write(logunit,'(a)') trim(subname) //' creating alarm '// trim(alarmname) end if alarm = ESMF_AlarmCreate( name=lalarmname, clock=clock, ringTime=NextAlarm, & From 2de79421e0cd8e58a13809fc333c9e8f40bc8cdd Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 10 Sep 2020 15:01:23 -0600 Subject: [PATCH 14/61] updates to get time bounds correct --- cime_config/namelist_definition_drv.xml | 237 +++++++++++------------- mediator/med.F90 | 20 +- 2 files changed, 122 insertions(+), 135 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index d7e0d170d..e6666d084 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -1555,7 +1555,7 @@ on_if_glc_coupled_fluxes - off + off @@ -1588,7 +1588,7 @@ mapping ATM_attributes - DOMAIN description of atm grid + DOMAIN description of atm grid $ATM_DOMAIN_PATH/$ATM_DOMAIN_FILE @@ -1612,7 +1612,7 @@ mapping LND_attributes - DOMAIN description of lnd grid + DOMAIN description of lnd grid $LND_DOMAIN_PATH/$LND_DOMAIN_FILE @@ -2031,9 +2031,7 @@ char aux_hist MED_attributes - - Auxiliary mediator atm2med instantaneous history output every hour. - + Auxiliary mediator atm2med instantaneous history output every hour. off,on off @@ -2043,9 +2041,7 @@ char aux_hist MED_attributes - - Auxiliary mediator atm2med instantaneous history output every hour. - + Auxiliary mediator atm2med instantaneous history output every hour. Faxa_swndr:Faxa_swvdr:Faxa_swndf:Faxa_swvdf @@ -2054,9 +2050,7 @@ char aux_hist MED_attributes - - Auxiliary mediator atm2med interval. - + Auxiliary mediator atm2med interval. 3600 @@ -2065,20 +2059,16 @@ char aux_hist MED_attributes - - Auxiliary name identifier in history name - + Auxiliary name identifier in history name - a2x1hi + atm.1h.inst logical aux_hist MED_attributes - - If true, use time average for aux file output. - + If true, use time average for aux file output. .false. @@ -2087,9 +2077,7 @@ integer aux_hist MED_attributes - - Number of time sames per file. - + Number of time sames per file. 24 @@ -2102,9 +2090,7 @@ char aux_hist MED_attributes - - Auxiliary atm2med history output averaged over 1 hour. - + Auxiliary atm2med history output averaged over 1 hour. off,on off @@ -2114,9 +2100,7 @@ char aux_hist MED_attributes - - Auxiliary atm2med history output averaged over 1 hour. - + Auxiliary atm2med history output averaged over 1 hour. Sa_u:Sa_v @@ -2125,9 +2109,7 @@ char aux_hist MED_attributes - - Auxiliary mediator atm2med instantaneous history output every hour. - + Auxiliary mediator atm2med instantaneous history output every hour. 3600 @@ -2136,20 +2118,16 @@ char aux_hist MED_attributes - - Auxiliary name identifier in history name - + Auxiliary name identifier in history name - a2x1h + atm.1h.avrg logical aux_hist MED_attributes - - If true, use time average for aux file output. - + If true, use time average for aux file output. .true. @@ -2158,9 +2136,7 @@ char aux_hist MED_attributes - - Number of time sames per file. - + Number of time sames per file. 24 @@ -2185,9 +2161,7 @@ char aux_hist MED_attributes - - Auxiliary mediator atm2med precipitation history output every 3 hours - + Auxiliary mediator atm2med precipitation history output every 3 hours Faxa_rainc:Faxa_rainl:Faxa_snowc:Faxa_snowl @@ -2196,9 +2170,7 @@ char aux_hist MED_attributes - - Auxiliary mediator atm2med interval. - + Auxiliary mediator atm2med interval. 10800 @@ -2207,20 +2179,16 @@ char aux_hist MED_attributes - - Auxiliary name identifier in history name. - + Auxiliary name identifier in history name. - a2x3h_prec + atm.3hprec.avrg logical aux_hist MED_attributes - - If true, use time average for aux file output. - + If true, use time average for aux file output. .true. @@ -2229,9 +2197,7 @@ char aux_hist MED_attributes - - Number of time sames per file. - + Number of time sames per file. 8 @@ -2278,20 +2244,16 @@ char aux_hist MED_attributes - - Auxiliary name identifier in history name - + Auxiliary name identifier in history name - a2x3h + atm.3h.avrg logical aux_hist MED_attributes - - If true, use time average for aux file output. - + If true, use time average for aux file output. .true. @@ -2300,9 +2262,7 @@ char aux_hist MED_attributes - - Number of time sames per file. - + Number of time sames per file. 8 @@ -2315,9 +2275,7 @@ char aux_hist MED_attributes - - Auxiliary mediator a2x precipitation history output every 3 hours - + Auxiliary mediator a2x precipitation history output every 3 hours off,on off @@ -2327,9 +2285,7 @@ char aux_hist MED_attributes - - Auxiliary mediator a2x precipitation history output every 3 hours - + Auxiliary mediator a2x precipitation history output every 3 hours Faxa_bcph:Faxa_ocph:Faxa_dstwet:Faxa_dstdry:Sa_co2prog:Sa_co2diag @@ -2338,9 +2294,7 @@ char aux_hist MED_attributes - - Auxiliary mediator a2x instantaneous history output every hour. - + Auxiliary mediator atm2med output every 24 hours. 86400 @@ -2349,20 +2303,16 @@ char aux_hist MED_attributes - - Auxiliary name identifier in history name - + Auxiliary name identifier in history name - a2x24h + atm.24h.avrg logical aux_hist MED_attributes - - If true, use time average for aux file output. - + If true, use time average for aux file output. .true. @@ -2371,9 +2321,7 @@ char aux_hist MED_attributes - - Number of time sames per file. - + Number of time sames per file. 1 @@ -2386,9 +2334,7 @@ char aux_hist MED_attributes - - Auxiliary mediator l2x fields every year - + Auxiliary mediator l2x fields every lnd coupling interval off,on off @@ -2398,9 +2344,7 @@ char aux_hist MED_attributes - - Auxiliary mediator a2x precipitation history output every 3 hours - + Auxiliary mediator lnd2med output every lnd coupling interval all @@ -2409,9 +2353,7 @@ char aux_hist MED_attributes - - Auxiliary mediator l2x instantaneous history output every mediator coupling interval - + Time interval between output calls every_nstep @@ -2420,31 +2362,25 @@ char aux_hist MED_attributes - - Auxiliary name identifier in history name - + Auxiliary name identifier in history name - a2x24h + lnd.ncpl.inst logical aux_hist MED_attributes - - If true, use time average for aux file output. - + If true, use time average for aux file output. - .true. + .false. char aux_hist MED_attributes - - Number of time sames per file. - + Number of time sames per file. 1 @@ -2453,20 +2389,73 @@ + + char + aux_hist + MED_attributes + Auxiliary mediator lnd2med fields every year + off,on + + off + + + + char + aux_hist + MED_attributes + auxiliary file lnd2med output fields + + all + + + + char + aux_hist + MED_attributes + Auxiliary mediator l2x instantaneous history output every mediator coupling interval + + 1year + + + + char + aux_hist + MED_attributes + Auxiliary name identifier in history name + + lnd.1yr.avrg + + + + 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 - - turns on mediator history stream for annual sno to mediator. - + turns on mediator history stream for annual sno to mediator. none,all none - @@ -2474,9 +2463,7 @@ char aux_hist MED_attributes - - Auxiliary mediator rof2med precipitation history output every 3 hours - + Auxiliary mediator rof2med precipitation history output every 3 hours off,on off @@ -2486,20 +2473,16 @@ char aux_hist MED_attributes - - Auxiliary mediator rof2med precipitation history output. - + Auxiliary mediator rof2med precipitation history output. - all + all char aux_hist MED_attributes - - Auxiliary mediator rof2med history output time interval. - + Time interval between output calls 86400 @@ -2508,20 +2491,16 @@ char aux_hist MED_attributes - - Auxiliary name identifier in history name - + Auxiliary name identifier in history name - r2x24h + rof.24h.avrg char aux_hist MED_attributes - - If true, use time average for aux file output. - + If true, use time average for aux file output. .true. @@ -2530,9 +2509,7 @@ char aux_hist MED_attributes - - Number of time sames per file. - + Number of time sames per file. 1 diff --git a/mediator/med.F90 b/mediator/med.F90 index 049a675e8..d2e5cd1c2 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -89,6 +89,7 @@ subroutine SetServices(gcomp, rc) use med_phases_history_mod , only: med_phases_history_write_ocn use med_phases_history_mod , only: med_phases_history_write_rof use med_phases_history_mod , only: med_phases_history_write_wav + use med_phases_history_mod , only: med_phases_history_write_med use med_phases_history_mod , only: med_phases_history_write use med_phases_restart_mod , only: med_phases_restart_write use med_phases_prep_atm_mod , only: med_phases_prep_atm @@ -246,6 +247,13 @@ subroutine SetServices(gcomp, rc) specPhaseLabel="med_phases_history_write_wav", specRoutine=med_phases_history_write_wav, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & + phaseLabelList=(/"med_phases_history_write_med"/), userRoutine=mediator_routine_Run, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & + specPhaseLabel="med_phases_history_write_med", specRoutine=med_phases_history_write_med, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + !------------------ ! setup mediator restart phase !------------------ @@ -718,7 +726,7 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) 'rof_present','wav_present','glc_present','med_present'/), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - med_present = "false" + med_present = "true" atm_present = "false" lnd_present = "false" ocn_present = "false" @@ -783,7 +791,9 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeSet(gcomp, name="glc_present", value=glc_present, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeSet(gcomp, name="med_present", value=med_present, rc=rc) + + ! Mediator is always present inside the mediator + call NUOPC_CompAttributeSet(gcomp, name="med_present", value="true", rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (mastertask) then @@ -1631,12 +1641,12 @@ subroutine DataInitialize(gcomp, rc) use NUOPC , only : NUOPC_CompAttributeSet, NUOPC_IsAtTime, NUOPC_SetAttribute use NUOPC , only : NUOPC_CompAttributeGet use med_fraction_mod , only : med_fraction_init, med_fraction_set + use med_phases_history_mod , only : med_phases_history_init use med_phases_restart_mod , only : med_phases_restart_read use med_phases_prep_glc_mod , only : med_phases_prep_glc_init use med_phases_prep_atm_mod , only : med_phases_prep_atm use med_phases_ocnalb_mod , only : med_phases_ocnalb_run use med_phases_aofluxes_mod , only : med_phases_aofluxes_run - use med_phases_history_mod , only : med_phases_history_alarms_init 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_MapNorm_init, med_map_RouteHandles_init @@ -2201,9 +2211,9 @@ subroutine DataInitialize(gcomp, rc) endif !--------------------------------------- - ! Initialize mediator hitory alarms + ! Initialize mediator history files and alarms !--------------------------------------- - call med_phases_history_alarms_init(gcomp, rc) + call med_phases_history_init(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call med_phases_profile(gcomp, rc) From 7cdb56ce7ef0518be4d95f3bc6b48b2383b7e788 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 11 Sep 2020 09:39:10 -0600 Subject: [PATCH 15/61] updates for history phase names --- cime_config/namelist_definition_drv.xml | 15 +-- cime_config/runseq/gen_runseq.py | 6 +- cime_config/runseq/runseq_D.py | 4 +- cime_config/runseq/runseq_NEMS.py | 2 - cime_config/runseq/runseq_TG.py | 2 +- mediator/med.F90 | 152 +++++++++++++++++++----- mediator/med_time_mod.F90 | 2 +- 7 files changed, 134 insertions(+), 49 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index e6666d084..1bba17a44 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -2403,7 +2403,7 @@ char aux_hist MED_attributes - auxiliary file lnd2med output fields + auxiliary file lnd2med sno fields averaged over a year all @@ -2412,7 +2412,7 @@ char aux_hist MED_attributes - Auxiliary mediator l2x instantaneous history output every mediator coupling interval + Auxiliary lnd2glc fields that are averaged over a year 1year @@ -2445,17 +2445,6 @@ - - char - aux_hist - MED_attributes - turns on mediator history stream for annual sno to mediator. - none,all - - none - - - diff --git a/cime_config/runseq/gen_runseq.py b/cime_config/runseq/gen_runseq.py index 29d1616bf..56190a2bd 100644 --- a/cime_config/runseq/gen_runseq.py +++ b/cime_config/runseq/gen_runseq.py @@ -46,9 +46,9 @@ def leave_time_loop(self, leave_time, if_write_hist_rest=False ): if leave_time and self.__time_loop: _, active_depth = self.__time_loop.pop() if if_write_hist_rest or active_depth == 0: - self.__outfile.write (" MED med_phases_history_write \n" ) - self.__outfile.write (" MED med_phases_restart_write \n" ) - self.__outfile.write (" MED med_phases_profile \n" ) + self.__outfile.write (" MED med_phases_history_write_all_inst \n" ) + self.__outfile.write (" MED med_phases_restart_write \n" ) + self.__outfile.write (" MED med_phases_profile \n" ) self.__outfile.write ("@ \n" ) def __exit_sequence(self): diff --git a/cime_config/runseq/runseq_D.py b/cime_config/runseq/runseq_D.py index 5b7bcdf39..de0e596f0 100644 --- a/cime_config/runseq/runseq_D.py +++ b/cime_config/runseq/runseq_D.py @@ -50,13 +50,13 @@ def gen_runseq(case, coupling_times): runseq.add_action ("MED med_fraction_set" , run_ice) runseq.add_action ("ROF -> MED :remapMethod=redist" , run_rof) runseq.add_action ("ATM -> MED :remapMethod=redist" , run_atm) - runseq.add_action ("MED med_phases_history_write" , atm_cpl_time == ocn_cpl_time) + runseq.add_action ("MED med_phases_history_write_all_inst", atm_cpl_time == ocn_cpl_time) runseq.leave_time_loop(run_rof and (atm_cpl_time < ocn_cpl_time)) runseq.add_action ("OCN", run_ocn) runseq.add_action ("OCN -> MED :remapMethod=redist" , run_ocn) - runseq.add_action ("MED med_phases_history_write" , atm_cpl_time < ocn_cpl_time) + runseq.add_action ("MED med_phases_history_write_all_inst", atm_cpl_time < ocn_cpl_time) runseq.leave_time_loop(True) diff --git a/cime_config/runseq/runseq_NEMS.py b/cime_config/runseq/runseq_NEMS.py index f44209c41..e29eb5fa6 100644 --- a/cime_config/runseq/runseq_NEMS.py +++ b/cime_config/runseq/runseq_NEMS.py @@ -41,7 +41,6 @@ def gen_runseq(case, coupling_times): outfile.write (" MED med_phases_aofluxes_run \n") outfile.write (" MED med_phases_prep_ocn_merge \n") outfile.write (" MED med_phases_prep_ocn_accum_fast \n") - outfile.write (" MED med_phases_history_write \n") outfile.write (" MED med_phases_profile \n") outfile.write (" @ \n") outfile.write (" OCN -> MED :remapMethod=redist \n") @@ -67,7 +66,6 @@ def gen_runseq(case, coupling_times): outfile.write (" MED med_phases_aofluxes_run \n") outfile.write (" MED med_phases_prep_ocn_merge \n") outfile.write (" MED med_phases_prep_ocn_accum_fast \n") - outfile.write (" MED med_phases_history_write \n") outfile.write (" MED med_phases_profile \n") outfile.write (" @ \n") outfile.write (" MED med_phases_prep_ocn_accum_avg \n") diff --git a/cime_config/runseq/runseq_TG.py b/cime_config/runseq/runseq_TG.py index 13b60a653..fb5a14846 100644 --- a/cime_config/runseq/runseq_TG.py +++ b/cime_config/runseq/runseq_TG.py @@ -37,7 +37,7 @@ def gen_runseq(case, coupling_times): runseq.add_action ("MED -> GLC :remapMethod=redist" , med_to_glc) runseq.add_action ("GLC" , run_glc) runseq.add_action ("GLC -> MED :remapMethod=redist" , run_glc) - runseq.add_action ("MED med_phases_history_write" , True) + runseq.add_action ("MED med_phases_history_write_all_inst", True) runseq.leave_time_loop(True) diff --git a/mediator/med.F90 b/mediator/med.F90 index d2e5cd1c2..ab3aae92a 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -82,15 +82,29 @@ subroutine SetServices(gcomp, rc) use NUOPC_Mediator , only: mediator_label_TimestampExport => label_TimestampExport use NUOPC_Mediator , only: mediator_label_SetRunClock => label_SetRunClock use NUOPC_Mediator , only: mediator_label_Finalize => label_Finalize - use med_phases_history_mod , only: med_phases_history_write_atm - use med_phases_history_mod , only: med_phases_history_write_ice - use med_phases_history_mod , only: med_phases_history_write_glc - use med_phases_history_mod , only: med_phases_history_write_lnd - use med_phases_history_mod , only: med_phases_history_write_ocn - use med_phases_history_mod , only: med_phases_history_write_rof - use med_phases_history_mod , only: med_phases_history_write_wav - use med_phases_history_mod , only: med_phases_history_write_med - use med_phases_history_mod , only: med_phases_history_write + use med_phases_history_mod , only: med_phases_history_write_atm_inst + use med_phases_history_mod , only: med_phases_history_write_atm_avg + use med_phases_history_mod , only: med_phases_history_write_atm_aux + use med_phases_history_mod , only: med_phases_history_write_ice_inst + use med_phases_history_mod , only: med_phases_history_write_ice_avg + use med_phases_history_mod , only: med_phases_history_write_ice_aux + use med_phases_history_mod , only: med_phases_history_write_glc_inst + use med_phases_history_mod , only: med_phases_history_write_glc_avg + use med_phases_history_mod , only: med_phases_history_write_glc_aux + use med_phases_history_mod , only: med_phases_history_write_lnd_inst + use med_phases_history_mod , only: med_phases_history_write_lnd_avg + use med_phases_history_mod , only: med_phases_history_write_lnd_aux + use med_phases_history_mod , only: med_phases_history_write_ocn_inst + use med_phases_history_mod , only: med_phases_history_write_ocn_avg + use med_phases_history_mod , only: med_phases_history_write_ocn_aux + use med_phases_history_mod , only: med_phases_history_write_rof_inst + use med_phases_history_mod , only: med_phases_history_write_rof_avg + use med_phases_history_mod , only: med_phases_history_write_rof_aux + use med_phases_history_mod , only: med_phases_history_write_wav_inst + use med_phases_history_mod , only: med_phases_history_write_wav_avg + use med_phases_history_mod , only: med_phases_history_write_wav_aux + use med_phases_history_mod , only: med_phases_history_write_med_inst + use med_phases_history_mod , only: med_phases_history_write_all_inst use med_phases_restart_mod , only: med_phases_restart_write use med_phases_prep_atm_mod , only: med_phases_prep_atm use med_phases_prep_ice_mod , only: med_phases_prep_ice @@ -192,66 +206,150 @@ subroutine SetServices(gcomp, rc) !------------------ call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write"/), userRoutine=mediator_routine_Run, rc=rc) + phaseLabelList=(/"med_phases_history_write_all_inst"/), userRoutine=mediator_routine_Run, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write", specRoutine=med_phases_history_write, rc=rc) + specPhaseLabel="med_phases_history_write_all_inst", specRoutine=med_phases_history_write_all_inst, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_atm"/), userRoutine=mediator_routine_Run, rc=rc) + phaseLabelList=(/"med_phases_history_write_atm_inst"/), userRoutine=mediator_routine_Run, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_atm", specRoutine=med_phases_history_write_atm, rc=rc) + specPhaseLabel="med_phases_history_write_atm_inst", specRoutine=med_phases_history_write_atm_inst, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & + phaseLabelList=(/"med_phases_history_write_atm_avg"/), userRoutine=mediator_routine_Run, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & + specPhaseLabel="med_phases_history_write_atm_avg", specRoutine=med_phases_history_write_atm_avg, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & + phaseLabelList=(/"med_phases_history_write_atm_aux"/), userRoutine=mediator_routine_Run, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & + specPhaseLabel="med_phases_history_write_atm_aux", specRoutine=med_phases_history_write_atm_aux, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_ice"/), userRoutine=mediator_routine_Run, rc=rc) + phaseLabelList=(/"med_phases_history_write_ice_inst"/), userRoutine=mediator_routine_Run, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & + specPhaseLabel="med_phases_history_write_ice_inst", specRoutine=med_phases_history_write_ice_inst, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & + phaseLabelList=(/"med_phases_history_write_ice_avg"/), userRoutine=mediator_routine_Run, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & + specPhaseLabel="med_phases_history_write_ice_avg", specRoutine=med_phases_history_write_ice_avg, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & + phaseLabelList=(/"med_phases_history_write_ice_aux"/), userRoutine=mediator_routine_Run, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_ice", specRoutine=med_phases_history_write_ice, rc=rc) + specPhaseLabel="med_phases_history_write_ice_aux", specRoutine=med_phases_history_write_ice_aux, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_glc"/), userRoutine=mediator_routine_Run, rc=rc) + phaseLabelList=(/"med_phases_history_write_glc_inst"/), userRoutine=mediator_routine_Run, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & + specPhaseLabel="med_phases_history_write_glc_inst", specRoutine=med_phases_history_write_glc_inst, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & + phaseLabelList=(/"med_phases_history_write_glc_avg"/), userRoutine=mediator_routine_Run, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & + specPhaseLabel="med_phases_history_write_glc_avg", specRoutine=med_phases_history_write_glc_avg, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & + phaseLabelList=(/"med_phases_history_write_glc_aux"/), userRoutine=mediator_routine_Run, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_glc", specRoutine=med_phases_history_write_glc, rc=rc) + specPhaseLabel="med_phases_history_write_glc_aux", specRoutine=med_phases_history_write_glc_aux, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_lnd"/), userRoutine=mediator_routine_Run, rc=rc) + phaseLabelList=(/"med_phases_history_write_lnd_inst"/), userRoutine=mediator_routine_Run, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & + specPhaseLabel="med_phases_history_write_lnd_inst", specRoutine=med_phases_history_write_lnd_inst, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & + phaseLabelList=(/"med_phases_history_write_lnd_avg"/), userRoutine=mediator_routine_Run, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_lnd", specRoutine=med_phases_history_write_lnd, rc=rc) + specPhaseLabel="med_phases_history_write_lnd_avg", specRoutine=med_phases_history_write_lnd_avg, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & + phaseLabelList=(/"med_phases_history_write_lnd_aux"/), userRoutine=mediator_routine_Run, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & + specPhaseLabel="med_phases_history_write_lnd_aux", specRoutine=med_phases_history_write_lnd_aux, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_ocn"/), userRoutine=mediator_routine_Run, rc=rc) + phaseLabelList=(/"med_phases_history_write_ocn_inst"/), userRoutine=mediator_routine_Run, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & + specPhaseLabel="med_phases_history_write_ocn_inst", specRoutine=med_phases_history_write_ocn_inst, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & + phaseLabelList=(/"med_phases_history_write_ocn_avg"/), userRoutine=mediator_routine_Run, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_ocn", specRoutine=med_phases_history_write_ocn, rc=rc) + specPhaseLabel="med_phases_history_write_ocn_avg", specRoutine=med_phases_history_write_ocn_avg, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & + phaseLabelList=(/"med_phases_history_write_ocn_aux"/), userRoutine=mediator_routine_Run, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & + specPhaseLabel="med_phases_history_write_ocn_aux", specRoutine=med_phases_history_write_ocn_aux, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_rof"/), userRoutine=mediator_routine_Run, rc=rc) + phaseLabelList=(/"med_phases_history_write_rof_inst"/), userRoutine=mediator_routine_Run, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & + specPhaseLabel="med_phases_history_write_rof_inst", specRoutine=med_phases_history_write_rof_inst, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & + phaseLabelList=(/"med_phases_history_write_rof_avg"/), userRoutine=mediator_routine_Run, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_rof", specRoutine=med_phases_history_write_rof, rc=rc) + specPhaseLabel="med_phases_history_write_rof_avg", specRoutine=med_phases_history_write_rof_avg, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & + phaseLabelList=(/"med_phases_history_write_rof_aux"/), userRoutine=mediator_routine_Run, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & + specPhaseLabel="med_phases_history_write_rof_aux", specRoutine=med_phases_history_write_rof_aux, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_wav"/), userRoutine=mediator_routine_Run, rc=rc) + phaseLabelList=(/"med_phases_history_write_wav_inst"/), userRoutine=mediator_routine_Run, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & + specPhaseLabel="med_phases_history_write_wav_inst", specRoutine=med_phases_history_write_wav_inst, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & + phaseLabelList=(/"med_phases_history_write_wav_avg"/), userRoutine=mediator_routine_Run, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & + specPhaseLabel="med_phases_history_write_wav_avg", specRoutine=med_phases_history_write_wav_avg, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & + phaseLabelList=(/"med_phases_history_write_wav_aux"/), userRoutine=mediator_routine_Run, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_wav", specRoutine=med_phases_history_write_wav, rc=rc) + specPhaseLabel="med_phases_history_write_wav_aux", specRoutine=med_phases_history_write_wav_aux, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_med"/), userRoutine=mediator_routine_Run, rc=rc) + phaseLabelList=(/"med_phases_history_write_med_inst"/), userRoutine=mediator_routine_Run, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_med", specRoutine=med_phases_history_write_med, rc=rc) + specPhaseLabel="med_phases_history_write_med_inst", specRoutine=med_phases_history_write_med_inst, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ diff --git a/mediator/med_time_mod.F90 b/mediator/med_time_mod.F90 index 040f17b46..f76b71310 100644 --- a/mediator/med_time_mod.F90 +++ b/mediator/med_time_mod.F90 @@ -85,7 +85,7 @@ subroutine med_time_alarmInit( clock, alarm, option, & type(ESMF_Time) :: NextAlarm ! Next restart alarm time type(ESMF_TimeInterval) :: AlarmInterval ! Alarm interval integer :: sec - character(len=*), parameter :: subname = '(med_time_alarmInit): ' + character(len=*), parameter :: subname = ' (med_time_alarmInit): ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS From 8dfe3f41e658451e3482a2c9a9252c7c420c1c74 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 13 Sep 2020 13:35:40 -0600 Subject: [PATCH 16/61] more updates for auxiliary file writes --- cime_config/namelist_definition_drv.xml | 180 +++++++++++++++++------- mediator/med_io_mod.F90 | 6 +- 2 files changed, 130 insertions(+), 56 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 1bba17a44..d8e167552 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -1940,10 +1940,14 @@ + + + + char time - MED_attributes + ALLCOMP_attributes none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end mediator history snapshot option (used with history_n and history_ymd) @@ -1970,7 +1974,7 @@ integer time - MED_attributes + ALLCOMP_attributes sets mediator snapshot history file frequency (like restart_n) set by HIST_N in env_run.xml. @@ -2046,22 +2050,22 @@ Faxa_swndr:Faxa_swvdr:Faxa_swndf:Faxa_swvdf - + char aux_hist MED_attributes - Auxiliary mediator atm2med interval. + history option type - 3600 + nhours - + char aux_hist MED_attributes - Auxiliary name identifier in history name + history option type - atm.1h.inst + 1 @@ -2073,6 +2077,15 @@ .false. + + char + aux_hist + MED_attributes + Auxiliary name identifier in history name + + atm.1h.inst + + integer aux_hist @@ -2105,22 +2118,22 @@ Sa_u:Sa_v - + char aux_hist MED_attributes - Auxiliary mediator atm2med instantaneous history output every hour. + history option type - 3600 + nhours - + char aux_hist MED_attributes - Auxiliary name identifier in history name + history option type - atm.1h.avrg + 1 @@ -2141,6 +2154,15 @@ 24 + + char + aux_hist + MED_attributes + Auxiliary name identifier in history name + + atm.1h.avrg + + @@ -2166,22 +2188,22 @@ Faxa_rainc:Faxa_rainl:Faxa_snowc:Faxa_snowl - + char aux_hist MED_attributes - Auxiliary mediator atm2med interval. + history option type - 10800 + nhours - + char aux_hist MED_attributes - Auxiliary name identifier in history name. + history option type - atm.3hprec.avrg + 3 @@ -2202,6 +2224,15 @@ 8 + + char + aux_hist + MED_attributes + Auxiliary name identifier in history name. + + atm.3hprec.avrg + + @@ -2229,24 +2260,22 @@ 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 - - Auxiliary mediator a2x instantaneous history output every hour. - + history option type - 10800 + nhours - + char aux_hist MED_attributes - Auxiliary name identifier in history name + history option type - atm.3h.avrg + 3 @@ -2267,6 +2296,15 @@ 8 + + char + aux_hist + MED_attributes + Auxiliary name identifier in history name. + + atm.3h.avrg + + @@ -2290,22 +2328,22 @@ Faxa_bcph:Faxa_ocph:Faxa_dstwet:Faxa_dstdry:Sa_co2prog:Sa_co2diag - + char aux_hist MED_attributes - Auxiliary mediator atm2med output every 24 hours. + history option type - 86400 + ndays - + char aux_hist MED_attributes - Auxiliary name identifier in history name + history option type - atm.24h.avrg + 1 @@ -2326,6 +2364,15 @@ 1 + + char + aux_hist + MED_attributes + Auxiliary name identifier in history name + + atm.24h.avrg + + @@ -2349,22 +2396,22 @@ all - + char aux_hist MED_attributes - Time interval between output calls + history option type - every_nstep + nsteps - + char aux_hist MED_attributes - Auxiliary name identifier in history name + history option type - lnd.ncpl.inst + 1 @@ -2385,6 +2432,15 @@ 1 + + char + aux_hist + MED_attributes + Auxiliary name identifier in history name + + lnd.ncpl.inst + + @@ -2408,22 +2464,22 @@ all - + char aux_hist MED_attributes - Auxiliary lnd2glc fields that are averaged over a year + history option type - 1year + nyears - + char aux_hist MED_attributes - Auxiliary name identifier in history name + history option type - lnd.1yr.avrg + 1 @@ -2432,7 +2488,7 @@ MED_attributes If true, use time average for aux file output. - .false. + .true. @@ -2444,6 +2500,15 @@ 1 + + char + aux_hist + MED_attributes + Auxiliary name identifier in history name + + lnd.1yr.avrg + + @@ -2467,22 +2532,22 @@ all - + char aux_hist MED_attributes - Time interval between output calls + history option type - 86400 + ndays - + char aux_hist MED_attributes - Auxiliary name identifier in history name + history option type - rof.24h.avrg + 1 @@ -2503,6 +2568,15 @@ 1 + + char + aux_hist + MED_attributes + Auxiliary name identifier in history name + + rof.24h.avrg + + diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index eaebb6570..ed28ea5c4 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -287,9 +287,9 @@ subroutine med_io_close(filename, iam, file_ind, rc) ! different filename is open, abort if (iam==0) then write(logunit,*) subname,' different wfilename and filename currently open, aborting ' - write(logunit,*) 'filename = ',trim(filename) - write(logunit,*) 'wfilename = ',trim(wfilename(lfile_ind)) - write(logunit,*) 'lfile_ind = ',lfile_ind + 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 From c6abde0ecf792e37efffda342aa5dee4456889b2 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 21 Sep 2020 08:36:25 -0600 Subject: [PATCH 17/61] more cleanup of aux files --- cime_config/config_component.xml | 4 ++-- cime_config/namelist_definition_drv.xml | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index dbffe661f..386c0eea0 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -999,7 +999,7 @@ char off,low,high,max - low + off run_flags env_run.xml @@ -1008,7 +1008,7 @@ "low": some verbosity "high": more verbosity "max": all lower 16 bits - By default, the verbosity level is set to "low" + By default, the verbosity level is set to "off" diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index d8e167552..fd2cab180 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -2461,7 +2461,7 @@ MED_attributes auxiliary file lnd2med sno fields averaged over a year - all + Sl_tsrf_elev:Sl_topo_elev:Flgl_qice_elev From 8676c3b7a8a94d9daa6932ffb8b09b0255a14c28 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 5 Oct 2020 19:43:29 -0600 Subject: [PATCH 18/61] updates to get aux files working with new per file clock --- cime_config/namelist_definition_drv.xml | 16 +-- mediator/med.F90 | 163 ++++++++++++------------ mediator/med_constants_mod.F90 | 2 +- mediator/med_phases_restart_mod.F90 | 44 +++++-- mediator/med_time_mod.F90 | 2 +- 5 files changed, 119 insertions(+), 108 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index fd2cab180..756011e45 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -2031,7 +2031,7 @@ - + char aux_hist MED_attributes @@ -2099,7 +2099,7 @@ - + char aux_hist MED_attributes @@ -2167,7 +2167,7 @@ - + char aux_hist MED_attributes @@ -2237,7 +2237,7 @@ - + char aux_hist MED_attributes @@ -2309,7 +2309,7 @@ - + char aux_hist MED_attributes @@ -2377,7 +2377,7 @@ - + char aux_hist MED_attributes @@ -2445,7 +2445,7 @@ - + char aux_hist MED_attributes @@ -2513,7 +2513,7 @@ - + char aux_hist MED_attributes diff --git a/mediator/med.F90 b/mediator/med.F90 index ab3aae92a..0ec1a61b4 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -82,29 +82,32 @@ subroutine SetServices(gcomp, rc) use NUOPC_Mediator , only: mediator_label_TimestampExport => label_TimestampExport use NUOPC_Mediator , only: mediator_label_SetRunClock => label_SetRunClock use NUOPC_Mediator , only: mediator_label_Finalize => label_Finalize - use med_phases_history_mod , only: med_phases_history_write_atm_inst - use med_phases_history_mod , only: med_phases_history_write_atm_avg - use med_phases_history_mod , only: med_phases_history_write_atm_aux - use med_phases_history_mod , only: med_phases_history_write_ice_inst - use med_phases_history_mod , only: med_phases_history_write_ice_avg - use med_phases_history_mod , only: med_phases_history_write_ice_aux - use med_phases_history_mod , only: med_phases_history_write_glc_inst - use med_phases_history_mod , only: med_phases_history_write_glc_avg - use med_phases_history_mod , only: med_phases_history_write_glc_aux - use med_phases_history_mod , only: med_phases_history_write_lnd_inst - use med_phases_history_mod , only: med_phases_history_write_lnd_avg - use med_phases_history_mod , only: med_phases_history_write_lnd_aux - use med_phases_history_mod , only: med_phases_history_write_ocn_inst - use med_phases_history_mod , only: med_phases_history_write_ocn_avg - use med_phases_history_mod , only: med_phases_history_write_ocn_aux - use med_phases_history_mod , only: med_phases_history_write_rof_inst - use med_phases_history_mod , only: med_phases_history_write_rof_avg - use med_phases_history_mod , only: med_phases_history_write_rof_aux - use med_phases_history_mod , only: med_phases_history_write_wav_inst - use med_phases_history_mod , only: med_phases_history_write_wav_avg - use med_phases_history_mod , only: med_phases_history_write_wav_aux - use med_phases_history_mod , only: med_phases_history_write_med_inst - use med_phases_history_mod , only: med_phases_history_write_all_inst + use med_phases_history_mod , only: med_phases_history_write_inst_atm + use med_phases_history_mod , only: med_phases_history_write_inst_ice + use med_phases_history_mod , only: med_phases_history_write_inst_glc + use med_phases_history_mod , only: med_phases_history_write_inst_lnd + use med_phases_history_mod , only: med_phases_history_write_inst_ocn + use med_phases_history_mod , only: med_phases_history_write_inst_rof + use med_phases_history_mod , only: med_phases_history_write_inst_wav + use med_phases_history_mod , only: med_phases_history_write_inst_med + use med_phases_history_mod , only: med_phases_history_write_inst_all + + use med_phases_history_mod , only: med_phases_history_write_avg_atm + use med_phases_history_mod , only: med_phases_history_write_avg_ice + use med_phases_history_mod , only: med_phases_history_write_avg_glc + use med_phases_history_mod , only: med_phases_history_write_avg_lnd + use med_phases_history_mod , only: med_phases_history_write_avg_ocn + use med_phases_history_mod , only: med_phases_history_write_avg_rof + use med_phases_history_mod , only: med_phases_history_write_avg_wav + + use med_phases_history_mod , only: med_phases_history_write_aux_atm + use med_phases_history_mod , only: med_phases_history_write_aux_ice + use med_phases_history_mod , only: med_phases_history_write_aux_glc + use med_phases_history_mod , only: med_phases_history_write_aux_lnd + use med_phases_history_mod , only: med_phases_history_write_aux_ocn + use med_phases_history_mod , only: med_phases_history_write_aux_rof + use med_phases_history_mod , only: med_phases_history_write_aux_wav + use med_phases_restart_mod , only: med_phases_restart_write use med_phases_prep_atm_mod , only: med_phases_prep_atm use med_phases_prep_ice_mod , only: med_phases_prep_ice @@ -206,150 +209,150 @@ subroutine SetServices(gcomp, rc) !------------------ call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_all_inst"/), userRoutine=mediator_routine_Run, rc=rc) + phaseLabelList=(/"med_phases_history_write_inst_all"/), userRoutine=mediator_routine_Run, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_all_inst", specRoutine=med_phases_history_write_all_inst, rc=rc) + specPhaseLabel="med_phases_history_write_inst_all", specRoutine=med_phases_history_write_inst_all, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_atm_inst"/), userRoutine=mediator_routine_Run, rc=rc) + phaseLabelList=(/"med_phases_history_write_inst_atm"/), userRoutine=mediator_routine_Run, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_atm_inst", specRoutine=med_phases_history_write_atm_inst, rc=rc) + specPhaseLabel="med_phases_history_write_inst_atm", specRoutine=med_phases_history_write_inst_atm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_atm_avg"/), userRoutine=mediator_routine_Run, rc=rc) + phaseLabelList=(/"med_phases_history_write_avg_atm"/), userRoutine=mediator_routine_Run, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_atm_avg", specRoutine=med_phases_history_write_atm_avg, rc=rc) + specPhaseLabel="med_phases_history_write_avg_atm", specRoutine=med_phases_history_write_avg_atm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_atm_aux"/), userRoutine=mediator_routine_Run, rc=rc) + phaseLabelList=(/"med_phases_history_write_aux_atm"/), userRoutine=mediator_routine_Run, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_atm_aux", specRoutine=med_phases_history_write_atm_aux, rc=rc) + specPhaseLabel="med_phases_history_write_aux_atm", specRoutine=med_phases_history_write_aux_atm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_ice_inst"/), userRoutine=mediator_routine_Run, rc=rc) + phaseLabelList=(/"med_phases_history_write_inst_ice"/), userRoutine=mediator_routine_Run, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_ice_inst", specRoutine=med_phases_history_write_ice_inst, rc=rc) + specPhaseLabel="med_phases_history_write_inst_ice", specRoutine=med_phases_history_write_inst_ice, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_ice_avg"/), userRoutine=mediator_routine_Run, rc=rc) + phaseLabelList=(/"med_phases_history_write_avg_ice"/), userRoutine=mediator_routine_Run, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_ice_avg", specRoutine=med_phases_history_write_ice_avg, rc=rc) + specPhaseLabel="med_phases_history_write_avg_ice", specRoutine=med_phases_history_write_avg_ice, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_ice_aux"/), userRoutine=mediator_routine_Run, rc=rc) + phaseLabelList=(/"med_phases_history_write_aux_ice"/), userRoutine=mediator_routine_Run, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_ice_aux", specRoutine=med_phases_history_write_ice_aux, rc=rc) + specPhaseLabel="med_phases_history_write_aux_ice", specRoutine=med_phases_history_write_aux_ice, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_glc_inst"/), userRoutine=mediator_routine_Run, rc=rc) + phaseLabelList=(/"med_phases_history_write_inst_glc"/), userRoutine=mediator_routine_Run, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_glc_inst", specRoutine=med_phases_history_write_glc_inst, rc=rc) + specPhaseLabel="med_phases_history_write_inst_glc", specRoutine=med_phases_history_write_inst_glc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_glc_avg"/), userRoutine=mediator_routine_Run, rc=rc) + phaseLabelList=(/"med_phases_history_write_avg_glc"/), userRoutine=mediator_routine_Run, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_glc_avg", specRoutine=med_phases_history_write_glc_avg, rc=rc) + specPhaseLabel="med_phases_history_write_avg_glc", specRoutine=med_phases_history_write_avg_glc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_glc_aux"/), userRoutine=mediator_routine_Run, rc=rc) + phaseLabelList=(/"med_phases_history_write_aux_glc"/), userRoutine=mediator_routine_Run, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_glc_aux", specRoutine=med_phases_history_write_glc_aux, rc=rc) + specPhaseLabel="med_phases_history_write_aux_glc", specRoutine=med_phases_history_write_aux_glc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_lnd_inst"/), userRoutine=mediator_routine_Run, rc=rc) + phaseLabelList=(/"med_phases_history_write_inst_lnd"/), userRoutine=mediator_routine_Run, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_lnd_inst", specRoutine=med_phases_history_write_lnd_inst, rc=rc) + specPhaseLabel="med_phases_history_write_inst_lnd", specRoutine=med_phases_history_write_inst_lnd, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_lnd_avg"/), userRoutine=mediator_routine_Run, rc=rc) + phaseLabelList=(/"med_phases_history_write_avg_lnd"/), userRoutine=mediator_routine_Run, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_lnd_avg", specRoutine=med_phases_history_write_lnd_avg, rc=rc) + specPhaseLabel="med_phases_history_write_avg_lnd", specRoutine=med_phases_history_write_avg_lnd, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_lnd_aux"/), userRoutine=mediator_routine_Run, rc=rc) + phaseLabelList=(/"med_phases_history_write_aux_lnd"/), userRoutine=mediator_routine_Run, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_lnd_aux", specRoutine=med_phases_history_write_lnd_aux, rc=rc) + specPhaseLabel="med_phases_history_write_aux_lnd", specRoutine=med_phases_history_write_aux_lnd, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_ocn_inst"/), userRoutine=mediator_routine_Run, rc=rc) + phaseLabelList=(/"med_phases_history_write_inst_ocn"/), userRoutine=mediator_routine_Run, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_ocn_inst", specRoutine=med_phases_history_write_ocn_inst, rc=rc) + specPhaseLabel="med_phases_history_write_inst_ocn", specRoutine=med_phases_history_write_inst_ocn, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_ocn_avg"/), userRoutine=mediator_routine_Run, rc=rc) + phaseLabelList=(/"med_phases_history_write_avg_ocn"/), userRoutine=mediator_routine_Run, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_ocn_avg", specRoutine=med_phases_history_write_ocn_avg, rc=rc) + specPhaseLabel="med_phases_history_write_avg_ocn", specRoutine=med_phases_history_write_avg_ocn, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_ocn_aux"/), userRoutine=mediator_routine_Run, rc=rc) + phaseLabelList=(/"med_phases_history_write_aux_ocn"/), userRoutine=mediator_routine_Run, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_ocn_aux", specRoutine=med_phases_history_write_ocn_aux, rc=rc) + specPhaseLabel="med_phases_history_write_aux_ocn", specRoutine=med_phases_history_write_aux_ocn, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_rof_inst"/), userRoutine=mediator_routine_Run, rc=rc) + phaseLabelList=(/"med_phases_history_write_inst_rof"/), userRoutine=mediator_routine_Run, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_rof_inst", specRoutine=med_phases_history_write_rof_inst, rc=rc) + specPhaseLabel="med_phases_history_write_inst_rof", specRoutine=med_phases_history_write_inst_rof, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_rof_avg"/), userRoutine=mediator_routine_Run, rc=rc) + phaseLabelList=(/"med_phases_history_write_avg_rof"/), userRoutine=mediator_routine_Run, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_rof_avg", specRoutine=med_phases_history_write_rof_avg, rc=rc) + specPhaseLabel="med_phases_history_write_avg_rof", specRoutine=med_phases_history_write_avg_rof, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_rof_aux"/), userRoutine=mediator_routine_Run, rc=rc) + phaseLabelList=(/"med_phases_history_write_aux_rof"/), userRoutine=mediator_routine_Run, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_rof_aux", specRoutine=med_phases_history_write_rof_aux, rc=rc) + specPhaseLabel="med_phases_history_write_aux_rof", specRoutine=med_phases_history_write_aux_rof, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_wav_inst"/), userRoutine=mediator_routine_Run, rc=rc) + phaseLabelList=(/"med_phases_history_write_inst_wav"/), userRoutine=mediator_routine_Run, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_wav_inst", specRoutine=med_phases_history_write_wav_inst, rc=rc) + specPhaseLabel="med_phases_history_write_inst_wav", specRoutine=med_phases_history_write_inst_wav, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_wav_avg"/), userRoutine=mediator_routine_Run, rc=rc) + phaseLabelList=(/"med_phases_history_write_avg_wav"/), userRoutine=mediator_routine_Run, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_wav_avg", specRoutine=med_phases_history_write_wav_avg, rc=rc) + specPhaseLabel="med_phases_history_write_avg_wav", specRoutine=med_phases_history_write_avg_wav, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_wav_aux"/), userRoutine=mediator_routine_Run, rc=rc) + phaseLabelList=(/"med_phases_history_write_aux_wav"/), userRoutine=mediator_routine_Run, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_wav_aux", specRoutine=med_phases_history_write_wav_aux, rc=rc) + specPhaseLabel="med_phases_history_write_aux_wav", specRoutine=med_phases_history_write_aux_wav, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_med_inst"/), userRoutine=mediator_routine_Run, rc=rc) + phaseLabelList=(/"med_phases_history_write_inst_med"/), userRoutine=mediator_routine_Run, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_med_inst", specRoutine=med_phases_history_write_med_inst, rc=rc) + specPhaseLabel="med_phases_history_write_inst_med", specRoutine=med_phases_history_write_inst_med, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ @@ -1739,7 +1742,6 @@ subroutine DataInitialize(gcomp, rc) use NUOPC , only : NUOPC_CompAttributeSet, NUOPC_IsAtTime, NUOPC_SetAttribute use NUOPC , only : NUOPC_CompAttributeGet use med_fraction_mod , only : med_fraction_init, med_fraction_set - use med_phases_history_mod , only : med_phases_history_init use med_phases_restart_mod , only : med_phases_restart_read use med_phases_prep_glc_mod , only : med_phases_prep_glc_init use med_phases_prep_atm_mod , only : med_phases_prep_atm @@ -2308,12 +2310,6 @@ subroutine DataInitialize(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif - !--------------------------------------- - ! Initialize mediator history files and alarms - !--------------------------------------- - call med_phases_history_init(gcomp, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_profile(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -2332,16 +2328,15 @@ subroutine DataInitialize(gcomp, rc) end subroutine DataInitialize !----------------------------------------------------------------------------- - subroutine SetRunClock(gcomp, rc) - use ESMF , only : ESMF_GridComp, ESMF_CLOCK, ESMF_Time, ESMF_TimeInterval - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_ClockGet, ESMF_ClockSet - use ESMF , only : ESMF_Success, ESMF_Failure - use ESMF , only : ESMF_Alarm, ESMF_ALARMLIST_ALL, ESMF_ClockGetAlarmList - use ESMF , only : ESMF_AlarmCreate, ESMF_AlarmSet, ESMF_ClockAdvance - use NUOPC , only : NUOPC_CompCheckSetClock, NUOPC_CompAttributeGet - use NUOPC_Mediator , only : NUOPC_MediatorGet + use ESMF , only : ESMF_GridComp, ESMF_CLOCK, ESMF_Time, ESMF_TimeInterval + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_ClockGet, ESMF_ClockSet + use ESMF , only : ESMF_Success, ESMF_Failure + use ESMF , only : ESMF_Alarm, ESMF_ALARMLIST_ALL, ESMF_ClockGetAlarmList + use ESMF , only : ESMF_AlarmCreate, ESMF_AlarmSet, ESMF_ClockAdvance + use NUOPC , only : NUOPC_CompCheckSetClock, NUOPC_CompAttributeGet + use NUOPC_Mediator , only : NUOPC_MediatorGet ! input/output variables type(ESMF_GridComp) :: gcomp diff --git a/mediator/med_constants_mod.F90 b/mediator/med_constants_mod.F90 index 4cc96f4f7..6a5854e2d 100644 --- a/mediator/med_constants_mod.F90 +++ b/mediator/med_constants_mod.F90 @@ -11,6 +11,6 @@ module med_constants_mod real(R8), parameter :: med_constants_czero = 0.0_R8 ! spval integer, parameter :: med_constants_ispval_mask = -987987 ! spval for RH mask values integer, parameter :: med_constants_SecPerDay = 86400 ! Seconds per day - integer :: med_constants_dbug_flag = 0 + integer :: med_constants_dbug_flag = 3 end module med_constants_mod diff --git a/mediator/med_phases_restart_mod.F90 b/mediator/med_phases_restart_mod.F90 index cc32a43a7..18b4cd7b4 100644 --- a/mediator/med_phases_restart_mod.F90 +++ b/mediator/med_phases_restart_mod.F90 @@ -9,6 +9,7 @@ module med_phases_restart_mod 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_phases_history_mod, only : num_auxfiles, auxfiles use med_time_mod , only : med_time_AlarmInit use esmFlds , only : ncomps, compname, compocn use perf_mod , only : t_startf, t_stopf @@ -155,7 +156,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 @@ -363,11 +364,13 @@ subroutine med_phases_restart_write(gcomp, rc) if (is_local%wrap%comp_present(n)) then nx = is_local%wrap%nx(n) ny = is_local%wrap%ny(n) + if (dbug_flag > 5) then + write(tmpstr,*) subname,' nx,ny = ',trim(compname(n)),nx,ny + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + end if ! Write import field bundles if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(n,n),rc=rc)) then - !write(tmpstr,*) subname,' nx,ny = ',trim(compname(n)),nx,ny - !call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) 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) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -375,8 +378,10 @@ subroutine med_phases_restart_write(gcomp, rc) ! Write export field bundles if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(n),rc=rc)) then - !write(tmpstr,*) subname,' nx,ny = ',trim(compname(n)),nx,ny - !call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + if (dbug_flag > 5) then + write(tmpstr,*) subname,' nx,ny = ',trim(compname(n)),nx,ny + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + end if 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) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -384,8 +389,6 @@ subroutine med_phases_restart_write(gcomp, rc) ! Write fraction field bundles if (ESMF_FieldBundleIsCreated(is_local%wrap%FBfrac(n),rc=rc)) then - !write(tmpstr,*) subname,' nx,ny = ',trim(compname(n)),nx,ny - !call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) 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) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -394,8 +397,6 @@ subroutine med_phases_restart_write(gcomp, rc) ! Write export field bundle accumulators if (ESMF_FieldBundleIsCreated(is_local%wrap%FBExpAccum(n),rc=rc)) then ! TODO: only write this out if actually have done accumulation - !write(tmpstr,*) subname,' nx,ny = ',trim(compname(n)),nx,ny - !call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) call med_io_write(restart_file, iam, is_local%wrap%FBExpAccum(n), & nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre=trim(compname(n))//'ExpAccum', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -404,8 +405,6 @@ subroutine med_phases_restart_write(gcomp, rc) ! Write import field bundle accumulators if (ESMF_FieldBundleIsCreated(is_local%wrap%FBImpAccum(n,n),rc=rc)) then ! TODO: only write this out if actually have done accumulation - !write(tmpstr,*) subname,' nx,ny = ',trim(compname(n)),nx,ny - !call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) call med_io_write(restart_file, iam, is_local%wrap%FBImpAccum(n,n), & nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre=trim(compname(n))//'ImpAccum', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -416,13 +415,30 @@ subroutine med_phases_restart_write(gcomp, rc) ! Write ocn albedo field bundle (CESM only) 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) + nx=is_local%wrap%nx(compocn), ny=is_local%wrap%ny(compocn), nt=1, & + whead=whead, wdata=wdata, 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,num_auxfiles(nc) + if (auxfiles(nc,nf)%useavg .and. auxfiles(nc,nf)%accumcnt > 0) then + call med_io_write(restart_file, iam, auxfiles(nc,nf)%accumcnt, & + trim(compname(nc))//trim(auxfiles(nc,nf)%auxname)//'_accumcnt', & + whead=whead, wdata=wdata, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_io_write(restart_file, iam, auxfiles(nc,nf)%FBaccum, & + nx=is_local%wrap%nx(nc), ny=is_local%wrap%ny(nc), nt=1, whead=whead, wdata=wdata, & + pre=trim(compname(nc))//trim(auxfiles(nc,nf)%auxname), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end do + end do + enddo ! Close file diff --git a/mediator/med_time_mod.F90 b/mediator/med_time_mod.F90 index f76b71310..3d1085746 100644 --- a/mediator/med_time_mod.F90 +++ b/mediator/med_time_mod.F90 @@ -238,7 +238,7 @@ subroutine med_time_alarmInit( clock, alarm, option, & endif if (mastertask) then - write(logunit,'(a)') trim(subname) //' creating alarm '// trim(alarmname) + write(logunit,'(a)') trim(subname) //' creating alarm '// trim(lalarmname) end if alarm = ESMF_AlarmCreate( name=lalarmname, clock=clock, ringTime=NextAlarm, & From 03a1d87f7103aea699f4495b0c4d754f78fc67f4 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 1 Nov 2020 09:22:22 -0700 Subject: [PATCH 19/61] more updates to mvertens/perf --- mediator/med_constants_mod.F90 | 2 +- mediator/med_methods_mod.F90 | 20 +++++--------------- 2 files changed, 6 insertions(+), 16 deletions(-) diff --git a/mediator/med_constants_mod.F90 b/mediator/med_constants_mod.F90 index 6a5854e2d..4cc96f4f7 100644 --- a/mediator/med_constants_mod.F90 +++ b/mediator/med_constants_mod.F90 @@ -11,6 +11,6 @@ module med_constants_mod real(R8), parameter :: med_constants_czero = 0.0_R8 ! spval integer, parameter :: med_constants_ispval_mask = -987987 ! spval for RH mask values integer, parameter :: med_constants_SecPerDay = 86400 ! Seconds per day - integer :: med_constants_dbug_flag = 3 + integer :: med_constants_dbug_flag = 0 end module med_constants_mod diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index eddc759d2..ed360087f 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -181,8 +181,6 @@ subroutine med_methods_FB_init_pointer(StateIn, FBout, flds_scalar_name, name, r if (chkerr(rc,__LINE__,u_FILE_u)) return ! create new field with an ungridded dimension - call ESMF_LogWrite(trim(subname)// ": creating new field "// & - trim(lfieldnamelist(n)) //" with ungridded dimension", ESMF_LOGMSG_INFO) newfield = ESMF_FieldCreate(lmesh, dataptr2d, ESMF_INDEX_DELOCAL, & meshloc=meshloc, name=lfieldNameList(n), & ungriddedLbound=ungriddedLbound, ungriddedUbound=ungriddedUbound, gridToFieldMap=gridtoFieldMap, rc=rc) @@ -194,7 +192,7 @@ subroutine med_methods_FB_init_pointer(StateIn, FBout, flds_scalar_name, name, r call ESMF_FieldGet(lfield, farrayptr=dataptr1d, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ! create new field without an ungridded dimension + ! create new field without an ungridded dimension newfield = ESMF_FieldCreate(lmesh, dataptr1d, ESMF_INDEX_DELOCAL, & meshloc=meshloc, name=lfieldNameList(n), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -464,11 +462,7 @@ subroutine med_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBgeom, S ! Create the field on a lmesh if (ungriddedCount > 0) then - ! ungridded dimensions in field - call ESMF_LogWrite(trim(subname) // ": creating new field "// & - trim(lfieldnamelist(n)) //" with ungridded dimension", ESMF_LOGMSG_INFO) - allocate(ungriddedLBound(ungriddedCount), ungriddedUBound(ungriddedCount)) call ESMF_AttributeGet(lfield, name="UngriddedLBound", convention="NUOPC", & purpose="Instance", valueList=ungriddedLBound, rc=rc) @@ -491,8 +485,6 @@ subroutine med_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBgeom, S deallocate( ungriddedLbound, ungriddedUbound, gridToFieldMap) else ! No ungridded dimensions in field - call ESMF_LogWrite(trim(subname)// ": creating new field "// & - trim(lfieldnamelist(n)) //" without ungridded dimension", ESMF_LOGMSG_INFO) field = ESMF_FieldCreate(lmesh, ESMF_TYPEKIND_R8, meshloc=meshloc, name=lfieldNameList(n), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if @@ -500,16 +492,16 @@ subroutine med_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBgeom, S else if (present(fieldNameList)) then ! Assume no ungridded dimensions if just the field name list is give - call ESMF_LogWrite(trim(subname)// ": creating new field "// & - trim(lfieldnamelist(n)) //" without ungridded dimension", ESMF_LOGMSG_INFO) field = ESMF_FieldCreate(lmesh, ESMF_TYPEKIND_R8, meshloc=meshloc, name=lfieldNameList(n), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if ! Add the created field bundle FBout - call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" adding field "//trim(lfieldNameList(n)), & - ESMF_LOGMSG_INFO) + if (dbug_flag > 1) then + call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" adding field "//trim(lfieldNameList(n)), & + ESMF_LOGMSG_INFO) + end if call ESMF_FieldBundleAdd(FBout, (/field/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -1444,7 +1436,6 @@ logical function med_methods_FB_FldChk(FB, fldname, rc) if (dbug_flag > 10) then call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif - rc = ESMF_SUCCESS ! If field bundle is not created then set return to .false. @@ -1462,7 +1453,6 @@ logical function med_methods_FB_FldChk(FB, fldname, rc) ESMF_LOGMSG_ERROR) return endif - if (isPresent) then med_methods_FB_FldChk = .true. endif From be86f605bd7e4fdf0e59589029a7d734fe5ee6ec Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 1 Nov 2020 14:02:07 -0700 Subject: [PATCH 20/61] refact of time averaged output --- cime_config/runseq/gen_runseq.py | 2 +- mediator/med.F90 | 36 +- mediator/med_phases_history_mod.F90 | 673 ++++++++++++++++++---------- 3 files changed, 461 insertions(+), 250 deletions(-) diff --git a/cime_config/runseq/gen_runseq.py b/cime_config/runseq/gen_runseq.py index 56190a2bd..dc87c8644 100644 --- a/cime_config/runseq/gen_runseq.py +++ b/cime_config/runseq/gen_runseq.py @@ -46,7 +46,7 @@ def leave_time_loop(self, leave_time, if_write_hist_rest=False ): if leave_time and self.__time_loop: _, active_depth = self.__time_loop.pop() if if_write_hist_rest or active_depth == 0: - self.__outfile.write (" MED med_phases_history_write_all_inst \n" ) + self.__outfile.write (" MED med_phases_history_write_inst_all \n" ) self.__outfile.write (" MED med_phases_restart_write \n" ) self.__outfile.write (" MED med_phases_profile \n" ) self.__outfile.write ("@ \n" ) diff --git a/mediator/med.F90 b/mediator/med.F90 index f74ad0b18..b4946cd49 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -82,6 +82,7 @@ subroutine SetServices(gcomp, rc) use NUOPC_Mediator , only: mediator_label_TimestampExport => label_TimestampExport use NUOPC_Mediator , only: mediator_label_SetRunClock => label_SetRunClock use NUOPC_Mediator , only: mediator_label_Finalize => label_Finalize + use med_phases_history_mod , only: med_phases_history_write_inst_atm use med_phases_history_mod , only: med_phases_history_write_inst_ice use med_phases_history_mod , only: med_phases_history_write_inst_glc @@ -130,7 +131,6 @@ subroutine SetServices(gcomp, rc) use med_diag_mod , only: med_phases_diag_glc use med_diag_mod , only: med_phases_diag_ocn use med_diag_mod , only: med_phases_diag_ice_ice2med, med_phases_diag_ice_med2ice - use med_phases_history_mod , only: med_phases_history_alarms_init use med_fraction_mod , only: med_fraction_init, med_fraction_set use med_phases_profile_mod , only: med_phases_profile @@ -207,7 +207,7 @@ subroutine SetServices(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ - ! setup mediator history phases + ! setup mediator history phases for all output !------------------ call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & @@ -217,6 +217,10 @@ subroutine SetServices(gcomp, rc) specPhaseLabel="med_phases_history_write_inst_all", specRoutine=med_phases_history_write_inst_all, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + !------------------ + ! setup mediator history phases for atm output + !------------------ + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & phaseLabelList=(/"med_phases_history_write_inst_atm"/), userRoutine=mediator_routine_Run, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -236,6 +240,10 @@ subroutine SetServices(gcomp, rc) specPhaseLabel="med_phases_history_write_aux_atm", specRoutine=med_phases_history_write_aux_atm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + !------------------ + ! setup mediator history phases for ice output + !------------------ + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & phaseLabelList=(/"med_phases_history_write_inst_ice"/), userRoutine=mediator_routine_Run, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -255,6 +263,10 @@ subroutine SetServices(gcomp, rc) specPhaseLabel="med_phases_history_write_aux_ice", specRoutine=med_phases_history_write_aux_ice, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + !------------------ + ! setup mediator history phases for glc output + !------------------ + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & phaseLabelList=(/"med_phases_history_write_inst_glc"/), userRoutine=mediator_routine_Run, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -274,6 +286,10 @@ subroutine SetServices(gcomp, rc) specPhaseLabel="med_phases_history_write_aux_glc", specRoutine=med_phases_history_write_aux_glc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + !------------------ + ! setup mediator history phases for lnd output + !------------------ + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & phaseLabelList=(/"med_phases_history_write_inst_lnd"/), userRoutine=mediator_routine_Run, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -293,6 +309,10 @@ subroutine SetServices(gcomp, rc) specPhaseLabel="med_phases_history_write_aux_lnd", specRoutine=med_phases_history_write_aux_lnd, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + !------------------ + ! setup mediator history phases for ocn output + !------------------ + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & phaseLabelList=(/"med_phases_history_write_inst_ocn"/), userRoutine=mediator_routine_Run, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -312,6 +332,10 @@ subroutine SetServices(gcomp, rc) specPhaseLabel="med_phases_history_write_aux_ocn", specRoutine=med_phases_history_write_aux_ocn, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + !------------------ + ! setup mediator history phases for rof output + !------------------ + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & phaseLabelList=(/"med_phases_history_write_inst_rof"/), userRoutine=mediator_routine_Run, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -331,6 +355,10 @@ subroutine SetServices(gcomp, rc) specPhaseLabel="med_phases_history_write_aux_rof", specRoutine=med_phases_history_write_aux_rof, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + !------------------ + ! setup mediator history phases for wav output + !------------------ + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & phaseLabelList=(/"med_phases_history_write_inst_wav"/), userRoutine=mediator_routine_Run, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -350,6 +378,10 @@ subroutine SetServices(gcomp, rc) specPhaseLabel="med_phases_history_write_aux_wav", specRoutine=med_phases_history_write_aux_wav, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + !------------------ + ! setup mediator history phases for med output + !------------------ + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & phaseLabelList=(/"med_phases_history_write_inst_med"/), userRoutine=mediator_routine_Run, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 03062d504..a1ae84272 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -38,16 +38,14 @@ module med_phases_history_mod use esmFlds , only : compmed, compatm, complnd, compocn, compice, comprof, compglc, compwav use esmFlds , only : ncomps, compname use esmFlds , only : fldListFr, fldListTo - use med_constants_mod , only : SecPerDay => med_constants_SecPerDay - use med_constants_mod , only : czero => med_constants_czero - 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 : FB_GetFldPtr => med_methods_FB_GetFldPtr - use med_methods_mod , only : FB_init => med_methods_FB_init - use med_methods_mod , only : FB_accum => med_methods_FB_accum - use med_methods_mod , only : FB_average => med_methods_FB_average - use med_methods_mod , only : FB_fldchk => med_methods_FB_fldchk + use med_constants_mod , only : SecPerDay => med_constants_SecPerDay + use med_constants_mod , only : czero => med_constants_czero + use med_utils_mod , only : chkerr => med_utils_ChkErr + use med_methods_mod , only : med_methods_FB_reset + use med_methods_mod , only : med_methods_FB_accum + use med_methods_mod , only : med_methods_FB_average + use med_methods_mod , only : med_methods_FB_fldchk + use med_methods_mod , only : med_methods_FB_init 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 @@ -85,10 +83,10 @@ module med_phases_history_mod public :: med_phases_history_write_aux_rof public :: med_phases_history_write_aux_wav - ! Private routines - private :: med_phases_history_init_inst - private :: med_phases_history_init_avg - private :: med_phases_history_init_aux + ! Private routines + private :: med_phases_history_init_inst ! called the first time a write phase is called + private :: med_phases_history_init_avg ! called the first time a write phase is called + private :: med_phases_history_init_aux ! called the first time a write phase is called private :: med_phases_history_write_hfile private :: med_phases_history_write_hfileaux private :: med_phases_history_get_filename @@ -102,11 +100,15 @@ module med_phases_history_mod end type avgfile_type type(avgfile_type) :: avgfiles_import(ncomps) type(avgfile_type) :: avgfiles_export(ncomps) + ! where are the following initialized? - these are mediator specific fields type(avgfile_type) :: avgfiles_aoflux_ocn type(avgfile_type) :: avgfiles_ocnalb_ocn type(avgfile_type) :: avgfiles_aoflux_atm type(avgfile_type) :: avgfiles_ocnalb_atm + character(CL) :: case_name ! case name + character(CS) :: inst_tag ! instance tag + integer, parameter :: max_auxfiles = 10 type, public :: auxfile_type character(CS), allocatable :: flds(:) ! array of aux field names @@ -123,12 +125,8 @@ module med_phases_history_mod integer , public :: num_auxfiles(ncomps) = 0 type(auxfile_type) , public :: auxfiles(max_auxfiles,ncomps) - character(CL) :: case_name ! case name - character(CS) :: inst_tag ! instance tag - type(ESMF_Clock) :: hclock_inst_all type(ESMF_Clock) :: hclock_inst_comp(ncomps) - type(ESMF_Clock) :: hclock_avg_comp(ncomps) logical :: debug_alarms = .true. @@ -139,12 +137,6 @@ module med_phases_history_mod contains !=============================================================================== - ! TODO: remove this when no longer needed - subroutine med_phases_history_init(gcomp, rc) - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - end subroutine med_phases_history_init - subroutine med_phases_history_init_inst(gcomp, alarmname, hclock, rc) ! -------------------------------------- @@ -234,111 +226,95 @@ subroutine med_phases_history_init_avg(gcomp, alarmname, hclock, rc) integer , intent(out) :: rc ! local variables + type(InternalState) :: is_local + type(ESMF_Clock) :: mclock + type(ESMF_Alarm) :: alarm + type(ESMF_Time) :: CurrTime + type(ESMF_Time) :: StartTime + type(ESMF_TimeInterval) :: timestep + integer :: timestep_length + 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 + logical :: isPresent + logical :: isSet + logical :: first_time = .true. character(len=*), parameter :: subname=' (med_phases_history_init)' !--------------------------------------- rc = ESMF_SUCCESS ! ! Determine time average mediator output frequency and type - ! hist_option = 'none' - ! hist_n = -999 - ! call NUOPC_CompAttributeGet(gcomp, name='history_avg_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_avg_option', value=hist_option, rc=rc) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! call NUOPC_CompAttributeGet(gcomp, name='history_avg_n', value=cvalue, rc=rc) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! read(cvalue,*) hist_n - ! end if - - ! ! Set alarm for time averaged mediator history output - ! alarmname = 'alarm_history_avg_all' - ! call med_time_alarmInit(mclock, alarm, option=hist_option, opt_n=hist_n, & - ! reftime=mStartTime, alarmname=trim(alarmname), rc=rc) - ! call ESMF_AlarmSet(alarm, clock=mclock, rc=rc) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! if (mastertask) then - ! write(logunit,*) - ! write(logunit,'(a)') trim(subname) // 'Initialize time averaged history alarms' - ! write(logunit,'(a,2x,i8)') trim(subname)//" set average mediator history alarm "//& - ! trim(alarmname)//" with option "//trim(hist_option)//" and frequency ",hist_n - ! end if - ! do n = 1,ncomps - ! if (is_local%wrap%comp_present(n)) then - ! alarmname = 'alarm_history_avg_' // trim(compname(n)) - ! call med_time_alarmInit(mclock, alarm, option=hist_option, opt_n=hist_n, & - ! reftime=mStartTime, alarmname=trim(alarmname), rc=rc) - ! call ESMF_AlarmSet(alarm, clock=mclock, rc=rc) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! if (mastertask) then - ! write(logunit,'(a,2x,i8)') trim(subname)//" set average mediator history alarm "//& - ! trim(alarmname)//" with option "//trim(hist_option)//" and frequency ",hist_n - ! end if - ! end if - ! end do - - ! ! Create time average field bundles (module variables) - ! if (hist_option /= 'never' .and. hist_option /= 'none') then - ! call NUOPC_CompAttributeGet(gcomp, name='history_avg_n', value=cvalue, rc=rc) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! read(cvalue,*) hist_n - ! do n = 1,ncomps - ! ! accumulated import fields - ! if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(n,n),rc=rc)) then - ! call FB_init(avgfiles_import(n)%FBaccum, is_local%wrap%flds_scalar_name, & - ! FBgeom=is_local%wrap%FBImp(n,n), STflds=is_local%wrap%NStateImp(n), rc=rc) - ! if (chkerr(rc,__LINE__,u_FILE_u)) return - ! call FB_reset(avgfiles_import(n)%FBaccum, czero, rc) - ! if (chkerr(rc,__LINE__,u_FILE_u)) return - ! avgfiles_import(n)%accumcnt = 0 - ! end if - ! ! accumulated export fields - ! if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(n), rc=rc)) then - ! call FB_init(avgfiles_export(n)%FBaccum, is_local%wrap%flds_scalar_name, & - ! FBgeom=is_local%wrap%FBExp(n), STflds=is_local%wrap%NstateExp(n), rc=rc) - ! if (chkerr(rc,__LINE__,u_FILE_u)) return - ! call FB_reset(avgfiles_export(n)%FBaccum, czero, rc) - ! if (chkerr(rc,__LINE__,u_FILE_u)) return - ! avgfiles_export(n)%accumcnt = 0 - ! end if - ! ! accumulated atm/ocn flux on ocn mesh - ! if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_o, rc=rc)) then - ! call FB_init(avgfiles_aoflux_ocn%FBaccum, is_local%wrap%flds_scalar_name, & - ! FBgeom=is_local%wrap%FBMed_aoflux_o, FBflds=is_local%wrap%FBMed_aoflux_o, rc=rc) - ! if (chkerr(rc,__LINE__,u_FILE_u)) return - ! call FB_reset(avgfiles_aoflux_ocn%FBaccum, czero, rc) - ! if (chkerr(rc,__LINE__,u_FILE_u)) return - ! avgfiles_aoflux_ocn%accumcnt = 0 - ! end if - ! ! accumulated atm/ocn flux on atm mesh - ! if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a, rc=rc)) then - ! call FB_init(avgfiles_aoflux_atm%FBaccum, is_local%wrap%flds_scalar_name, & - ! FBgeom=is_local%wrap%FBMed_aoflux_a, FBflds=is_local%wrap%FBMed_aoflux_a, rc=rc) - ! if (chkerr(rc,__LINE__,u_FILE_u)) return - ! call FB_reset(avgfiles_aoflux_atm%FBaccum, czero, rc) - ! if (chkerr(rc,__LINE__,u_FILE_u)) return - ! avgfiles_aoflux_atm%accumcnt = 0 - ! end if - ! ! accumulated ocean albedo on ocn mesh - ! if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o, rc=rc)) then - ! call FB_init(avgfiles_ocnalb_ocn%FBaccum, is_local%wrap%flds_scalar_name, & - ! FBgeom=is_local%wrap%FBMed_ocnalb_o, FBflds=is_local%wrap%FBMed_ocnalb_o, rc=rc) - ! if (chkerr(rc,__LINE__,u_FILE_u)) return - ! call FB_reset(avgfiles_ocnalb_ocn%FBaccum, czero, rc) - ! if (chkerr(rc,__LINE__,u_FILE_u)) return - ! avgfiles_ocnalb_ocn%accumcnt = 0 - ! end if - ! ! accumulated ocean albedo on atm mesh - ! if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_a, rc=rc)) then - ! call FB_init(avgfiles_ocnalb_atm%FBaccum, is_local%wrap%flds_scalar_name, & - ! FBgeom=is_local%wrap%FBMed_ocnalb_a, FBflds=is_local%wrap%FBMed_ocnalb_a, rc=rc) - ! if (chkerr(rc,__LINE__,u_FILE_u)) return - ! call FB_reset(avgfiles_ocnalb_atm%FBaccum, czero, rc) - ! if (chkerr(rc,__LINE__,u_FILE_u)) return - ! avgfiles_ocnalb_atm%accumcnt = 0 - ! end if - ! end do - ! end if + hist_option = 'none' + hist_n = -999 + call NUOPC_CompAttributeGet(gcomp, name='history_avg_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_avg_option', value=hist_option, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(gcomp, name='history_avg_n', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) hist_n + end if + + ! Set alarm for instantaneous history output + ! Advance history clock to trigger alarms then reset history clock back to mcurrtime + call ESMF_ClockGet(hclock, startTime=StartTime, currTime=CurrTime, timeStep=timestep, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_time_alarmInit(hclock, alarm, option=hist_option, opt_n=hist_n, & + reftime=StartTime, alarmname=trim(alarmname), rc=rc) + call ESMF_AlarmSet(alarm, clock=hclock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockAdvance(hclock,rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockSet(hclock, currTime=currtime) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Create time average field bundles (module variables) + if (first_time) then + if (hist_option /= 'never' .and. hist_option /= 'none') then + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! accumulated atm/ocn flux on ocn mesh + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_o, rc=rc)) then + call med_methods_fb_init(avgfiles_aoflux_ocn%FBaccum, is_local%wrap%flds_scalar_name, & + FBgeom=is_local%wrap%FBMed_aoflux_o, FBflds=is_local%wrap%FBMed_aoflux_o, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call med_methods_FB_reset(avgfiles_aoflux_ocn%FBaccum, czero, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + avgfiles_aoflux_ocn%accumcnt = 0 + end if + ! accumulated atm/ocn flux on atm mesh + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a, rc=rc)) then + call med_methods_fb_init(avgfiles_aoflux_atm%FBaccum, is_local%wrap%flds_scalar_name, & + FBgeom=is_local%wrap%FBMed_aoflux_a, FBflds=is_local%wrap%FBMed_aoflux_a, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call med_methods_FB_reset(avgfiles_aoflux_atm%FBaccum, czero, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + avgfiles_aoflux_atm%accumcnt = 0 + end if + ! accumulated ocean albedo on ocn mesh + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o, rc=rc)) then + call med_methods_fb_init(avgfiles_ocnalb_ocn%FBaccum, is_local%wrap%flds_scalar_name, & + FBgeom=is_local%wrap%FBMed_ocnalb_o, FBflds=is_local%wrap%FBMed_ocnalb_o, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call med_methods_FB_reset(avgfiles_ocnalb_ocn%FBaccum, czero, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + avgfiles_ocnalb_ocn%accumcnt = 0 + end if + ! accumulated ocean albedo on atm mesh + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_a, rc=rc)) then + call med_methods_fb_init(avgfiles_ocnalb_atm%FBaccum, is_local%wrap%flds_scalar_name, & + FBgeom=is_local%wrap%FBMed_ocnalb_a, FBflds=is_local%wrap%FBMed_ocnalb_a, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call med_methods_FB_reset(avgfiles_ocnalb_atm%FBaccum, czero, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + avgfiles_ocnalb_atm%accumcnt = 0 + end if + end if + first_time = .false. + end if end subroutine med_phases_history_init_avg @@ -347,7 +323,6 @@ subroutine med_phases_history_init_aux(gcomp, ncomp, auxfile, rc) ! ----------------------------- ! Initialize auxiliary history file - ! NOTE: ! 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 @@ -379,6 +354,7 @@ subroutine med_phases_history_init_aux(gcomp, ncomp, auxfile, rc) character(CL) :: auxflds integer :: fieldCount logical :: found + character(CS) :: enable_auxfile character(CS), allocatable :: fieldNameList(:) character(len=*), parameter :: subname=' (med_phases_history_init_aux)' !--------------------------------------- @@ -401,12 +377,12 @@ subroutine med_phases_history_init_aux(gcomp, ncomp, auxfile, rc) 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) + call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_enabled', value=enable_auxfile, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if ! If enabled is on - then initailize auxfile(nfcnt) - if (isPresent .and. isSet .and. (trim(cvalue) == 'on')) then + if (isPresent .and. isSet .and. (trim(enable_auxfile) == 'on')) then ! Increment nfcnt nfcnt = nfcnt + 1 @@ -417,7 +393,7 @@ subroutine med_phases_history_init_aux(gcomp, ncomp, auxfile, rc) read(cvalue,*) auxfile(nfcnt)%ntperfile if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Determine if will do time average + ! Determine if will do time average for aux file call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_useavg', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) auxfile(nfcnt)%useavg @@ -430,12 +406,10 @@ subroutine med_phases_history_init_aux(gcomp, ncomp, auxfile, rc) 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(ncomp,ncomp), & - fieldCount=fieldCount, rc=rc) + call ESMF_FieldBundleGet(is_local%wrap%FBImp(ncomp,ncomp), fieldCount=fieldCount, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return allocate(auxfile(nfcnt)%flds(fieldcount)) - call ESMF_FieldBundleGet(is_local%wrap%FBImp(ncomp,ncomp), & - fieldNameList=auxfile(nfcnt)%flds, rc=rc) + call ESMF_FieldBundleGet(is_local%wrap%FBImp(ncomp,ncomp), fieldNameList=auxfile(nfcnt)%flds, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return else @@ -447,7 +421,7 @@ subroutine med_phases_history_init_aux(gcomp, ncomp, auxfile, rc) ! Remove all fields from fieldnamelist that are not in FBImp(ncomp,ncomp) fieldCount = size(fieldnamelist) do n = 1,fieldcount - if (.not. FB_fldchk(is_local%wrap%FBImp(ncomp,ncomp), trim(fieldnamelist(n)), rc)) then + if (.not. med_methods_FB_fldchk(is_local%wrap%FBImp(ncomp,ncomp), trim(fieldnamelist(n)), rc)) then do n1 = n, fieldCount-1 fieldnamelist(n1) = fieldnamelist(n1+1) end do @@ -477,18 +451,16 @@ subroutine med_phases_history_init_aux(gcomp, ncomp, auxfile, rc) if (auxfile(nfcnt)%useavg) then ! First duplicate all fields in FBImp(ncomp,ncomp) - call ESMF_LogWrite(trim(subname)// ": calling FB_init for FBaccum(ncomp)", ESMF_LOGMSG_INFO) - call FB_init(auxfile(nfcnt)%FBaccum, is_local%wrap%flds_scalar_name, & + call ESMF_LogWrite(trim(subname)// ": calling med_methods_fb_init for FBaccum(ncomp)", ESMF_LOGMSG_INFO) + call med_methods_fb_init(auxfile(nfcnt)%FBaccum, is_local%wrap%flds_scalar_name, & FBgeom=is_local%wrap%FBImp(ncomp,ncomp), STflds=is_local%wrap%NStateImp(ncomp), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! Now remove all fields from FBAccum that are not in the input flds list - call ESMF_FieldBundleGet(is_local%wrap%FBImp(ncomp,ncomp), & - fieldCount=fieldCount, rc=rc) + call ESMF_FieldBundleGet(is_local%wrap%FBImp(ncomp,ncomp), fieldCount=fieldCount, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return allocate(fieldNameList(fieldCount)) - call ESMF_FieldBundleGet(is_local%wrap%FBImp(ncomp,ncomp), & - fieldNameList=fieldNameList, rc=rc) + call ESMF_FieldBundleGet(is_local%wrap%FBImp(ncomp,ncomp), fieldNameList=fieldNameList, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return do n = 1,size(fieldnamelist) found = .false. @@ -499,8 +471,7 @@ subroutine med_phases_history_init_aux(gcomp, ncomp, auxfile, rc) end if end do if (.not. found) then - call ESMF_FieldBundleRemove(auxfile(nfcnt)%FBaccum, & - fieldnamelist(n:n), rc=rc) + call ESMF_FieldBundleRemove(auxfile(nfcnt)%FBaccum, fieldnamelist(n:n), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if end do @@ -616,12 +587,6 @@ subroutine med_phases_history_write_hfile(gcomp, comptype, hclock, alarmname, do rc = ESMF_SUCCESS - ! Get the communicator and localpet - 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 the internal state nullify(is_local%wrap) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) @@ -635,15 +600,16 @@ subroutine med_phases_history_write_hfile(gcomp, comptype, hclock, alarmname, do if (ESMF_AlarmIsRinging(alarm, rc=rc)) then if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (debug_alarms) then - call med_phases_history_output_alarminfo(hclock, alarm, alarmname, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if ! Set write_now flag write_now = .true. ! Turn ringer off call ESMF_AlarmRingerOff(alarm, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Write diagnostic output + if (debug_alarms) then + call med_phases_history_output_alarminfo(hclock, alarm, alarmname, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if else write_now = .false. end if @@ -654,23 +620,23 @@ subroutine med_phases_history_write_hfile(gcomp, comptype, hclock, alarmname, do if (comptype == 'all' .or. comptype == trim(compname(n))) then ! accumulate if (ESMF_FieldBundleIsCreated(avgfiles_import(n)%FBaccum)) then - call FB_accum(avgfiles_import(n)%FBaccum, is_local%wrap%FBImp(n,n), rc=rc) + call med_methods_FB_accum(avgfiles_import(n)%FBaccum, is_local%wrap%FBImp(n,n), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return avgfiles_import(n)%accumcnt = avgfiles_import(n)%accumcnt + 1 end if if (ESMF_FieldBundleIsCreated(avgfiles_export(n)%FBaccum)) then - call FB_accum(avgfiles_export(n)%FBaccum, is_local%wrap%FBExp(n), rc=rc) + call med_methods_FB_accum(avgfiles_export(n)%FBaccum, is_local%wrap%FBExp(n), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return avgfiles_export(n)%accumcnt = avgfiles_export(n)%accumcnt + 1 end if if (write_now) then if (ESMF_FieldBundleIsCreated(avgfiles_import(n)%FBaccum)) then - call FB_average(avgfiles_import(n)%FBaccum, avgfiles_import(n)%accumcnt, rc=rc) + call med_methods_FB_average(avgfiles_import(n)%FBaccum, avgfiles_import(n)%accumcnt, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return avgfiles_import(n)%accumcnt = 0 end if if (ESMF_FieldBundleIsCreated(avgfiles_export(n)%FBaccum)) then - call FB_average(avgfiles_export(n)%FBaccum, avgfiles_export(n)%accumcnt, rc=rc) + call med_methods_FB_average(avgfiles_export(n)%FBaccum, avgfiles_export(n)%accumcnt, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return avgfiles_export(n)%accumcnt = 0 end if @@ -704,6 +670,10 @@ subroutine med_phases_history_write_hfile(gcomp, comptype, hclock, alarmname, do end if ! Create history file + 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 med_io_wopen(hist_file, vm, iam, clobber=.true.) do m = 1,2 if (m == 1) then @@ -769,38 +739,32 @@ subroutine med_phases_history_write_hfile(gcomp, comptype, hclock, alarmname, do if (.not. doavg) then if (comptype == 'all' .or. comptype == 'med') then do n = 2,ncomps ! skip the mediator here - nx = is_local%wrap%nx(n) - ny = is_local%wrap%ny(n) if (ESMF_FieldBundleIsCreated(is_local%wrap%FBFrac(n),rc=rc)) then call med_io_write(hist_file, iam, is_local%wrap%FBFrac(n), & - nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, & + nx=is_local%wrap%nx(n), ny=is_local%wrap%ny(n), 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 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) + nx=is_local%wrap%nx(compocn), ny=is_local%wrap%ny(compocn), nt=1, whead=whead, wdata=wdata, & + pre='Med_alb_ocn', rc=rc) 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) + nx=is_local%wrap%nx(compocn), ny=is_local%wrap%ny(compocn), nt=1, whead=whead, wdata=wdata, & + pre='Med_aoflux_ocn', rc=rc) 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) + nx=is_local%wrap%nx(compatm), ny=is_local%wrap%ny(compatm), nt=1, whead=whead, wdata=wdata, & + pre='Med_alb_atm', rc=rc) 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) + nx=is_local%wrap%nx(compatm), ny=is_local%wrap%ny(compatm), nt=1, whead=whead, wdata=wdata, & + pre='Med_aoflux_atm', rc=rc) end if end if end if @@ -915,12 +879,12 @@ subroutine med_phases_history_write_hfileaux(gcomp, case_name, inst_tag, & ! Do accumulation and average if required if (auxfile%useavg) then - call FB_accum(auxfile%FBaccum, is_local%wrap%FBImp(comp_index,comp_index), rc=rc) + call med_methods_FB_accum(auxfile%FBaccum, is_local%wrap%FBImp(comp_index,comp_index), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return auxfile%accumcnt = auxfile%accumcnt + 1 if (write_now) then - call FB_average(auxfile%FBaccum, auxfile%accumcnt, rc=rc) + call med_methods_FB_average(auxfile%FBaccum, auxfile%accumcnt, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return auxfile%accumcnt = 0 endif @@ -985,7 +949,7 @@ subroutine med_phases_history_write_hfileaux(gcomp, case_name, inst_tag, & nx=nx, ny=ny, nt=auxfile%nt, whead=.false., wdata=.true., pre=trim(compname(comp_index))//'Imp', & flds=auxfile%flds, file_ind=nfile_index, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_reset(auxfile%FBaccum, value=czero, rc=rc) + call med_methods_FB_reset(auxfile%FBaccum, value=czero, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else call med_io_write(auxfile%histfile, iam, is_local%wrap%FBimp(comp_index,comp_index), & @@ -1014,7 +978,6 @@ subroutine med_phases_history_write_inst_all(gcomp, rc) ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc - ! local variables logical :: first_time = .true. character(len=*), parameter :: subname='(med_phases_history_write)' @@ -1028,12 +991,12 @@ subroutine med_phases_history_write_inst_all(gcomp, rc) end if call ESMF_ClockAdvance(hclock_inst_all, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_write_hfile(gcomp, 'all', hclock_inst_all, & - 'alarm_history_inst_all', .false., rc) + call med_phases_history_write_hfile(gcomp, 'all', hclock_inst_all, 'alarm_history_inst_all', .false., rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call t_stopf('MED:'//subname) end subroutine med_phases_history_write_inst_all + !=============================================================================== subroutine med_phases_history_write_inst_med(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 @@ -1042,7 +1005,7 @@ subroutine med_phases_history_write_inst_med(gcomp, rc) type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc ! local variables - logical :: first_time = .true. + logical :: first_time = .true. character(CL) :: alarmname character(len=*), parameter :: subname='(med_phases_history_write_med)' !--------------------------------------- @@ -1062,12 +1025,11 @@ subroutine med_phases_history_write_inst_med(gcomp, rc) call t_stopf('MED:'//subname) end subroutine med_phases_history_write_inst_med + !=============================================================================== subroutine med_phases_history_write_inst_atm(gcomp, rc) ! Write mediator history file for atm variables - ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc - ! local variables logical :: first_time = .true. character(CL) :: alarmname character(len=*), parameter :: subname='(med_phases_history_write_inst_atm)' @@ -1088,12 +1050,11 @@ subroutine med_phases_history_write_inst_atm(gcomp, rc) call t_stopf('MED:'//subname) end subroutine med_phases_history_write_inst_atm + !=============================================================================== subroutine med_phases_history_write_inst_ice(gcomp, rc) ! Write mediator history file for ice variables - ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc - ! local variables logical :: first_time = .true. character(CL) :: alarmname character(len=*), parameter :: subname='(med_phases_history_write_inst_ice)' @@ -1113,12 +1074,11 @@ subroutine med_phases_history_write_inst_ice(gcomp, rc) call t_stopf('MED:'//subname) end subroutine med_phases_history_write_inst_ice + !=============================================================================== subroutine med_phases_history_write_inst_glc(gcomp, rc) ! Write mediator history file for glc variables - ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc - ! local variables logical :: first_time = .true. character(CL) :: alarmname character(len=*), parameter :: subname='(med_phases_history_write_inst_glc)' @@ -1139,12 +1099,11 @@ subroutine med_phases_history_write_inst_glc(gcomp, rc) call t_stopf('MED:'//subname) end subroutine med_phases_history_write_inst_glc + !=============================================================================== subroutine med_phases_history_write_inst_lnd(gcomp, rc) ! Write mediator history file for lnd variables - ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc - ! local variables logical :: first_time = .true. character(CL) :: alarmname character(len=*), parameter :: subname='(med_phases_history_write_inst_lnd)' @@ -1165,12 +1124,11 @@ subroutine med_phases_history_write_inst_lnd(gcomp, rc) call t_stopf('MED:'//subname) end subroutine med_phases_history_write_inst_lnd + !=============================================================================== subroutine med_phases_history_write_inst_ocn(gcomp, rc) ! Write mediator history file for ocn variables - ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc - ! local variables logical :: first_time = .true. character(CL) :: alarmname character(len=*), parameter :: subname='(med_phases_history_write_inst_ocn)' @@ -1191,12 +1149,11 @@ subroutine med_phases_history_write_inst_ocn(gcomp, rc) call t_stopf('MED:'//subname) end subroutine med_phases_history_write_inst_ocn + !=============================================================================== subroutine med_phases_history_write_inst_rof(gcomp, rc) ! Write mediator history file for rof variables - ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc - ! local variables logical :: first_time = .true. character(CL) :: alarmname character(len=*), parameter :: subname='(med_phases_history_write_inst_rof)' @@ -1217,12 +1174,11 @@ subroutine med_phases_history_write_inst_rof(gcomp, rc) call t_stopf('MED:'//subname) end subroutine med_phases_history_write_inst_rof + !=============================================================================== subroutine med_phases_history_write_inst_wav(gcomp, rc) ! Write mediator history file for wav variables - ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc - ! local variables logical :: first_time = .true. character(CL) :: alarmname character(len=*), parameter :: subname='(med_phases_history_write_inst_wav)' @@ -1241,123 +1197,354 @@ subroutine med_phases_history_write_inst_wav(gcomp, rc) trim(alarmname), .false., rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call t_stopf('MED:'//subname) - rc = ESMF_SUCCESS end subroutine med_phases_history_write_inst_wav !=============================================================================== subroutine med_phases_history_write_avg_atm(gcomp, rc) - ! Write mediator history file for atm variables - ! input/output variables - type(ESMF_GridComp) :: gcomp + ! Write mediator average history file for atm variables + type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc - ! local variables - integer :: n + type(InternalState) :: is_local + integer :: n + character(CL) :: alarmname + logical :: first_time = .true. character(len=*), parameter :: subname='(med_phases_history_write_avg_atm)' !--------------------------------------- rc = ESMF_SUCCESS call t_startf('MED:'//subname) - call med_phases_history_write_hfile(gcomp, 'atm', hclock_avg_comp(compatm), & - 'alarm_history_avg_atm', .true., rc) + alarmname = 'alarm_history_avg_'//trim(compname(compatm)) + if (first_time) then + ! get internal state + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! init alarms + call med_phases_history_init_avg(gcomp, trim(alarmname), hclock_avg_comp(compwav), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! accumulated import fields + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(compatm,compatm),rc=rc)) then + call med_methods_fb_init(avgfiles_import(n)%FBaccum, is_local%wrap%flds_scalar_name, & + FBgeom=is_local%wrap%FBImp(compatm,compatm), STflds=is_local%wrap%NStateImp(compatm), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call med_methods_FB_reset(avgfiles_import(compatm)%FBaccum, czero, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + avgfiles_import(compatm)%accumcnt = 0 + end if + ! accumulated export fields + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(compatm), rc=rc)) then + call med_methods_fb_init(avgfiles_export(compatm)%FBaccum, is_local%wrap%flds_scalar_name, & + FBgeom=is_local%wrap%FBExp(compatm), STflds=is_local%wrap%NstateExp(compatm), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call med_methods_FB_reset(avgfiles_export(compatm)%FBaccum, czero, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + avgfiles_export(compatm)%accumcnt = 0 + end if + first_time = .false. + end if + call ESMF_ClockAdvance(hclock_inst_comp(compatm), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_phases_history_write_hfile(gcomp, trim(compname(compatm)), hclock_avg_comp(compatm), & + trim(alarmname), .false., rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call t_stopf('MED:'//subname) end subroutine med_phases_history_write_avg_atm + !=============================================================================== subroutine med_phases_history_write_avg_ice(gcomp, rc) - ! Write mediator history file for ice variables - ! input/output variables + ! Write mediator average history file for ice variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc - ! local variables + type(InternalState) :: is_local + integer :: n + character(CL) :: alarmname + logical :: first_time = .true. character(len=*), parameter :: subname='(med_phases_history_write_avg_ice)' !--------------------------------------- rc = ESMF_SUCCESS call t_startf('MED:'//subname) - call med_phases_history_write_hfile(gcomp, 'ice', hclock_avg_comp(compice), & - 'alarm_history_avg_ice', .true., rc) + alarmname = 'alarm_history_avg_'//trim(compname(compice)) + if (first_time) then + ! get internal state + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! init alarms + call med_phases_history_init_avg(gcomp, trim(alarmname), hclock_avg_comp(compwav), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! accumulated import fields + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(compice,compice),rc=rc)) then + call med_methods_fb_init(avgfiles_import(n)%FBaccum, is_local%wrap%flds_scalar_name, & + FBgeom=is_local%wrap%FBImp(compice,compice), STflds=is_local%wrap%NStateImp(compice), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call med_methods_FB_reset(avgfiles_import(compice)%FBaccum, czero, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + avgfiles_import(compice)%accumcnt = 0 + end if + ! accumulated export fields + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(compice), rc=rc)) then + call med_methods_fb_init(avgfiles_export(compice)%FBaccum, is_local%wrap%flds_scalar_name, & + FBgeom=is_local%wrap%FBExp(compice), STflds=is_local%wrap%NstateExp(compice), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call med_methods_FB_reset(avgfiles_export(compice)%FBaccum, czero, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + avgfiles_export(compice)%accumcnt = 0 + end if + first_time = .false. + end if + call ESMF_ClockAdvance(hclock_inst_comp(compice), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_phases_history_write_hfile(gcomp, trim(compname(compice)), hclock_avg_comp(compice), & + trim(alarmname), .false., rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call t_stopf('MED:'//subname) end subroutine med_phases_history_write_avg_ice + !=============================================================================== subroutine med_phases_history_write_avg_glc(gcomp, rc) - ! Write mediator history file for glc variables - ! input/output variables + ! Write mediator average history file for glc variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc - ! local variables + type(InternalState) :: is_local + integer :: n + character(CL) :: alarmname + logical :: first_time = .true. character(len=*), parameter :: subname='(med_phases_history_write_avg_glc)' !--------------------------------------- rc = ESMF_SUCCESS call t_startf('MED:'//subname) - call med_phases_history_write_hfile(gcomp, 'glc', hclock_avg_comp(compglc), & - 'alarm_history_avg_glc', .true., rc) + alarmname = 'alarm_history_avg_'//trim(compname(compglc)) + if (first_time) then + ! get internal state + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! init alarms + call med_phases_history_init_avg(gcomp, trim(alarmname), hclock_avg_comp(compwav), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! accumulated import fields + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(compglc,compglc),rc=rc)) then + call med_methods_fb_init(avgfiles_import(n)%FBaccum, is_local%wrap%flds_scalar_name, & + FBgeom=is_local%wrap%FBImp(compglc,compglc), STflds=is_local%wrap%NStateImp(compglc), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call med_methods_FB_reset(avgfiles_import(compglc)%FBaccum, czero, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + avgfiles_import(compglc)%accumcnt = 0 + end if + ! accumulated export fields + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(compglc), rc=rc)) then + call med_methods_fb_init(avgfiles_export(compglc)%FBaccum, is_local%wrap%flds_scalar_name, & + FBgeom=is_local%wrap%FBExp(compglc), STflds=is_local%wrap%NstateExp(compglc), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call med_methods_FB_reset(avgfiles_export(compglc)%FBaccum, czero, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + avgfiles_export(compglc)%accumcnt = 0 + end if + first_time = .false. + end if + call ESMF_ClockAdvance(hclock_inst_comp(compglc), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_phases_history_write_hfile(gcomp, trim(compname(compglc)), hclock_avg_comp(compglc), & + trim(alarmname), .false., rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call t_stopf('MED:'//subname) end subroutine med_phases_history_write_avg_glc + !=============================================================================== subroutine med_phases_history_write_avg_lnd(gcomp, rc) - ! Write mediator history file for lnd variables - ! input/output variables + ! Write mediator average history file for lnd variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc - ! local variables + type(InternalState) :: is_local + integer :: n + character(CL) :: alarmname + logical :: first_time = .true. character(len=*), parameter :: subname='(med_phases_history_write_avg_lnd)' !--------------------------------------- rc = ESMF_SUCCESS call t_startf('MED:'//subname) - call med_phases_history_write_hfile(gcomp, 'lnd', hclock_avg_comp(complnd), & - 'alarm_history_avg_lnd', .true., rc) + alarmname = 'alarm_history_avg_'//trim(compname(complnd)) + if (first_time) then + ! get internal state + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! init alarms + call med_phases_history_init_avg(gcomp, trim(alarmname), hclock_avg_comp(compwav), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! accumulated import fields + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(complnd,complnd),rc=rc)) then + call med_methods_fb_init(avgfiles_import(n)%FBaccum, is_local%wrap%flds_scalar_name, & + FBgeom=is_local%wrap%FBImp(complnd,complnd), STflds=is_local%wrap%NStateImp(complnd), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call med_methods_FB_reset(avgfiles_import(complnd)%FBaccum, czero, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + avgfiles_import(complnd)%accumcnt = 0 + end if + ! accumulated export fields + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(complnd), rc=rc)) then + call med_methods_fb_init(avgfiles_export(complnd)%FBaccum, is_local%wrap%flds_scalar_name, & + FBgeom=is_local%wrap%FBExp(complnd), STflds=is_local%wrap%NstateExp(complnd), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call med_methods_FB_reset(avgfiles_export(complnd)%FBaccum, czero, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + avgfiles_export(complnd)%accumcnt = 0 + end if + first_time = .false. + end if + call ESMF_ClockAdvance(hclock_inst_comp(complnd), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_phases_history_write_hfile(gcomp, trim(compname(complnd)), hclock_avg_comp(complnd), & + trim(alarmname), .false., rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call t_stopf('MED:'//subname) end subroutine med_phases_history_write_avg_lnd + !=============================================================================== subroutine med_phases_history_write_avg_ocn(gcomp, rc) - ! Write mediator history file for ocn variables - ! input/output variables + ! Write mediator average history file for ocn variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc - ! local variables + type(InternalState) :: is_local + integer :: n + character(CL) :: alarmname + logical :: first_time = .true. character(len=*), parameter :: subname='(med_phases_history_write_avg_ocn)' !--------------------------------------- rc = ESMF_SUCCESS call t_startf('MED:'//subname) - call med_phases_history_write_hfile(gcomp, 'ocn', hclock_avg_comp(compocn), & - 'alarm_history_avg_ocn', .true., rc) + alarmname = 'alarm_history_avg_'//trim(compname(compocn)) + if (first_time) then + ! get internal state + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! init alarms + call med_phases_history_init_avg(gcomp, trim(alarmname), hclock_avg_comp(compwav), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! accumulated import fields + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(compocn,compocn),rc=rc)) then + call med_methods_fb_init(avgfiles_import(n)%FBaccum, is_local%wrap%flds_scalar_name, & + FBgeom=is_local%wrap%FBImp(compocn,compocn), STflds=is_local%wrap%NStateImp(compocn), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call med_methods_FB_reset(avgfiles_import(compocn)%FBaccum, czero, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + avgfiles_import(compocn)%accumcnt = 0 + end if + ! accumulated export fields + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(compocn), rc=rc)) then + call med_methods_fb_init(avgfiles_export(compocn)%FBaccum, is_local%wrap%flds_scalar_name, & + FBgeom=is_local%wrap%FBExp(compocn), STflds=is_local%wrap%NstateExp(compocn), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call med_methods_FB_reset(avgfiles_export(compocn)%FBaccum, czero, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + avgfiles_export(compocn)%accumcnt = 0 + end if + first_time = .false. + end if + call ESMF_ClockAdvance(hclock_inst_comp(compocn), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_phases_history_write_hfile(gcomp, trim(compname(compocn)), hclock_avg_comp(compocn), & + trim(alarmname), .false., rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call t_stopf('MED:'//subname) end subroutine med_phases_history_write_avg_ocn + !=============================================================================== subroutine med_phases_history_write_avg_rof(gcomp, rc) - ! Write mediator history file for rof variables - ! input/output variables + ! Write mediator average history file for rof variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc - ! local variables + type(InternalState) :: is_local + integer :: n + character(CL) :: alarmname + logical :: first_time = .true. character(len=*), parameter :: subname='(med_phases_history_write_avg_rof)' !--------------------------------------- rc = ESMF_SUCCESS call t_startf('MED:'//subname) - call med_phases_history_write_hfile(gcomp, 'rof', hclock_avg_comp(comprof), & - 'alarm_history_avg_rof', .true., rc) + alarmname = 'alarm_history_avg_'//trim(compname(comprof)) + if (first_time) then + ! get internal state + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! init alarms + call med_phases_history_init_avg(gcomp, trim(alarmname), hclock_avg_comp(compwav), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! accumulated import fields + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(comprof,comprof),rc=rc)) then + call med_methods_fb_init(avgfiles_import(n)%FBaccum, is_local%wrap%flds_scalar_name, & + FBgeom=is_local%wrap%FBImp(comprof,comprof), STflds=is_local%wrap%NStateImp(comprof), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call med_methods_FB_reset(avgfiles_import(comprof)%FBaccum, czero, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + avgfiles_import(comprof)%accumcnt = 0 + end if + ! accumulated export fields + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(comprof), rc=rc)) then + call med_methods_fb_init(avgfiles_export(comprof)%FBaccum, is_local%wrap%flds_scalar_name, & + FBgeom=is_local%wrap%FBExp(comprof), STflds=is_local%wrap%NstateExp(comprof), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call med_methods_FB_reset(avgfiles_export(comprof)%FBaccum, czero, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + avgfiles_export(comprof)%accumcnt = 0 + end if + first_time = .false. + end if + call ESMF_ClockAdvance(hclock_inst_comp(comprof), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_phases_history_write_hfile(gcomp, trim(compname(comprof)), hclock_avg_comp(comprof), & + trim(alarmname), .false., rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call t_stopf('MED:'//subname) end subroutine med_phases_history_write_avg_rof + !=============================================================================== subroutine med_phases_history_write_avg_wav(gcomp, rc) - ! Write mediator history file for wav variables - - ! input/output variables + ! Write mediator average history file for wav variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc - - ! local variables - logical :: first_time = .true. - character(CL) :: alarmname + type(InternalState) :: is_local + integer :: n + character(CL) :: alarmname + logical :: first_time = .true. character(len=*), parameter :: subname='(med_phases_history_write_avg_wav)' !--------------------------------------- rc = ESMF_SUCCESS call t_startf('MED:'//subname) - call med_phases_history_write_hfile(gcomp, 'wav', hclock_avg_comp(compwav), & - 'alarm_history_avg_wav', .true., rc) + alarmname = 'alarm_history_avg_'//trim(compname(compwav)) + if (first_time) then + ! get internal state + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! init alarms + call med_phases_history_init_avg(gcomp, trim(alarmname), hclock_avg_comp(compwav), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! accumulated import fields + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(compwav,compwav),rc=rc)) then + call med_methods_fb_init(avgfiles_import(n)%FBaccum, is_local%wrap%flds_scalar_name, & + FBgeom=is_local%wrap%FBImp(compwav,compwav), STflds=is_local%wrap%NStateImp(compwav), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call med_methods_FB_reset(avgfiles_import(compwav)%FBaccum, czero, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + avgfiles_import(compwav)%accumcnt = 0 + end if + ! accumulated export fields + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(compwav), rc=rc)) then + call med_methods_fb_init(avgfiles_export(compwav)%FBaccum, is_local%wrap%flds_scalar_name, & + FBgeom=is_local%wrap%FBExp(compwav), STflds=is_local%wrap%NstateExp(compwav), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call med_methods_FB_reset(avgfiles_export(compwav)%FBaccum, czero, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + avgfiles_export(compwav)%accumcnt = 0 + end if + first_time = .false. + end if + call ESMF_ClockAdvance(hclock_inst_comp(compwav), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_phases_history_write_hfile(gcomp, trim(compname(compwav)), hclock_avg_comp(compwav), & + trim(alarmname), .false., rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call t_stopf('MED:'//subname) end subroutine med_phases_history_write_avg_wav @@ -1365,10 +1552,8 @@ end subroutine med_phases_history_write_avg_wav !=============================================================================== subroutine med_phases_history_write_aux_atm(gcomp, rc) ! Write mediator history file for atm variables - ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc - ! local variables logical :: first_time = .true. integer :: n character(len=*), parameter :: subname='(med_phases_history_write_aux_atm)' @@ -1392,12 +1577,11 @@ subroutine med_phases_history_write_aux_atm(gcomp, rc) call t_stopf('MED:'//subname) end subroutine med_phases_history_write_aux_atm + !=============================================================================== subroutine med_phases_history_write_aux_ice(gcomp, rc) ! Write mediator history file for ice variables - ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc - ! local variables logical :: first_time = .true. integer :: n character(len=*), parameter :: subname='(med_phases_history_write_aux_ice)' @@ -1421,12 +1605,11 @@ subroutine med_phases_history_write_aux_ice(gcomp, rc) call t_stopf('MED:'//subname) end subroutine med_phases_history_write_aux_ice + !=============================================================================== subroutine med_phases_history_write_aux_glc(gcomp, rc) ! Write mediator history file for glc variables - ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc - ! local variables logical :: first_time = .true. integer :: n character(len=*), parameter :: subname='(med_phases_history_write_aux_glc)' @@ -1450,12 +1633,11 @@ subroutine med_phases_history_write_aux_glc(gcomp, rc) call t_stopf('MED:'//subname) end subroutine med_phases_history_write_aux_glc + !=============================================================================== subroutine med_phases_history_write_aux_lnd(gcomp, rc) ! Write mediator history file for lnd variables - ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc - ! local variables logical :: first_time = .true. integer :: n character(len=*), parameter :: subname='(med_phases_history_write_aux_lnd)' @@ -1479,12 +1661,11 @@ subroutine med_phases_history_write_aux_lnd(gcomp, rc) call t_stopf('MED:'//subname) end subroutine med_phases_history_write_aux_lnd + !=============================================================================== subroutine med_phases_history_write_aux_ocn(gcomp, rc) ! Write mediator history file for ocn variables - ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc - ! local variables logical :: first_time = .true. integer :: n character(len=*), parameter :: subname='(med_phases_history_write_aux_ocn)' @@ -1508,12 +1689,11 @@ subroutine med_phases_history_write_aux_ocn(gcomp, rc) call t_stopf('MED:'//subname) end subroutine med_phases_history_write_aux_ocn + !=============================================================================== subroutine med_phases_history_write_aux_rof(gcomp, rc) ! Write mediator history file for rof variables - ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc - ! local variables logical :: first_time = .true. integer :: n character(len=*), parameter :: subname='(med_phases_history_write_aux_rof)' @@ -1537,12 +1717,11 @@ subroutine med_phases_history_write_aux_rof(gcomp, rc) call t_stopf('MED:'//subname) end subroutine med_phases_history_write_aux_rof + !=============================================================================== subroutine med_phases_history_write_aux_wav(gcomp, rc) ! Write mediator history file for wav variables - ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc - ! local variables logical :: first_time = .true. integer :: n character(len=*), parameter :: subname='(med_phases_history_write_aux_wav)' From 5d6c34410994ea351d1bb8162543b50cdd3aaaed Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 3 Nov 2020 09:41:52 -0700 Subject: [PATCH 21/61] removal of more calls to med_methods_mod --- mediator/med.F90 | 30 ++++++++++++++++++------------ 1 file changed, 18 insertions(+), 12 deletions(-) diff --git a/mediator/med.F90 b/mediator/med.F90 index b4946cd49..f90244dcb 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -22,7 +22,6 @@ module MED use med_methods_mod , only : FB_Reset => med_methods_FB_Reset use med_methods_mod , only : FB_FldChk => med_methods_FB_FldChk 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 @@ -2521,7 +2520,7 @@ subroutine med_meshinfo_create(FB, mesh_info, rc) integer , intent(out) :: rc ! local variables - type(ESMF_Field) :: lfield + integer :: nfield type(ESMF_Mesh) :: lmesh type(ESMF_Array) :: lArray type(ESMF_DistGrid) :: lDistGrid @@ -2529,33 +2528,37 @@ subroutine med_meshinfo_create(FB, mesh_info, rc) integer :: spatialDim real(r8), allocatable :: ownedElemCoords(:) real(r8), pointer :: dataptr(:) => null() - integer :: n, dimcount, fieldcount + integer :: n, dimcount + integer :: fieldcount + type(ESMF_Field), pointer :: fieldlist(:) => null() character(len=*),parameter :: subname=' (module_MED:med_meshinfo_create) ' !------------------------------------------------------------------------------- rc= ESMF_SUCCESS + ! Find the first field in FB with dimcount==1 call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ! Find the first field in FB with dimcount==1 + allocate(fieldlist(fieldcount)) + call ESMF_FieldBundleGet(FB, fieldlist=fieldlist, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return do n=1,fieldCount - call FB_getFieldN(FB, fieldnum=n, field=lfield, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_FieldGet(lfield, mesh=lmesh, dimcount=dimCount, rc=rc) + call ESMF_FieldGet(fieldlist(n), mesh=lmesh, dimcount=dimCount, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (dimCount==1) exit + if (dimCount==1) then + nfield = n + exit + end if enddo - call ESMF_FieldRegridGetArea(lfield, rc=rc) + call ESMF_FieldRegridGetArea(fieldlist(nfield), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_MeshGet(lmesh, spatialDim=spatialDim, numOwnedElements=numOwnedElements, & elementDistGrid=lDistGrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! Allocate mesh_info data, we need a copy here because the FB may get reset later allocate(mesh_info%areas(numOwnedElements)) - call ESMF_FieldGet(lfield, farrayPtr=dataptr, rc=rc) + call ESMF_FieldGet(fieldlist(n), farrayPtr=dataptr, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return mesh_info%areas = dataptr @@ -2570,7 +2573,10 @@ subroutine med_meshinfo_create(FB, mesh_info, rc) mesh_info%lons(n) = ownedElemCoords(2*n-1) mesh_info%lats(n) = ownedElemCoords(2*n) end do + + ! Deallocate memory deallocate(ownedElemCoords) + deallocate(fieldlist) end subroutine med_meshinfo_create From 60dad9950ed33cc20a4c9b08a40ff7cc0b1bd025 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 11 Apr 2021 21:39:36 -0600 Subject: [PATCH 22/61] verified that instantaneous output works --- cime_config/runseq/gen_runseq.py | 6 +- mediator/med.F90 | 22 +- mediator/med_io_mod.F90 | 6 +- mediator/med_phases_history_mod.F90 | 1219 ++++++++++----------------- 4 files changed, 441 insertions(+), 812 deletions(-) diff --git a/cime_config/runseq/gen_runseq.py b/cime_config/runseq/gen_runseq.py index dc87c8644..e98f17f0a 100644 --- a/cime_config/runseq/gen_runseq.py +++ b/cime_config/runseq/gen_runseq.py @@ -46,9 +46,9 @@ def leave_time_loop(self, leave_time, if_write_hist_rest=False ): if leave_time and self.__time_loop: _, active_depth = self.__time_loop.pop() if if_write_hist_rest or active_depth == 0: - self.__outfile.write (" MED med_phases_history_write_inst_all \n" ) - self.__outfile.write (" MED med_phases_restart_write \n" ) - self.__outfile.write (" MED med_phases_profile \n" ) + self.__outfile.write (" MED med_phases_history_write \n" ) + self.__outfile.write (" MED med_phases_restart_write \n" ) + self.__outfile.write (" MED med_phases_profile \n" ) self.__outfile.write ("@ \n" ) def __exit_sequence(self): diff --git a/mediator/med.F90 b/mediator/med.F90 index 36585e172..c8c6c6a27 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -90,6 +90,7 @@ subroutine SetServices(gcomp, rc) use NUOPC_Mediator , only: mediator_label_SetRunClock => label_SetRunClock use NUOPC_Mediator , only: mediator_label_Finalize => label_Finalize + use med_phases_history_mod , only: med_phases_history_write use med_phases_history_mod , only: med_phases_history_write_inst_atm use med_phases_history_mod , only: med_phases_history_write_inst_ice use med_phases_history_mod , only: med_phases_history_write_inst_glc @@ -98,7 +99,6 @@ subroutine SetServices(gcomp, rc) use med_phases_history_mod , only: med_phases_history_write_inst_rof use med_phases_history_mod , only: med_phases_history_write_inst_wav use med_phases_history_mod , only: med_phases_history_write_inst_med - use med_phases_history_mod , only: med_phases_history_write_inst_all use med_phases_history_mod , only: med_phases_history_write_avg_atm use med_phases_history_mod , only: med_phases_history_write_avg_ice @@ -221,10 +221,10 @@ subroutine SetServices(gcomp, rc) !------------------ call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_inst_all"/), userRoutine=mediator_routine_Run, rc=rc) + phaseLabelList=(/"med_phases_history_write"/), userRoutine=mediator_routine_Run, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_inst_all", specRoutine=med_phases_history_write_inst_all, rc=rc) + specPhaseLabel="med_phases_history_write", specRoutine=med_phases_history_write, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ @@ -2772,15 +2772,13 @@ subroutine med_meshinfo_create(FB, mesh_info, rc) integer , intent(out) :: rc ! local variables - integer :: nfield + type(ESMF_Field) :: lfield type(ESMF_Mesh) :: lmesh integer :: numOwnedElements integer :: spatialDim real(r8), allocatable :: ownedElemCoords(:) real(r8), pointer :: dataptr(:) => null() - integer :: n, dimcount - integer :: fieldcount - type(ESMF_Field), pointer :: fieldlist(:) => null() + integer :: n, dimcount, fieldcount character(len=*),parameter :: subname=' (module_MED:med_meshinfo_create) ' !------------------------------------------------------------------------------- @@ -2794,10 +2792,7 @@ subroutine med_meshinfo_create(FB, mesh_info, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldGet(lfield, mesh=lmesh, dimcount=dimCount, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (dimCount==1) then - nfield = n - exit - end if + if (dimCount==1) exit enddo ! Determine dimensions in mesh @@ -2808,7 +2803,7 @@ subroutine med_meshinfo_create(FB, mesh_info, rc) call ESMF_FieldRegridGetArea(lfield, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return allocate(mesh_info%areas(numOwnedElements)) - call ESMF_FieldGet(fieldlist(n), farrayPtr=dataptr, rc=rc) + call ESMF_FieldGet(lfield, farrayPtr=dataptr, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return mesh_info%areas(:) = dataptr @@ -2822,10 +2817,7 @@ subroutine med_meshinfo_create(FB, mesh_info, rc) mesh_info%lons(n) = ownedElemCoords(2*n-1) mesh_info%lats(n) = ownedElemCoords(2*n) end do - - ! Deallocate memory deallocate(ownedElemCoords) - deallocate(fieldlist) end subroutine med_meshinfo_create diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index 0e51e8ed2..511d932a2 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -133,9 +133,10 @@ 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 ESMF , only : ESMF_UtilStringUpperCase use NUOPC, only : NUOPC_CompAttributeGet #endif + use ESMF , only : ESMF_GridComp ! input/output arguments type(ESMF_GridComp), intent(in) :: gcomp @@ -167,10 +168,13 @@ subroutine med_io_init(gcomp, rc) #endif #ifdef CESMCOUPLED + io_subsystem => shr_pio_getiosys(med_id) pio_iotype = shr_pio_getiotype(med_id) pio_ioformat = shr_pio_getioformat(med_id) + #else + ! query VM call ESMF_VMGetCurrent(vm=vm, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index a1ae84272..048bc7921 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -21,7 +21,7 @@ module med_phases_history_mod use ESMF , only : ESMF_GridComp, ESMF_GridCompGet use ESMF , only : ESMF_VM, ESMF_VMGet use ESMF , only : ESMF_Clock, ESMF_ClockGet, ESMF_ClockSet, ESMF_ClockAdvance, ESMF_ClockCreate - use ESMF , only : ESMF_ClockGetNextTime, ESMF_ClockGetAlarm + use ESMF , only : ESMF_ClockGetNextTime, ESMF_ClockGetAlarm, ESMF_ClockIsCreated use ESMF , only : ESMF_Calendar use ESMF , only : ESMF_Time, ESMF_TimeGet use ESMF , only : ESMF_TimeInterval, ESMF_TimeIntervalGet, ESMF_TimeIntervalSet @@ -36,7 +36,7 @@ module med_phases_history_mod use NUOPC , only : NUOPC_CompAttributeGet use NUOPC_Model , only : NUOPC_ModelGet use esmFlds , only : compmed, compatm, complnd, compocn, compice, comprof, compglc, compwav - use esmFlds , only : ncomps, compname + use esmFlds , only : ncomps, compname, num_icesheets use esmFlds , only : fldListFr, fldListTo use med_constants_mod , only : SecPerDay => med_constants_SecPerDay use med_constants_mod , only : czero => med_constants_czero @@ -57,7 +57,7 @@ module med_phases_history_mod private ! Public routines called from the run sequence - public :: med_phases_history_write_inst_all + public :: med_phases_history_write public :: med_phases_history_write_inst_med public :: med_phases_history_write_inst_atm public :: med_phases_history_write_inst_ice @@ -67,14 +67,6 @@ module med_phases_history_mod public :: med_phases_history_write_inst_rof public :: med_phases_history_write_inst_wav - public :: med_phases_history_write_avg_atm - public :: med_phases_history_write_avg_ice - public :: med_phases_history_write_avg_glc - public :: med_phases_history_write_avg_lnd - public :: med_phases_history_write_avg_ocn - public :: med_phases_history_write_avg_rof - public :: med_phases_history_write_avg_wav - public :: med_phases_history_write_aux_atm public :: med_phases_history_write_aux_ice public :: med_phases_history_write_aux_glc @@ -83,10 +75,21 @@ module med_phases_history_mod public :: med_phases_history_write_aux_rof public :: med_phases_history_write_aux_wav + public :: med_phases_history_write_avg_atm + public :: med_phases_history_write_avg_ice + public :: med_phases_history_write_avg_glc + public :: med_phases_history_write_avg_lnd + public :: med_phases_history_write_avg_ocn + public :: med_phases_history_write_avg_rof + public :: med_phases_history_write_avg_wav + ! Private routines - private :: med_phases_history_init_inst ! called the first time a write phase is called - private :: med_phases_history_init_avg ! called the first time a write phase is called - private :: med_phases_history_init_aux ! called the first time a write phase is called + private :: med_phases_history_init_inst ! called the first time a write phase is called + private :: med_phases_history_init_avg ! called the first time a write phase is called + private :: med_phases_history_init_aux ! called the first time a write phase is called + private :: med_phases_history_write_inst_comp ! write instantaneous file for a given component + private :: med_phases_history_write_avg_comp ! write averaged file for a given component + private :: med_phases_history_write_aux_comp ! write auxiliary file for a given component private :: med_phases_history_write_hfile private :: med_phases_history_write_hfileaux private :: med_phases_history_get_filename @@ -94,21 +97,23 @@ module med_phases_history_mod private :: med_phases_history_output_alarminfo private :: med_phases_history_ymds2rday_offset + character(CL) :: case_name ! case name + character(CS) :: inst_tag ! instance tag + + ! Time averaging history files type, public :: avgfile_type type(ESMF_FieldBundle) :: FBaccum ! field bundle for time averaging integer :: accumcnt ! field bundle accumulation counter end type avgfile_type type(avgfile_type) :: avgfiles_import(ncomps) type(avgfile_type) :: avgfiles_export(ncomps) - ! where are the following initialized? - these are mediator specific fields type(avgfile_type) :: avgfiles_aoflux_ocn type(avgfile_type) :: avgfiles_ocnalb_ocn type(avgfile_type) :: avgfiles_aoflux_atm type(avgfile_type) :: avgfiles_ocnalb_atm + type(ESMF_Clock) :: hclock_avg_comp(ncomps) - character(CL) :: case_name ! case name - character(CS) :: inst_tag ! instance tag - + ! Auxiliary history files integer, parameter :: max_auxfiles = 10 type, public :: auxfile_type character(CS), allocatable :: flds(:) ! array of aux field names @@ -120,14 +125,14 @@ module med_phases_history_mod logical :: useavg ! if true, time average, otherwise instantaneous type(ESMF_FieldBundle) :: FBaccum ! field bundle for time averaging integer :: accumcnt ! field bundle accumulation counter - type(ESMF_Clock) :: hclock ! auxiliary history clock + type(ESMF_Clock) :: hclock ! auxiliary history clock end type auxfile_type integer , public :: num_auxfiles(ncomps) = 0 type(auxfile_type) , public :: auxfiles(max_auxfiles,ncomps) + ! Instantaneous history files type(ESMF_Clock) :: hclock_inst_all type(ESMF_Clock) :: hclock_inst_comp(ncomps) - type(ESMF_Clock) :: hclock_avg_comp(ncomps) logical :: debug_alarms = .true. character(*), parameter :: u_FILE_u = & @@ -137,8 +142,289 @@ module med_phases_history_mod contains !=============================================================================== - subroutine med_phases_history_init_inst(gcomp, alarmname, hclock, rc) + !=========================================================== + ! Instantaneous mediator history files + !=========================================================== + + subroutine med_phases_history_write(gcomp, rc) + ! -------------------------------------- + ! Write instantaneous mediator history file for all variables + ! Name has been kept for backwards compatibiliyt + ! -------------------------------------- + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + ! local variables + character(len=*), parameter :: subname='(med_phases_history_write)' + !--------------------------------------- + rc = ESMF_SUCCESS + call t_startf('MED:'//subname) + if (.not. ESMF_ClockIsCreated(hclock_inst_all)) then + call med_phases_history_init_inst(gcomp, 'alarm_history_inst_all', hclock_inst_all, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + call ESMF_ClockAdvance(hclock_inst_all, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_phases_history_write_hfile(gcomp, 'all', hclock_inst_all, 'alarm_history_inst_all', .false., rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call t_stopf('MED:'//subname) + end subroutine med_phases_history_write + + subroutine med_phases_history_write_inst_med(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 + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + !--------------------------------------- + rc = ESMF_SUCCESS + call med_phases_history_write_inst_comp(gcomp, compmed, 'med_phases_history_write_inst_med', rc) + end subroutine med_phases_history_write_inst_med + + subroutine med_phases_history_write_inst_atm(gcomp, rc) + ! Write mediator history file for atm variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + !--------------------------------------- + rc = ESMF_SUCCESS + call med_phases_history_write_inst_comp(gcomp, compatm, 'med_phases_history_write_inst_atm', rc) + end subroutine med_phases_history_write_inst_atm + + subroutine med_phases_history_write_inst_ice(gcomp, rc) + ! Write mediator history file for ice variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + !--------------------------------------- + rc = ESMF_SUCCESS + call med_phases_history_write_inst_comp(gcomp, compice, 'med_phases_history_write_inst_ice', rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end subroutine med_phases_history_write_inst_ice + + subroutine med_phases_history_write_inst_lnd(gcomp, rc) + ! Write mediator history file for lnd variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + !--------------------------------------- + rc = ESMF_SUCCESS + call med_phases_history_write_inst_comp(gcomp, complnd, 'med_phases_history_write_inst_lnd', rc) + end subroutine med_phases_history_write_inst_lnd + + subroutine med_phases_history_write_inst_glc(gcomp, rc) + ! Write mediator history file for glc variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + ! local variables + integer :: ns + character(len=CS) :: cns + !--------------------------------------- + rc = ESMF_SUCCESS + do ns = 1,num_icesheets + write(cns,*) ns + call med_phases_history_write_inst_comp(gcomp, compglc(ns), 'med_phases_history_write_inst_glc'//trim(cns), rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do + end subroutine med_phases_history_write_inst_glc + + subroutine med_phases_history_write_inst_ocn(gcomp, rc) + ! Write mediator history file for ocn variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + !--------------------------------------- + rc = ESMF_SUCCESS + call med_phases_history_write_inst_comp(gcomp, compocn, 'med_phases_history_write_inst_ocn', rc) + end subroutine med_phases_history_write_inst_ocn + + subroutine med_phases_history_write_inst_rof(gcomp, rc) + ! Write mediator history file for rof variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + !--------------------------------------- + rc = ESMF_SUCCESS + call med_phases_history_write_inst_comp(gcomp, comprof, 'med_phases_history_write_inst_rof', rc) + end subroutine med_phases_history_write_inst_rof + + subroutine med_phases_history_write_inst_wav(gcomp, rc) + ! Write mediator history file for wav variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + !--------------------------------------- + rc = ESMF_SUCCESS + call med_phases_history_write_inst_comp(gcomp, compwav, 'med_phases_history_write_inst_wav', rc) + end subroutine med_phases_history_write_inst_wav + + !=========================================================== + ! Time averaged mediator history files + !=========================================================== + + ! Write mediator average history file for atm variables + subroutine med_phases_history_write_avg_atm(gcomp, rc) + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + !--------------------------------------- + rc = ESMF_SUCCESS + call med_phases_history_write_avg_comp(gcomp, compatm, 'med_phases_history_write_avg_atm', rc) + end subroutine med_phases_history_write_avg_atm + + ! Write mediator average history file for ice variables + subroutine med_phases_history_write_avg_ice(gcomp, rc) + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + !--------------------------------------- + rc = ESMF_SUCCESS + call med_phases_history_write_avg_comp(gcomp, compice, 'med_phases_history_write_avg_ice', rc) + end subroutine med_phases_history_write_avg_ice + + ! Write mediator average history file for glc variables + subroutine med_phases_history_write_avg_glc(gcomp, rc) + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + ! local variables + integer :: ns + character(len=CS) :: cns + !--------------------------------------- + rc = ESMF_SUCCESS + do ns = 1,num_icesheets + write(cns,*) ns + call med_phases_history_write_avg_comp(gcomp, compglc(ns), 'med_phases_history_write_avg_glc'//trim(cns), rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do + end subroutine med_phases_history_write_avg_glc + + ! Write mediator average history file for lnd variables + subroutine med_phases_history_write_avg_lnd(gcomp, rc) + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + !--------------------------------------- + rc = ESMF_SUCCESS + call med_phases_history_write_avg_comp(gcomp, complnd, 'med_phases_history_write_avg_lnd', rc) + end subroutine med_phases_history_write_avg_lnd + + ! Write mediator average history file for ocn variables + subroutine med_phases_history_write_avg_ocn(gcomp, rc) + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + !--------------------------------------- + rc = ESMF_SUCCESS + call med_phases_history_write_avg_comp(gcomp, compocn, 'med_phases_history_write_avg_ocn', rc) + end subroutine med_phases_history_write_avg_ocn + + ! Write mediator average history file for rof variables + subroutine med_phases_history_write_avg_rof(gcomp, rc) + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + !--------------------------------------- + rc = ESMF_SUCCESS + call med_phases_history_write_avg_comp(gcomp, comprof, 'med_phases_history_write_avg_rof', rc) + end subroutine med_phases_history_write_avg_rof + + ! Write mediator average history file for wav variables + subroutine med_phases_history_write_avg_wav(gcomp, rc) + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + !--------------------------------------- + rc = ESMF_SUCCESS + call med_phases_history_write_avg_comp(gcomp, compwav, 'med_phases_history_write_avg_wav', rc) + end subroutine med_phases_history_write_avg_wav + + !=========================================================== + ! Auxiliary mediator history files + !=========================================================== + + ! Write mediator history file for atm variables + subroutine med_phases_history_write_aux_atm(gcomp, rc) + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + logical :: first_time = .true. + !--------------------------------------- + rc = ESMF_SUCCESS + call med_phases_history_write_aux_comp(gcomp, compatm, first_time, 'med_phases_history_write_aux_atm', rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (first_time) first_time = .false. + end subroutine med_phases_history_write_aux_atm + + ! Write mediator history file for ice variables + subroutine med_phases_history_write_aux_ice(gcomp, rc) + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + logical :: first_time = .true. + !--------------------------------------- + rc = ESMF_SUCCESS + call med_phases_history_write_aux_comp(gcomp, compice, first_time, 'med_phases_history_write_aux_ice', rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (first_time) first_time = .false. + end subroutine med_phases_history_write_aux_ice + + ! Write mediator history file for glc variables + subroutine med_phases_history_write_aux_glc(gcomp, rc) + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + integer :: ns + character(len=CS) :: cns + logical :: first_time = .true. + !--------------------------------------- + rc = ESMF_SUCCESS + do ns = 1,num_icesheets + write(cns,*) ns + call med_phases_history_write_aux_comp(gcomp, compglc(ns), first_time, 'med_phases_history_write_aux_glc'//trim(cns), rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do + if (first_time) first_time = .false. + end subroutine med_phases_history_write_aux_glc + + ! Write mediator history file for lnd variables + subroutine med_phases_history_write_aux_lnd(gcomp, rc) + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + logical :: first_time = .true. + !--------------------------------------- + rc = ESMF_SUCCESS + call med_phases_history_write_aux_comp(gcomp, complnd, first_time, 'med_phases_history_write_aux_lnd', rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (first_time) first_time = .false. + end subroutine med_phases_history_write_aux_lnd + + ! Write mediator history file for ocn variables + subroutine med_phases_history_write_aux_ocn(gcomp, rc) + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + logical :: first_time = .true. + !--------------------------------------- + rc = ESMF_SUCCESS + call med_phases_history_write_aux_comp(gcomp, compocn, first_time, 'med_phases_history_write_aux_ocn', rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (first_time) first_time = .false. + end subroutine med_phases_history_write_aux_ocn + + ! Write mediator history file for rof variables + subroutine med_phases_history_write_aux_rof(gcomp, rc) + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + logical :: first_time = .true. + !--------------------------------------- + rc = ESMF_SUCCESS + call med_phases_history_write_aux_comp(gcomp, comprof, first_time, 'med_phases_history_write_aux_rof', rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (first_time) first_time = .false. + end subroutine med_phases_history_write_aux_rof + + ! Write mediator history file for wav variables + subroutine med_phases_history_write_aux_wav(gcomp, rc) + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + logical :: first_time = .true. + !--------------------------------------- + rc = ESMF_SUCCESS + call med_phases_history_write_aux_comp(gcomp, compwav, first_time, 'med_phases_history_write_aux_wav', rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (first_time) first_time = .false. + end subroutine med_phases_history_write_aux_wav + + !=========================================================== + ! Private Routines + !=========================================================== + subroutine med_phases_history_init_inst(gcomp, alarmname, hclock, compid, rc) ! -------------------------------------- ! Initialize instantaneous history file ! -------------------------------------- @@ -148,6 +434,7 @@ subroutine med_phases_history_init_inst(gcomp, alarmname, hclock, rc) character(len=*) , intent(in) :: alarmname ! alarm name type(ESMF_Clock) , intent(inout) :: hclock integer , intent(out) :: rc + integer, optional , intent(in) :: compid ! local variables type(ESMF_Clock) :: mclock @@ -166,12 +453,6 @@ subroutine med_phases_history_init_inst(gcomp, alarmname, hclock, rc) rc = ESMF_SUCCESS - ! First create hclock from mclock - THIS CALL DOES NOT COPY ALARMS - call NUOPC_ModelGet(gcomp, modelClock=mclock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - hclock = ESMF_ClockCreate(mclock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Determine instantaneous mediator output frequency and type call NUOPC_CompAttributeGet(gcomp, name='history_option', isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -182,11 +463,17 @@ subroutine med_phases_history_init_inst(gcomp, alarmname, hclock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) hist_n else - ! If attribute is not present - don't write histoyr output + ! If attribute is not present - don't write history output hist_option = 'none' hist_n = -999 end if + ! First create hclock from mclock - THIS CALL DOES NOT COPY ALARMS + call NUOPC_ModelGet(gcomp, modelClock=mclock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + hclock = ESMF_ClockCreate(mclock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Set alarm for instantaneous history output ! Advance history clock to trigger alarms then reset history clock back to mcurrtime call ESMF_ClockGet(hclock, startTime=StartTime, currTime=CurrTime, timeStep=timestep, rc=rc) @@ -213,7 +500,7 @@ subroutine med_phases_history_init_inst(gcomp, alarmname, hclock, rc) end subroutine med_phases_history_init_inst !=============================================================================== - subroutine med_phases_history_init_avg(gcomp, alarmname, hclock, rc) + subroutine med_phases_history_init_avg(gcomp, compid, alarmname, hclock, rc) ! ----------------------------- ! Initialize time average history file @@ -221,6 +508,7 @@ subroutine med_phases_history_init_avg(gcomp, alarmname, hclock, rc) ! input/output variables type(ESMF_GridComp) , intent(inout) :: gcomp + integer , intent(in) :: compid character(len=*) , intent(in) :: alarmname ! alarm name type(ESMF_Clock) , intent(inout) :: hclock integer , intent(out) :: rc @@ -238,7 +526,6 @@ subroutine med_phases_history_init_avg(gcomp, alarmname, hclock, rc) integer :: hist_n ! freq_n setting relative to freq_option logical :: isPresent logical :: isSet - logical :: first_time = .true. character(len=*), parameter :: subname=' (med_phases_history_init)' !--------------------------------------- rc = ESMF_SUCCESS @@ -256,7 +543,7 @@ subroutine med_phases_history_init_avg(gcomp, alarmname, hclock, rc) read(cvalue,*) hist_n end if - ! Set alarm for instantaneous history output + ! Set alarm for time averaged history output ! Advance history clock to trigger alarms then reset history clock back to mcurrtime call ESMF_ClockGet(hclock, startTime=StartTime, currTime=CurrTime, timeStep=timestep, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -270,50 +557,85 @@ subroutine med_phases_history_init_avg(gcomp, alarmname, hclock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Create time average field bundles (module variables) - if (first_time) then - if (hist_option /= 'never' .and. hist_option /= 'none') then - nullify(is_local%wrap) - call ESMF_GridCompGetInternalState(gcomp, is_local, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (hist_option /= 'never' .and. hist_option /= 'none') then + + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (compid /= compmed) then + + ! create accumulated import fields + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(compid,compid),rc=rc)) then + if (.not. ESMF_FieldBundleIsCreated(avgfiles_import(compid)%FBaccum)) then + call med_methods_fb_init(avgfiles_import(compid)%FBaccum, is_local%wrap%flds_scalar_name, & + FBgeom=is_local%wrap%FBImp(compid,compid), STflds=is_local%wrap%NStateImp(compid), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call med_methods_FB_reset(avgfiles_import(compid)%FBaccum, czero, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + avgfiles_import(compid)%accumcnt = 0 + end if + end if + ! accumulated export fields + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(compid), rc=rc)) then + if (.not. ESMF_FieldBundleIsCreated(avgfiles_export(compid)%FBaccum)) then + call med_methods_fb_init(avgfiles_export(compid)%FBaccum, is_local%wrap%flds_scalar_name, & + FBgeom=is_local%wrap%FBExp(compid), STflds=is_local%wrap%NstateExp(compid), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call med_methods_FB_reset(avgfiles_export(compid)%FBaccum, czero, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + avgfiles_export(compid)%accumcnt = 0 + end if + end if + + else ! compid is compmed ! accumulated atm/ocn flux on ocn mesh if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_o, rc=rc)) then - call med_methods_fb_init(avgfiles_aoflux_ocn%FBaccum, is_local%wrap%flds_scalar_name, & - FBgeom=is_local%wrap%FBMed_aoflux_o, FBflds=is_local%wrap%FBMed_aoflux_o, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call med_methods_FB_reset(avgfiles_aoflux_ocn%FBaccum, czero, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - avgfiles_aoflux_ocn%accumcnt = 0 + if (.not. ESMF_FieldBundleIsCreated(avgfiles_aoflux_ocn%FBaccum)) then + call med_methods_fb_init(avgfiles_aoflux_ocn%FBaccum, is_local%wrap%flds_scalar_name, & + FBgeom=is_local%wrap%FBMed_aoflux_o, FBflds=is_local%wrap%FBMed_aoflux_o, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call med_methods_FB_reset(avgfiles_aoflux_ocn%FBaccum, czero, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + avgfiles_aoflux_ocn%accumcnt = 0 + end if end if ! accumulated atm/ocn flux on atm mesh if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a, rc=rc)) then - call med_methods_fb_init(avgfiles_aoflux_atm%FBaccum, is_local%wrap%flds_scalar_name, & - FBgeom=is_local%wrap%FBMed_aoflux_a, FBflds=is_local%wrap%FBMed_aoflux_a, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call med_methods_FB_reset(avgfiles_aoflux_atm%FBaccum, czero, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - avgfiles_aoflux_atm%accumcnt = 0 + if (.not. ESMF_FieldBundleIsCreated(avgfiles_aoflux_atm%FBaccum)) then + call med_methods_fb_init(avgfiles_aoflux_atm%FBaccum, is_local%wrap%flds_scalar_name, & + FBgeom=is_local%wrap%FBMed_aoflux_a, FBflds=is_local%wrap%FBMed_aoflux_a, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call med_methods_FB_reset(avgfiles_aoflux_atm%FBaccum, czero, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + avgfiles_aoflux_atm%accumcnt = 0 + end if end if ! accumulated ocean albedo on ocn mesh if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o, rc=rc)) then - call med_methods_fb_init(avgfiles_ocnalb_ocn%FBaccum, is_local%wrap%flds_scalar_name, & - FBgeom=is_local%wrap%FBMed_ocnalb_o, FBflds=is_local%wrap%FBMed_ocnalb_o, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call med_methods_FB_reset(avgfiles_ocnalb_ocn%FBaccum, czero, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - avgfiles_ocnalb_ocn%accumcnt = 0 + if (.not. ESMF_FieldBundleIsCreated(avgfiles_ocnalb_ocn%FBaccum)) then + call med_methods_fb_init(avgfiles_ocnalb_ocn%FBaccum, is_local%wrap%flds_scalar_name, & + FBgeom=is_local%wrap%FBMed_ocnalb_o, FBflds=is_local%wrap%FBMed_ocnalb_o, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call med_methods_FB_reset(avgfiles_ocnalb_ocn%FBaccum, czero, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + avgfiles_ocnalb_ocn%accumcnt = 0 + end if end if ! accumulated ocean albedo on atm mesh if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_a, rc=rc)) then - call med_methods_fb_init(avgfiles_ocnalb_atm%FBaccum, is_local%wrap%flds_scalar_name, & - FBgeom=is_local%wrap%FBMed_ocnalb_a, FBflds=is_local%wrap%FBMed_ocnalb_a, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call med_methods_FB_reset(avgfiles_ocnalb_atm%FBaccum, czero, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - avgfiles_ocnalb_atm%accumcnt = 0 + if (.not. ESMF_FieldBundleIsCreated(avgfiles_ocnalb_atm%FBaccum)) then + call med_methods_fb_init(avgfiles_ocnalb_atm%FBaccum, is_local%wrap%flds_scalar_name, & + FBgeom=is_local%wrap%FBMed_ocnalb_a, FBflds=is_local%wrap%FBMed_ocnalb_a, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call med_methods_FB_reset(avgfiles_ocnalb_atm%FBaccum, czero, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + avgfiles_ocnalb_atm%accumcnt = 0 + end if end if + end if - first_time = .false. end if end subroutine med_phases_history_init_avg @@ -970,780 +1292,91 @@ subroutine med_phases_history_write_hfileaux(gcomp, case_name, inst_tag, & end subroutine med_phases_history_write_hfileaux !=============================================================================== - subroutine med_phases_history_write_inst_all(gcomp, rc) - ! -------------------------------------- - ! Write mediator history file for all variables - ! This is a phase called by the run sequence - ! -------------------------------------- - ! input/output variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - ! local variables - logical :: first_time = .true. - character(len=*), parameter :: subname='(med_phases_history_write)' - !--------------------------------------- - rc = ESMF_SUCCESS - call t_startf('MED:'//subname) - if (first_time) then - call med_phases_history_init_inst(gcomp, 'alarm_history_inst_all', hclock_inst_all, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - first_time = .false. - end if - call ESMF_ClockAdvance(hclock_inst_all, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_write_hfile(gcomp, 'all', hclock_inst_all, 'alarm_history_inst_all', .false., rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call t_stopf('MED:'//subname) - end subroutine med_phases_history_write_inst_all - - !=============================================================================== - subroutine med_phases_history_write_inst_med(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 + subroutine med_phases_history_write_inst_comp(gcomp, compid, subname, rc) + ! Write instantaneous mediator history file for component compid ! input/output variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc + type(ESMF_GridComp) , intent(inout) :: gcomp + integer , intent(in) :: compid + character(len=*) , intent(in) :: subname + integer , intent(out) :: rc ! local variables - logical :: first_time = .true. - character(CL) :: alarmname - character(len=*), parameter :: subname='(med_phases_history_write_med)' - !--------------------------------------- - rc = ESMF_SUCCESS - call t_startf('MED:'//subname) - alarmname = 'alarm_history_inst_'//trim(compname(compmed)) - if (first_time) then - call med_phases_history_init_inst(gcomp, trim(alarmname), hclock_inst_comp(compmed), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - first_time = .false. - end if - call ESMF_ClockAdvance(hclock_inst_comp(compmed), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_write_hfile(gcomp, trim(compname(compmed)), hclock_inst_comp(compmed), & - trim(alarmname), .false., rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call t_stopf('MED:'//subname) - end subroutine med_phases_history_write_inst_med - - !=============================================================================== - subroutine med_phases_history_write_inst_atm(gcomp, rc) - ! Write mediator history file for atm variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - logical :: first_time = .true. - character(CL) :: alarmname - character(len=*), parameter :: subname='(med_phases_history_write_inst_atm)' - !--------------------------------------- - rc = ESMF_SUCCESS - call t_startf('MED:'//subname) - alarmname = 'alarm_history_inst_'//trim(compname(compatm)) - if (first_time) then - call med_phases_history_init_inst(gcomp, trim(alarmname), hclock_inst_comp(compatm), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - first_time = .false. - end if - call ESMF_ClockAdvance(hclock_inst_comp(compatm), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_write_hfile(gcomp, trim(compname(compatm)), hclock_inst_comp(compatm), & - trim(alarmname), .false., rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call t_stopf('MED:'//subname) - end subroutine med_phases_history_write_inst_atm - - !=============================================================================== - subroutine med_phases_history_write_inst_ice(gcomp, rc) - ! Write mediator history file for ice variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - logical :: first_time = .true. - character(CL) :: alarmname - character(len=*), parameter :: subname='(med_phases_history_write_inst_ice)' - !--------------------------------------- - rc = ESMF_SUCCESS - call t_startf('MED:'//subname) - alarmname = 'alarm_history_inst_'//trim(compname(compice)) - if (first_time) then - call med_phases_history_init_inst(gcomp, trim(alarmname), hclock_inst_comp(compice), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - first_time = .false. - end if - call ESMF_ClockAdvance(hclock_inst_comp(compice), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_write_hfile(gcomp, trim(compname(compice)), hclock_inst_comp(compice),& - trim(alarmname), .false., rc) - call t_stopf('MED:'//subname) - end subroutine med_phases_history_write_inst_ice - - !=============================================================================== - subroutine med_phases_history_write_inst_glc(gcomp, rc) - ! Write mediator history file for glc variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - logical :: first_time = .true. character(CL) :: alarmname - character(len=*), parameter :: subname='(med_phases_history_write_inst_glc)' - !--------------------------------------- - rc = ESMF_SUCCESS - call t_startf('MED:'//subname) - alarmname = 'alarm_history_inst_'//trim(compname(compglc)) - if (first_time) then - call med_phases_history_init_inst(gcomp, trim(alarmname), hclock_inst_comp(compglc), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - first_time = .false. - end if - call ESMF_ClockAdvance(hclock_inst_comp(compglc), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_write_hfile(gcomp, trim(compname(compglc)), hclock_inst_comp(compglc), & - trim(alarmname), .false., rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call t_stopf('MED:'//subname) - end subroutine med_phases_history_write_inst_glc - - !=============================================================================== - subroutine med_phases_history_write_inst_lnd(gcomp, rc) - ! Write mediator history file for lnd variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - logical :: first_time = .true. - character(CL) :: alarmname - character(len=*), parameter :: subname='(med_phases_history_write_inst_lnd)' - !--------------------------------------- - rc = ESMF_SUCCESS - call t_startf('MED:'//subname) - alarmname = 'alarm_history_inst_'//trim(compname(complnd)) - if (first_time) then - call med_phases_history_init_inst(gcomp, trim(alarmname), hclock_inst_comp(complnd), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - first_time = .false. - end if - call ESMF_ClockAdvance(hclock_inst_comp(complnd), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_write_hfile(gcomp, trim(compname(complnd)), hclock_inst_comp(complnd), & - trim(alarmname), .false., rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call t_stopf('MED:'//subname) - end subroutine med_phases_history_write_inst_lnd - - !=============================================================================== - subroutine med_phases_history_write_inst_ocn(gcomp, rc) - ! Write mediator history file for ocn variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - logical :: first_time = .true. - character(CL) :: alarmname - character(len=*), parameter :: subname='(med_phases_history_write_inst_ocn)' - !--------------------------------------- - rc = ESMF_SUCCESS - call t_startf('MED:'//subname) - alarmname = 'alarm_history_inst_'//trim(compname(compocn)) - if (first_time) then - call med_phases_history_init_inst(gcomp, trim(alarmname), hclock_inst_comp(compocn), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - first_time = .false. - end if - call ESMF_ClockAdvance(hclock_inst_comp(compocn), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_write_hfile(gcomp, trim(compname(compocn)), hclock_inst_comp(compocn), & - trim(alarmname), .false., rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call t_stopf('MED:'//subname) - end subroutine med_phases_history_write_inst_ocn - - !=============================================================================== - subroutine med_phases_history_write_inst_rof(gcomp, rc) - ! Write mediator history file for rof variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - logical :: first_time = .true. - character(CL) :: alarmname - character(len=*), parameter :: subname='(med_phases_history_write_inst_rof)' - !--------------------------------------- - rc = ESMF_SUCCESS - call t_startf('MED:'//subname) - alarmname = 'alarm_history_inst_'//trim(compname(comprof)) - if (first_time) then - call med_phases_history_init_inst(gcomp, trim(alarmname), hclock_inst_comp(comprof), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - first_time = .false. - end if - call ESMF_ClockAdvance(hclock_inst_comp(comprof), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_write_hfile(gcomp, trim(compname(comprof)), hclock_inst_comp(comprof), & - trim(alarmname), .false., rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call t_stopf('MED:'//subname) - end subroutine med_phases_history_write_inst_rof - - !=============================================================================== - subroutine med_phases_history_write_inst_wav(gcomp, rc) - ! Write mediator history file for wav variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - logical :: first_time = .true. - character(CL) :: alarmname - character(len=*), parameter :: subname='(med_phases_history_write_inst_wav)' - !--------------------------------------- - rc = ESMF_SUCCESS - call t_startf('MED:'//subname) - alarmname = 'alarm_history_inst_'//trim(compname(compwav)) - if (first_time) then - call med_phases_history_init_inst(gcomp, trim(alarmname), hclock_inst_comp(compwav), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - first_time = .false. - end if - call ESMF_ClockAdvance(hclock_inst_comp(compwav), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_write_hfile(gcomp, trim(compname(compwav)), hclock_inst_comp(compwav), & - trim(alarmname), .false., rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call t_stopf('MED:'//subname) - end subroutine med_phases_history_write_inst_wav - - !=============================================================================== - subroutine med_phases_history_write_avg_atm(gcomp, rc) - ! Write mediator average history file for atm variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - type(InternalState) :: is_local - integer :: n - character(CL) :: alarmname - logical :: first_time = .true. - character(len=*), parameter :: subname='(med_phases_history_write_avg_atm)' - !--------------------------------------- - rc = ESMF_SUCCESS - call t_startf('MED:'//subname) - alarmname = 'alarm_history_avg_'//trim(compname(compatm)) - if (first_time) then - ! get internal state - nullify(is_local%wrap) - call ESMF_GridCompGetInternalState(gcomp, is_local, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! init alarms - call med_phases_history_init_avg(gcomp, trim(alarmname), hclock_avg_comp(compwav), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! accumulated import fields - if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(compatm,compatm),rc=rc)) then - call med_methods_fb_init(avgfiles_import(n)%FBaccum, is_local%wrap%flds_scalar_name, & - FBgeom=is_local%wrap%FBImp(compatm,compatm), STflds=is_local%wrap%NStateImp(compatm), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call med_methods_FB_reset(avgfiles_import(compatm)%FBaccum, czero, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - avgfiles_import(compatm)%accumcnt = 0 - end if - ! accumulated export fields - if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(compatm), rc=rc)) then - call med_methods_fb_init(avgfiles_export(compatm)%FBaccum, is_local%wrap%flds_scalar_name, & - FBgeom=is_local%wrap%FBExp(compatm), STflds=is_local%wrap%NstateExp(compatm), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call med_methods_FB_reset(avgfiles_export(compatm)%FBaccum, czero, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - avgfiles_export(compatm)%accumcnt = 0 - end if - first_time = .false. - end if - call ESMF_ClockAdvance(hclock_inst_comp(compatm), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_write_hfile(gcomp, trim(compname(compatm)), hclock_avg_comp(compatm), & - trim(alarmname), .false., rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call t_stopf('MED:'//subname) - end subroutine med_phases_history_write_avg_atm - - !=============================================================================== - subroutine med_phases_history_write_avg_ice(gcomp, rc) - ! Write mediator average history file for ice variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - type(InternalState) :: is_local - integer :: n - character(CL) :: alarmname - logical :: first_time = .true. - character(len=*), parameter :: subname='(med_phases_history_write_avg_ice)' - !--------------------------------------- - rc = ESMF_SUCCESS - call t_startf('MED:'//subname) - alarmname = 'alarm_history_avg_'//trim(compname(compice)) - if (first_time) then - ! get internal state - nullify(is_local%wrap) - call ESMF_GridCompGetInternalState(gcomp, is_local, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! init alarms - call med_phases_history_init_avg(gcomp, trim(alarmname), hclock_avg_comp(compwav), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! accumulated import fields - if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(compice,compice),rc=rc)) then - call med_methods_fb_init(avgfiles_import(n)%FBaccum, is_local%wrap%flds_scalar_name, & - FBgeom=is_local%wrap%FBImp(compice,compice), STflds=is_local%wrap%NStateImp(compice), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call med_methods_FB_reset(avgfiles_import(compice)%FBaccum, czero, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - avgfiles_import(compice)%accumcnt = 0 - end if - ! accumulated export fields - if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(compice), rc=rc)) then - call med_methods_fb_init(avgfiles_export(compice)%FBaccum, is_local%wrap%flds_scalar_name, & - FBgeom=is_local%wrap%FBExp(compice), STflds=is_local%wrap%NstateExp(compice), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call med_methods_FB_reset(avgfiles_export(compice)%FBaccum, czero, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - avgfiles_export(compice)%accumcnt = 0 - end if - first_time = .false. - end if - call ESMF_ClockAdvance(hclock_inst_comp(compice), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_write_hfile(gcomp, trim(compname(compice)), hclock_avg_comp(compice), & - trim(alarmname), .false., rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call t_stopf('MED:'//subname) - end subroutine med_phases_history_write_avg_ice - - !=============================================================================== - subroutine med_phases_history_write_avg_glc(gcomp, rc) - ! Write mediator average history file for glc variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - type(InternalState) :: is_local - integer :: n - character(CL) :: alarmname - logical :: first_time = .true. - character(len=*), parameter :: subname='(med_phases_history_write_avg_glc)' !--------------------------------------- rc = ESMF_SUCCESS call t_startf('MED:'//subname) - alarmname = 'alarm_history_avg_'//trim(compname(compglc)) - if (first_time) then - ! get internal state - nullify(is_local%wrap) - call ESMF_GridCompGetInternalState(gcomp, is_local, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! init alarms - call med_phases_history_init_avg(gcomp, trim(alarmname), hclock_avg_comp(compwav), rc=rc) + alarmname = 'alarm_history_inst_'//trim(compname(compid)) + if (.not. ESMF_ClockIsCreated(hclock_inst_comp(compid))) then + call med_phases_history_init_inst(gcomp, trim(alarmname), hclock_inst_comp(compid), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! accumulated import fields - if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(compglc,compglc),rc=rc)) then - call med_methods_fb_init(avgfiles_import(n)%FBaccum, is_local%wrap%flds_scalar_name, & - FBgeom=is_local%wrap%FBImp(compglc,compglc), STflds=is_local%wrap%NStateImp(compglc), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call med_methods_FB_reset(avgfiles_import(compglc)%FBaccum, czero, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - avgfiles_import(compglc)%accumcnt = 0 - end if - ! accumulated export fields - if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(compglc), rc=rc)) then - call med_methods_fb_init(avgfiles_export(compglc)%FBaccum, is_local%wrap%flds_scalar_name, & - FBgeom=is_local%wrap%FBExp(compglc), STflds=is_local%wrap%NstateExp(compglc), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call med_methods_FB_reset(avgfiles_export(compglc)%FBaccum, czero, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - avgfiles_export(compglc)%accumcnt = 0 - end if - first_time = .false. end if - call ESMF_ClockAdvance(hclock_inst_comp(compglc), rc=rc) + call ESMF_ClockAdvance(hclock_inst_comp(compid), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_write_hfile(gcomp, trim(compname(compglc)), hclock_avg_comp(compglc), & + call med_phases_history_write_hfile(gcomp, trim(compname(compid)), hclock_inst_comp(compid), & trim(alarmname), .false., rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call t_stopf('MED:'//subname) - end subroutine med_phases_history_write_avg_glc + end subroutine med_phases_history_write_inst_comp !=============================================================================== - subroutine med_phases_history_write_avg_lnd(gcomp, rc) - ! Write mediator average history file for lnd variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - type(InternalState) :: is_local + subroutine med_phases_history_write_avg_comp(gcomp, compid, subname, rc) + ! Write mediator average history file variables for component compid + ! input/output variables + type(ESMF_GridComp) , intent(inout) :: gcomp + integer , intent(in) :: compid + character(len=*) , intent(in) :: subname + integer , intent(out) :: rc + ! local variables integer :: n character(CL) :: alarmname - logical :: first_time = .true. - character(len=*), parameter :: subname='(med_phases_history_write_avg_lnd)' - !--------------------------------------- - rc = ESMF_SUCCESS - call t_startf('MED:'//subname) - alarmname = 'alarm_history_avg_'//trim(compname(complnd)) - if (first_time) then - ! get internal state - nullify(is_local%wrap) - call ESMF_GridCompGetInternalState(gcomp, is_local, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! init alarms - call med_phases_history_init_avg(gcomp, trim(alarmname), hclock_avg_comp(compwav), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! accumulated import fields - if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(complnd,complnd),rc=rc)) then - call med_methods_fb_init(avgfiles_import(n)%FBaccum, is_local%wrap%flds_scalar_name, & - FBgeom=is_local%wrap%FBImp(complnd,complnd), STflds=is_local%wrap%NStateImp(complnd), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call med_methods_FB_reset(avgfiles_import(complnd)%FBaccum, czero, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - avgfiles_import(complnd)%accumcnt = 0 - end if - ! accumulated export fields - if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(complnd), rc=rc)) then - call med_methods_fb_init(avgfiles_export(complnd)%FBaccum, is_local%wrap%flds_scalar_name, & - FBgeom=is_local%wrap%FBExp(complnd), STflds=is_local%wrap%NstateExp(complnd), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call med_methods_FB_reset(avgfiles_export(complnd)%FBaccum, czero, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - avgfiles_export(complnd)%accumcnt = 0 - end if - first_time = .false. - end if - call ESMF_ClockAdvance(hclock_inst_comp(complnd), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_write_hfile(gcomp, trim(compname(complnd)), hclock_avg_comp(complnd), & - trim(alarmname), .false., rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call t_stopf('MED:'//subname) - end subroutine med_phases_history_write_avg_lnd - - !=============================================================================== - subroutine med_phases_history_write_avg_ocn(gcomp, rc) - ! Write mediator average history file for ocn variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - type(InternalState) :: is_local - integer :: n - character(CL) :: alarmname - logical :: first_time = .true. - character(len=*), parameter :: subname='(med_phases_history_write_avg_ocn)' - !--------------------------------------- - rc = ESMF_SUCCESS - call t_startf('MED:'//subname) - alarmname = 'alarm_history_avg_'//trim(compname(compocn)) - if (first_time) then - ! get internal state - nullify(is_local%wrap) - call ESMF_GridCompGetInternalState(gcomp, is_local, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! init alarms - call med_phases_history_init_avg(gcomp, trim(alarmname), hclock_avg_comp(compwav), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! accumulated import fields - if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(compocn,compocn),rc=rc)) then - call med_methods_fb_init(avgfiles_import(n)%FBaccum, is_local%wrap%flds_scalar_name, & - FBgeom=is_local%wrap%FBImp(compocn,compocn), STflds=is_local%wrap%NStateImp(compocn), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call med_methods_FB_reset(avgfiles_import(compocn)%FBaccum, czero, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - avgfiles_import(compocn)%accumcnt = 0 - end if - ! accumulated export fields - if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(compocn), rc=rc)) then - call med_methods_fb_init(avgfiles_export(compocn)%FBaccum, is_local%wrap%flds_scalar_name, & - FBgeom=is_local%wrap%FBExp(compocn), STflds=is_local%wrap%NstateExp(compocn), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call med_methods_FB_reset(avgfiles_export(compocn)%FBaccum, czero, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - avgfiles_export(compocn)%accumcnt = 0 - end if - first_time = .false. - end if - call ESMF_ClockAdvance(hclock_inst_comp(compocn), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_write_hfile(gcomp, trim(compname(compocn)), hclock_avg_comp(compocn), & - trim(alarmname), .false., rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call t_stopf('MED:'//subname) - end subroutine med_phases_history_write_avg_ocn - - !=============================================================================== - subroutine med_phases_history_write_avg_rof(gcomp, rc) - ! Write mediator average history file for rof variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - type(InternalState) :: is_local - integer :: n - character(CL) :: alarmname - logical :: first_time = .true. - character(len=*), parameter :: subname='(med_phases_history_write_avg_rof)' !--------------------------------------- - rc = ESMF_SUCCESS - call t_startf('MED:'//subname) - alarmname = 'alarm_history_avg_'//trim(compname(comprof)) - if (first_time) then - ! get internal state - nullify(is_local%wrap) - call ESMF_GridCompGetInternalState(gcomp, is_local, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! init alarms - call med_phases_history_init_avg(gcomp, trim(alarmname), hclock_avg_comp(compwav), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! accumulated import fields - if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(comprof,comprof),rc=rc)) then - call med_methods_fb_init(avgfiles_import(n)%FBaccum, is_local%wrap%flds_scalar_name, & - FBgeom=is_local%wrap%FBImp(comprof,comprof), STflds=is_local%wrap%NStateImp(comprof), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call med_methods_FB_reset(avgfiles_import(comprof)%FBaccum, czero, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - avgfiles_import(comprof)%accumcnt = 0 - end if - ! accumulated export fields - if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(comprof), rc=rc)) then - call med_methods_fb_init(avgfiles_export(comprof)%FBaccum, is_local%wrap%flds_scalar_name, & - FBgeom=is_local%wrap%FBExp(comprof), STflds=is_local%wrap%NstateExp(comprof), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call med_methods_FB_reset(avgfiles_export(comprof)%FBaccum, czero, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - avgfiles_export(comprof)%accumcnt = 0 - end if - first_time = .false. - end if - call ESMF_ClockAdvance(hclock_inst_comp(comprof), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_write_hfile(gcomp, trim(compname(comprof)), hclock_avg_comp(comprof), & - trim(alarmname), .false., rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call t_stopf('MED:'//subname) - end subroutine med_phases_history_write_avg_rof - !=============================================================================== - subroutine med_phases_history_write_avg_wav(gcomp, rc) - ! Write mediator average history file for wav variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - type(InternalState) :: is_local - integer :: n - character(CL) :: alarmname - logical :: first_time = .true. - character(len=*), parameter :: subname='(med_phases_history_write_avg_wav)' - !--------------------------------------- rc = ESMF_SUCCESS call t_startf('MED:'//subname) - alarmname = 'alarm_history_avg_'//trim(compname(compwav)) - if (first_time) then - ! get internal state - nullify(is_local%wrap) - call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + alarmname = 'alarm_history_avg_'//trim(compname(compid)) + if (.not. ESMF_ClockIsCreated(hclock_avg_comp(compid))) then + ! init clock and alarm + call med_phases_history_init_avg(gcomp, compid, trim(alarmname), hclock_avg_comp(compid), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! init alarms - call med_phases_history_init_avg(gcomp, trim(alarmname), hclock_avg_comp(compwav), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! accumulated import fields - if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(compwav,compwav),rc=rc)) then - call med_methods_fb_init(avgfiles_import(n)%FBaccum, is_local%wrap%flds_scalar_name, & - FBgeom=is_local%wrap%FBImp(compwav,compwav), STflds=is_local%wrap%NStateImp(compwav), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call med_methods_FB_reset(avgfiles_import(compwav)%FBaccum, czero, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - avgfiles_import(compwav)%accumcnt = 0 - end if - ! accumulated export fields - if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(compwav), rc=rc)) then - call med_methods_fb_init(avgfiles_export(compwav)%FBaccum, is_local%wrap%flds_scalar_name, & - FBgeom=is_local%wrap%FBExp(compwav), STflds=is_local%wrap%NstateExp(compwav), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call med_methods_FB_reset(avgfiles_export(compwav)%FBaccum, czero, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - avgfiles_export(compwav)%accumcnt = 0 - end if - first_time = .false. end if - call ESMF_ClockAdvance(hclock_inst_comp(compwav), rc=rc) + call ESMF_ClockAdvance(hclock_avg_comp(compid), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_write_hfile(gcomp, trim(compname(compwav)), hclock_avg_comp(compwav), & + call med_phases_history_write_hfile(gcomp, trim(compname(compid)), hclock_avg_comp(compid), & trim(alarmname), .false., rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call t_stopf('MED:'//subname) - end subroutine med_phases_history_write_avg_wav - !=============================================================================== - subroutine med_phases_history_write_aux_atm(gcomp, rc) - ! Write mediator history file for atm variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - logical :: first_time = .true. - integer :: n - character(len=*), parameter :: subname='(med_phases_history_write_aux_atm)' - !--------------------------------------- - rc = ESMF_SUCCESS - call t_startf('MED:'//subname) - if (first_time) then - if (mastertask) then - write(logunit,'(a)') trim(subname) // 'Initialize auxiliary history file and alarms for atm' - end if - call med_phases_history_init_aux(gcomp, compatm, auxfiles(:,compatm), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - first_time = .false. - end if - do n = 1,num_auxfiles(compatm) - call ESMF_ClockAdvance(auxfiles(n,compatm)%hclock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_write_hfileaux(gcomp, case_name, inst_tag, n, compatm, auxfiles(n,compatm), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end do - call t_stopf('MED:'//subname) - end subroutine med_phases_history_write_aux_atm + end subroutine med_phases_history_write_avg_comp !=============================================================================== - subroutine med_phases_history_write_aux_ice(gcomp, rc) - ! Write mediator history file for ice variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - logical :: first_time = .true. - integer :: n - character(len=*), parameter :: subname='(med_phases_history_write_aux_ice)' - !--------------------------------------- - rc = ESMF_SUCCESS - call t_startf('MED:'//subname) - if (first_time) then - if (mastertask) then - write(logunit,'(a)') trim(subname) // 'Initialize auxiliary history file and alarms for ice' - end if - call med_phases_history_init_aux(gcomp, compice, auxfiles(:,compice), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - first_time = .false. - end if - do n = 1,num_auxfiles(compice) - call ESMF_ClockAdvance(auxfiles(n,compice)%hclock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_write_hfileaux(gcomp, case_name, inst_tag, n, compice, auxfiles(n,compice), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end do - call t_stopf('MED:'//subname) - end subroutine med_phases_history_write_aux_ice - - !=============================================================================== - subroutine med_phases_history_write_aux_glc(gcomp, rc) - ! Write mediator history file for glc variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - logical :: first_time = .true. - integer :: n - character(len=*), parameter :: subname='(med_phases_history_write_aux_glc)' - !--------------------------------------- - rc = ESMF_SUCCESS - call t_startf('MED:'//subname) - if (first_time) then - if (mastertask) then - write(logunit,'(a)') trim(subname) // 'Initialize auxiliary history file and alarms for glc' - end if - call med_phases_history_init_aux(gcomp, compglc, auxfiles(:,compglc), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - first_time = .false. - end if - do n = 1,num_auxfiles(compglc) - call ESMF_ClockAdvance(auxfiles(n,compglc)%hclock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_write_hfileaux(gcomp, case_name, inst_tag, n, compglc, auxfiles(n,compglc), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end do - call t_stopf('MED:'//subname) - end subroutine med_phases_history_write_aux_glc - - !=============================================================================== - subroutine med_phases_history_write_aux_lnd(gcomp, rc) - ! Write mediator history file for lnd variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - logical :: first_time = .true. - integer :: n - character(len=*), parameter :: subname='(med_phases_history_write_aux_lnd)' - !--------------------------------------- - rc = ESMF_SUCCESS - call t_startf('MED:'//subname) - if (first_time) then - if (mastertask) then - write(logunit,'(a)') trim(subname) // 'Initialize auxiliary history file and alarms for lnd' - end if - call med_phases_history_init_aux(gcomp, complnd, auxfiles(:,complnd), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - first_time = .false. - end if - do n = 1,num_auxfiles(complnd) - call ESMF_ClockAdvance(auxfiles(n,complnd)%hclock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_write_hfileaux(gcomp, case_name, inst_tag, n, complnd, auxfiles(n,complnd), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end do - call t_stopf('MED:'//subname) - end subroutine med_phases_history_write_aux_lnd - - !=============================================================================== - subroutine med_phases_history_write_aux_ocn(gcomp, rc) - ! Write mediator history file for ocn variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - logical :: first_time = .true. - integer :: n - character(len=*), parameter :: subname='(med_phases_history_write_aux_ocn)' - !--------------------------------------- - rc = ESMF_SUCCESS - call t_startf('MED:'//subname) - if (first_time) then - if (mastertask) then - write(logunit,'(a)') trim(subname) // 'Initialize auxiliary history file and alarms for ocn' - end if - call med_phases_history_init_aux(gcomp, compocn, auxfiles(:,compocn), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - first_time = .false. - end if - do n = 1,num_auxfiles(compocn) - call ESMF_ClockAdvance(auxfiles(n,compocn)%hclock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_write_hfileaux(gcomp, case_name, inst_tag, n, compocn, auxfiles(n,compocn), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end do - call t_stopf('MED:'//subname) - end subroutine med_phases_history_write_aux_ocn - - !=============================================================================== - subroutine med_phases_history_write_aux_rof(gcomp, rc) - ! Write mediator history file for rof variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - logical :: first_time = .true. - integer :: n - character(len=*), parameter :: subname='(med_phases_history_write_aux_rof)' - !--------------------------------------- - rc = ESMF_SUCCESS - call t_startf('MED:'//subname) - if (first_time) then - if (mastertask) then - write(logunit,'(a)') trim(subname) // 'Initialize auxiliary history file and alarms for rof' - end if - call med_phases_history_init_aux(gcomp, comprof, auxfiles(:,comprof), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - first_time = .false. - end if - do n = 1,num_auxfiles(comprof) - call ESMF_ClockAdvance(auxfiles(n,comprof)%hclock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_write_hfileaux(gcomp, case_name, inst_tag, n, comprof, auxfiles(n,comprof), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end do - call t_stopf('MED:'//subname) - end subroutine med_phases_history_write_aux_rof - - !=============================================================================== - subroutine med_phases_history_write_aux_wav(gcomp, rc) - ! Write mediator history file for wav variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - logical :: first_time = .true. + subroutine med_phases_history_write_aux_comp(gcomp, compid, first_time, subname, rc) + ! Write mediator history file for component compid + ! input/output variables + type(ESMF_GridComp) , intent(inout) :: gcomp + integer , intent(in) :: compid + logical , intent(in) :: first_time + character(len=*) , intent(in) :: subname + integer , intent(out) :: rc + ! local variables integer :: n - character(len=*), parameter :: subname='(med_phases_history_write_aux_wav)' !--------------------------------------- rc = ESMF_SUCCESS call t_startf('MED:'//subname) if (first_time) then if (mastertask) then - write(logunit,'(a)') trim(subname) // 'Initialize auxiliary history file and alarms for wav' + write(logunit,'(a)') trim(subname) // 'Initialize auxiliary history file and alarms for '//& + trim(compname(compid)) end if - call med_phases_history_init_aux(gcomp, compwav, auxfiles(:,compwav), rc=rc) + call med_phases_history_init_aux(gcomp, compid, auxfiles(:,compid), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - first_time = .false. end if - do n = 1,num_auxfiles(compwav) - call ESMF_ClockAdvance(auxfiles(n,compwav)%hclock, rc=rc) + do n = 1,num_auxfiles(compid) + call ESMF_ClockAdvance(auxfiles(n,compid)%hclock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_write_hfileaux(gcomp, case_name, inst_tag, n, compwav, auxfiles(n,compwav), rc=rc) + call med_phases_history_write_hfileaux(gcomp, case_name, inst_tag, n, compid, auxfiles(n,compid), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end do call t_stopf('MED:'//subname) - end subroutine med_phases_history_write_aux_wav + end subroutine med_phases_history_write_aux_comp !=============================================================================== subroutine med_phases_history_get_filename(gcomp, doavg, comptype, hist_file, time_units, days_since, rc) From 3486a60684705fd310c4e8df048f4a015608ee7b Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 13 Apr 2021 22:51:17 -0600 Subject: [PATCH 23/61] compression of inst, avg and aux for a given component into one run phase --- cime_config/config_component.xml | 33 - cime_config/config_component_cesm.xml | 274 +++++- cime_config/config_component_ufs.xml | 28 +- cime_config/namelist_definition_drv.xml | 523 ++++++---- mediator/med.F90 | 148 +-- mediator/med_io_mod.F90 | 62 +- mediator/med_phases_history_mod.F90 | 1203 +++++++++++------------ 7 files changed, 1269 insertions(+), 1002 deletions(-) diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index f69aa441e..796722bbe 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -2311,38 +2311,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,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) - - integer 0,1,2,3,4,5,6,7,8,9 @@ -2367,7 +2335,6 @@ machines/compilers. - diff --git a/cime_config/config_component_cesm.xml b/cime_config/config_component_cesm.xml index 60ce9ad64..cfe118435 100644 --- a/cime_config/config_component_cesm.xml +++ b/cime_config/config_component_cesm.xml @@ -452,6 +452,153 @@ + + + + + + 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 + never + med_history + env_run.xml + Sets mediator average history file frequency (like REST_OPTION) + + + char + + -999 + med_history + env_run.xml + Sets mediator average history file frequency (like REST_N) + + + 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 mediator average history file frequency (like REST_OPTION) + + + char + + -999 + med_history + env_run.xml + Sets mediator average history file frequency (like REST_N) + + + 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 mediator average history file frequency (like REST_OPTION) + + + char + + -999 + med_history + env_run.xml + Sets mediator average history file frequency (like REST_N) + + + 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 mediator average history file frequency (like REST_OPTION) + + + char + + -999 + med_history + env_run.xml + Sets mediator average history file frequency (like REST_N) + + + 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 mediator average history file frequency (like REST_OPTION) + + + char + + -999 + med_history + env_run.xml + Sets mediator average history file frequency (like REST_N) + + + 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 mediator average history file frequency (like REST_OPTION) + + + char + + -999 + med_history + env_run.xml + Sets mediator average history file frequency (like REST_N) + + + 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 mediator average history file frequency (like REST_OPTION) + + + char + + -999 + med_history + env_run.xml + Sets mediator average history file frequency (like REST_N) + + + + + + char none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,nmonths,nmonth,nyears,nyear,date,ifdays0,end @@ -459,11 +606,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 @@ -471,18 +617,130 @@ 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 mediator average 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 + never + med_history + env_run.xml + Sets mediator average history file frequency (like REST_OPTION) + + + char + + -999 + med_history + env_run.xml + Sets mediator average history file frequency (like REST_N) + + + 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 mediator average history file frequency (like REST_OPTION) + + + char + + -999 + med_history + env_run.xml + Sets mediator average history file frequency (like REST_N) + + + 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 mediator average history file frequency (like REST_OPTION) + + + char + + -999 + med_history + env_run.xml + Sets mediator average history file frequency (like REST_N) + + + 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 mediator average history file frequency (like REST_OPTION) + + + char + + -999 + med_history + env_run.xml + Sets mediator average history file frequency (like REST_N) + + + 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 mediator average history file frequency (like REST_OPTION) + + + char + + -999 + med_history + env_run.xml + Sets mediator average history file frequency (like REST_N) + + + 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 mediator average history file frequency (like REST_OPTION) + + + char + + -999 + med_history + env_run.xml + Sets mediator average history file frequency (like REST_N) + + + 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 mediator average history file frequency (like REST_OPTION) + + + char + + -999 + med_history env_run.xml - yyyymmdd format, sets driver average history date (like REST_DATE) + Sets mediator average history file frequency (like REST_N) diff --git a/cime_config/config_component_ufs.xml b/cime_config/config_component_ufs.xml index 1516f97b0..bb32df7b5 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 a54c66acb..a3cd73166 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -1356,53 +1356,71 @@ + + 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 atm import/export/fields snapshot option (used with history_n and history_ymd) + + + $HIST_OPTION_ATM + + + integer time MED_attributes - Sets mediator time-average history file frequency (like restart_option) - set by AVGHIST_N in env_run.xml. + sets mediator snapshot history file frequency for atm import/export fields (like restart_n) - $AVGHIST_N + $HIST_N_ATM - - + 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) - set by AVGHIST_OPTION in env_run.xml. - histavg_option alarms are: - [none/never], turns option off - [nstep/s] , history snapshot every histavg_n nsteps , relative to current run start time - [nsecond/s] , history snapshot every histavg_n nseconds, relative to current run start time - [nminute/s] , history snapshot every histavg_n nminutes, relative to current run start time - [nhour/s] , history snapshot every histavg_n nhours , relative to current run start time - [nday/s] , history snapshot every histavg_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 histavg_n nmonths , relative to current run start time - [nyear/s] , history snapshot every histavg_n nyears , relative to current run start time - [date] , history snapshot at histavg_ymd value - [ifdays0] , history snapshot at histavg_n calendar day value and seconds equal 0 - [end] , history snapshot at end - $AVGHIST_OPTION + $AVGHIST_OPTION_ATM + + + + integer + time + MED_attributes + + Sets mediator time-average history file frequency (like restart_option) + + + $AVGHIST_N_ATM - - char aux_hist @@ -1468,9 +1486,7 @@ - - char aux_hist @@ -1536,9 +1552,7 @@ - - char aux_hist @@ -1606,9 +1620,7 @@ - - char aux_hist @@ -1678,9 +1690,7 @@ - - char aux_hist @@ -1747,8 +1757,159 @@ - + + + + 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) + + + $HIST_OPTION_ICE + + + + integer + time + MED_attributes + + sets mediator snapshot history file frequency for ice import/export fields (like restart_n) + + + $HIST_N_ICE + + + + 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) + + + $AVGHIST_OPTION_ICE + + + + integer + time + MED_attributes + + Sets mediator time-average history file frequency (like restart_option) + + + $AVGHIST_N_ICE + + + + + + + + + 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) + + + $HIST_OPTION_GLC + + + + integer + time + MED_attributes + + sets mediator snapshot history file frequency for glc import/export fields (like restart_n) + + + $HIST_N_GLC + + + + 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) + + + $AVGHIST_OPTION_GLC + + + + integer + time + MED_attributes + + Sets mediator time-average history file frequency (like restart_option) + + + $AVGHIST_N_GLC + + + + + + + + + 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) + + + $HIST_OPTION_LND + + + + integer + time + MED_attributes + + sets mediator snapshot history file frequency for lnd import/export fields (like restart_n) + + + $HIST_N_LND + + + + 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) + + + $AVGHIST_OPTION_LND + + + + integer + time + MED_attributes + + Sets mediator time-average history file frequency (like restart_option) + + + $AVGHIST_N_LND + + + + char aux_hist @@ -1814,9 +1975,7 @@ - - char aux_hist @@ -1883,8 +2042,108 @@ - + + + + + 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) + + + $HIST_OPTION_OCN + + + + integer + time + MED_attributes + + sets mediator snapshot history file frequency for ocn import/export fields (like restart_n) + + + $HIST_N_OCN + + + + 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) + + + $AVGHIST_OPTION_OCN + + + + integer + time + MED_attributes + + Sets mediator time-average history file frequency (like restart_option) + + + $AVGHIST_N_OCN + + + + + + + + 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 rof import/export/fields snapshot option (used with history_n and history_ymd) + + + $HIST_OPTION_ROF + + + + integer + time + MED_attributes + + sets mediator snapshot history file frequency for rof import/export fields (like restart_n) + + + $HIST_N_ROF + + + + 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) + + + $AVGHIST_OPTION_ROF + + + + integer + time + MED_attributes + + Sets mediator time-average history file frequency (like restart_option) + + + $AVGHIST_N_ROF + + + + char aux_hist @@ -1950,6 +2209,57 @@ + + + + + + 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 wav import/export/fields snapshot option (used with history_n and history_ymd) + + + $HIST_OPTION_WAV + + + + integer + time + MED_attributes + + sets mediator snapshot history file frequency for wav import/export fields (like restart_n) + + + $HIST_N_WAV + + + + 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) + + + $AVGHIST_OPTION_WAV + + + + integer + time + MED_attributes + + Sets mediator time-average history file frequency (like restart_option) + + + $AVGHIST_N_WAV + + + @@ -1964,7 +2274,6 @@ .true. - char mapping @@ -1975,7 +2284,6 @@ $ATM2OCN_FMAPNAME - char mapping @@ -1988,7 +2296,6 @@ $ATM2OCN_SMAPNAME - char mapping @@ -2001,7 +2308,6 @@ $ATM2OCN_VMAPNAME - char mapping @@ -2014,7 +2320,6 @@ $OCN2ATM_FMAPNAME - char mapping @@ -2027,7 +2332,6 @@ $OCN2ATM_SMAPNAME - char mapping @@ -2040,7 +2344,6 @@ $ATM2OCN_FMAPNAME - char mapping @@ -2053,7 +2356,6 @@ $ATM2OCN_SMAPNAME - char mapping @@ -2066,7 +2368,6 @@ $ATM2OCN_VMAPNAME - char mapping @@ -2105,7 +2406,6 @@ $ATM2LND_FMAPNAME - char mapping @@ -2118,7 +2418,6 @@ $ATM2LND_SMAPNAME - char mapping @@ -2131,7 +2430,6 @@ $ATM2LND_SMAPNAME - char mapping @@ -2144,7 +2442,6 @@ $LND2ATM_FMAPNAME - char mapping @@ -2157,7 +2454,6 @@ $LND2ATM_SMAPNAME - char mapping @@ -2170,7 +2466,6 @@ $LND2ROF_FMAPNAME - char mapping @@ -2183,7 +2478,6 @@ $ROF2LND_FMAPNAME - char mapping @@ -2196,7 +2490,6 @@ $ROF2LND_FMAPNAME - char mapping @@ -2209,7 +2502,6 @@ $ROF2OCN_FMAPNAME - char mapping @@ -2222,7 +2514,6 @@ $GLC2OCN_LIQ_RMAPNAME - char mapping @@ -2248,7 +2539,6 @@ $GLC2OCN_ICE_RMAPNAME - char mapping @@ -2261,7 +2551,6 @@ $ROF2OCN_LIQ_RMAPNAME - char mapping @@ -2274,7 +2563,6 @@ $ROF2OCN_ICE_RMAPNAME - char mapping @@ -2287,7 +2575,6 @@ $LND2GLC_FMAPNAME - char mapping @@ -2300,7 +2587,6 @@ $LND2GLC_SMAPNAME - char mapping @@ -2313,7 +2599,6 @@ $GLC2LND_FMAPNAME - char mapping @@ -2326,7 +2611,6 @@ $GLC2LND_SMAPNAME - char mapping @@ -2339,7 +2623,6 @@ $ATM2WAV_SMAPNAME - char mapping @@ -2352,7 +2635,6 @@ $ATM2WAV_SMAPNAME - char mapping @@ -2365,7 +2647,6 @@ $OCN2WAV_SMAPNAME - char mapping @@ -2378,7 +2659,6 @@ $ICE2WAV_SMAPNAME - char mapping @@ -2886,112 +3166,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 @@ -3006,7 +3180,6 @@ $BARRIER_OPTION - integer time @@ -3019,7 +3192,6 @@ $BARRIER_N - integer time @@ -3031,7 +3203,6 @@ $BARRIER_DATE - char time @@ -3057,7 +3228,6 @@ never - integer time @@ -3069,7 +3239,6 @@ -999 - integer time diff --git a/mediator/med.F90 b/mediator/med.F90 index c8c6c6a27..cc69aeadf 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -91,30 +91,14 @@ subroutine SetServices(gcomp, rc) use NUOPC_Mediator , only: mediator_label_Finalize => label_Finalize use med_phases_history_mod , only: med_phases_history_write - use med_phases_history_mod , only: med_phases_history_write_inst_atm - use med_phases_history_mod , only: med_phases_history_write_inst_ice - use med_phases_history_mod , only: med_phases_history_write_inst_glc - use med_phases_history_mod , only: med_phases_history_write_inst_lnd - use med_phases_history_mod , only: med_phases_history_write_inst_ocn - use med_phases_history_mod , only: med_phases_history_write_inst_rof - use med_phases_history_mod , only: med_phases_history_write_inst_wav - use med_phases_history_mod , only: med_phases_history_write_inst_med - - use med_phases_history_mod , only: med_phases_history_write_avg_atm - use med_phases_history_mod , only: med_phases_history_write_avg_ice - use med_phases_history_mod , only: med_phases_history_write_avg_glc - use med_phases_history_mod , only: med_phases_history_write_avg_lnd - use med_phases_history_mod , only: med_phases_history_write_avg_ocn - use med_phases_history_mod , only: med_phases_history_write_avg_rof - use med_phases_history_mod , only: med_phases_history_write_avg_wav - - use med_phases_history_mod , only: med_phases_history_write_aux_atm - use med_phases_history_mod , only: med_phases_history_write_aux_ice - use med_phases_history_mod , only: med_phases_history_write_aux_glc - use med_phases_history_mod , only: med_phases_history_write_aux_lnd - use med_phases_history_mod , only: med_phases_history_write_aux_ocn - use med_phases_history_mod , only: med_phases_history_write_aux_rof - use med_phases_history_mod , only: med_phases_history_write_aux_wav + use med_phases_history_mod , only: med_phases_history_write_atm + use med_phases_history_mod , only: med_phases_history_write_ice + use med_phases_history_mod , only: med_phases_history_write_glc + use med_phases_history_mod , only: med_phases_history_write_lnd + use med_phases_history_mod , only: med_phases_history_write_ocn + use med_phases_history_mod , only: med_phases_history_write_rof + use med_phases_history_mod , only: med_phases_history_write_wav + use med_phases_history_mod , only: med_phases_history_write_med use med_phases_restart_mod , only: med_phases_restart_write use med_phases_prep_atm_mod , only: med_phases_prep_atm @@ -232,22 +216,10 @@ subroutine SetServices(gcomp, rc) !------------------ call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_inst_atm"/), userRoutine=mediator_routine_Run, rc=rc) + phaseLabelList=(/"med_phases_history_write_atm"/), userRoutine=mediator_routine_Run, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_inst_atm", specRoutine=med_phases_history_write_inst_atm, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_avg_atm"/), userRoutine=mediator_routine_Run, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_avg_atm", specRoutine=med_phases_history_write_avg_atm, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_aux_atm"/), userRoutine=mediator_routine_Run, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_aux_atm", specRoutine=med_phases_history_write_aux_atm, rc=rc) + specPhaseLabel="med_phases_history_write_atm", specRoutine=med_phases_history_write_atm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ @@ -255,22 +227,10 @@ subroutine SetServices(gcomp, rc) !------------------ call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_inst_ice"/), userRoutine=mediator_routine_Run, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_inst_ice", specRoutine=med_phases_history_write_inst_ice, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_avg_ice"/), userRoutine=mediator_routine_Run, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_avg_ice", specRoutine=med_phases_history_write_avg_ice, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_aux_ice"/), userRoutine=mediator_routine_Run, rc=rc) + phaseLabelList=(/"med_phases_history_write_ice"/), userRoutine=mediator_routine_Run, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_aux_ice", specRoutine=med_phases_history_write_aux_ice, rc=rc) + specPhaseLabel="med_phases_history_write_ice", specRoutine=med_phases_history_write_ice, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ @@ -278,22 +238,10 @@ subroutine SetServices(gcomp, rc) !------------------ call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_inst_glc"/), userRoutine=mediator_routine_Run, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_inst_glc", specRoutine=med_phases_history_write_inst_glc, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_avg_glc"/), userRoutine=mediator_routine_Run, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_avg_glc", specRoutine=med_phases_history_write_avg_glc, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_aux_glc"/), userRoutine=mediator_routine_Run, rc=rc) + phaseLabelList=(/"med_phases_history_write_glc"/), userRoutine=mediator_routine_Run, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_aux_glc", specRoutine=med_phases_history_write_aux_glc, rc=rc) + specPhaseLabel="med_phases_history_write_glc", specRoutine=med_phases_history_write_glc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ @@ -301,22 +249,10 @@ subroutine SetServices(gcomp, rc) !------------------ call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_inst_lnd"/), userRoutine=mediator_routine_Run, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_inst_lnd", specRoutine=med_phases_history_write_inst_lnd, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_avg_lnd"/), userRoutine=mediator_routine_Run, rc=rc) + phaseLabelList=(/"med_phases_history_write_lnd"/), userRoutine=mediator_routine_Run, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_avg_lnd", specRoutine=med_phases_history_write_avg_lnd, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_aux_lnd"/), userRoutine=mediator_routine_Run, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_aux_lnd", specRoutine=med_phases_history_write_aux_lnd, rc=rc) + specPhaseLabel="med_phases_history_write_lnd", specRoutine=med_phases_history_write_lnd, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ @@ -324,22 +260,10 @@ subroutine SetServices(gcomp, rc) !------------------ call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_inst_ocn"/), userRoutine=mediator_routine_Run, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_inst_ocn", specRoutine=med_phases_history_write_inst_ocn, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_avg_ocn"/), userRoutine=mediator_routine_Run, rc=rc) + phaseLabelList=(/"med_phases_history_write_ocn"/), userRoutine=mediator_routine_Run, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_avg_ocn", specRoutine=med_phases_history_write_avg_ocn, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_aux_ocn"/), userRoutine=mediator_routine_Run, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_aux_ocn", specRoutine=med_phases_history_write_aux_ocn, rc=rc) + specPhaseLabel="med_phases_history_write_ocn", specRoutine=med_phases_history_write_ocn, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ @@ -347,22 +271,10 @@ subroutine SetServices(gcomp, rc) !------------------ call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_inst_rof"/), userRoutine=mediator_routine_Run, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_inst_rof", specRoutine=med_phases_history_write_inst_rof, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_avg_rof"/), userRoutine=mediator_routine_Run, rc=rc) + phaseLabelList=(/"med_phases_history_write_rof"/), userRoutine=mediator_routine_Run, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_avg_rof", specRoutine=med_phases_history_write_avg_rof, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_aux_rof"/), userRoutine=mediator_routine_Run, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_aux_rof", specRoutine=med_phases_history_write_aux_rof, rc=rc) + specPhaseLabel="med_phases_history_write_rof", specRoutine=med_phases_history_write_rof, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ @@ -370,22 +282,10 @@ subroutine SetServices(gcomp, rc) !------------------ call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_inst_wav"/), userRoutine=mediator_routine_Run, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_inst_wav", specRoutine=med_phases_history_write_inst_wav, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_avg_wav"/), userRoutine=mediator_routine_Run, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_avg_wav", specRoutine=med_phases_history_write_avg_wav, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_aux_wav"/), userRoutine=mediator_routine_Run, rc=rc) + phaseLabelList=(/"med_phases_history_write_wav"/), userRoutine=mediator_routine_Run, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_aux_wav", specRoutine=med_phases_history_write_aux_wav, rc=rc) + specPhaseLabel="med_phases_history_write_wav", specRoutine=med_phases_history_write_wav, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ @@ -393,10 +293,10 @@ subroutine SetServices(gcomp, rc) !------------------ call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_inst_med"/), userRoutine=mediator_routine_Run, rc=rc) + phaseLabelList=(/"med_phases_history_write_med"/), userRoutine=mediator_routine_Run, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_inst_med", specRoutine=med_phases_history_write_inst_med, rc=rc) + specPhaseLabel="med_phases_history_write_med", specRoutine=med_phases_history_write_med, 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) diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index 511d932a2..b57a8cb28 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -810,6 +810,7 @@ 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) ' !------------------------------------------------------------------------------- @@ -836,17 +837,9 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & return endif - 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 @@ -854,18 +847,37 @@ 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) @@ -874,10 +886,8 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & 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 @@ -885,7 +895,6 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & ! 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 @@ -934,8 +943,13 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & 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) @@ -1038,14 +1052,16 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & 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) diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 048bc7921..10e494d65 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -57,36 +57,17 @@ module med_phases_history_mod private ! Public routines called from the run sequence - public :: med_phases_history_write - public :: med_phases_history_write_inst_med - public :: med_phases_history_write_inst_atm - public :: med_phases_history_write_inst_ice - public :: med_phases_history_write_inst_glc - public :: med_phases_history_write_inst_lnd - public :: med_phases_history_write_inst_ocn - public :: med_phases_history_write_inst_rof - public :: med_phases_history_write_inst_wav - - public :: med_phases_history_write_aux_atm - public :: med_phases_history_write_aux_ice - public :: med_phases_history_write_aux_glc - public :: med_phases_history_write_aux_lnd - public :: med_phases_history_write_aux_ocn - public :: med_phases_history_write_aux_rof - public :: med_phases_history_write_aux_wav - - public :: med_phases_history_write_avg_atm - public :: med_phases_history_write_avg_ice - public :: med_phases_history_write_avg_glc - public :: med_phases_history_write_avg_lnd - public :: med_phases_history_write_avg_ocn - public :: med_phases_history_write_avg_rof - public :: med_phases_history_write_avg_wav + public :: med_phases_history_write ! inst only + public :: med_phases_history_write_med ! inst only + public :: med_phases_history_write_atm ! inst, avg, aux + public :: med_phases_history_write_ice ! inst, avg, aux + public :: med_phases_history_write_glc ! inst, avg, aux + public :: med_phases_history_write_lnd ! inst, avg, aux + public :: med_phases_history_write_ocn ! inst, avg, aux + public :: med_phases_history_write_rof ! inst, avg, aux + public :: med_phases_history_write_wav ! inst, avg, aux ! Private routines - private :: med_phases_history_init_inst ! called the first time a write phase is called - private :: med_phases_history_init_avg ! called the first time a write phase is called - private :: med_phases_history_init_aux ! called the first time a write phase is called private :: med_phases_history_write_inst_comp ! write instantaneous file for a given component private :: med_phases_history_write_avg_comp ! write averaged file for a given component private :: med_phases_history_write_aux_comp ! write auxiliary file for a given component @@ -142,508 +123,532 @@ module med_phases_history_mod contains !=============================================================================== - !=========================================================== - ! Instantaneous mediator history files - !=========================================================== - subroutine med_phases_history_write(gcomp, rc) ! -------------------------------------- ! Write instantaneous mediator history file for all variables - ! Name has been kept for backwards compatibiliyt ! -------------------------------------- + ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc + ! local variables + character(CL) :: alarmname + type(ESMF_Clock) :: mclock + type(ESMF_Alarm) :: alarm + type(ESMF_Time) :: CurrTime + type(ESMF_Time) :: StartTime + type(ESMF_TimeInterval) :: timestep + integer :: timestep_length + 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 + logical :: first_time = .true. character(len=*), parameter :: subname='(med_phases_history_write)' !--------------------------------------- rc = ESMF_SUCCESS call t_startf('MED:'//subname) - if (.not. ESMF_ClockIsCreated(hclock_inst_all)) then - call med_phases_history_init_inst(gcomp, 'alarm_history_inst_all', hclock_inst_all, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - call ESMF_ClockAdvance(hclock_inst_all, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_write_hfile(gcomp, 'all', hclock_inst_all, 'alarm_history_inst_all', .false., rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call t_stopf('MED:'//subname) - end subroutine med_phases_history_write - subroutine med_phases_history_write_inst_med(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 - ! input/output variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - !--------------------------------------- - rc = ESMF_SUCCESS - call med_phases_history_write_inst_comp(gcomp, compmed, 'med_phases_history_write_inst_med', rc) - end subroutine med_phases_history_write_inst_med - - subroutine med_phases_history_write_inst_atm(gcomp, rc) - ! Write mediator history file for atm variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - !--------------------------------------- - rc = ESMF_SUCCESS - call med_phases_history_write_inst_comp(gcomp, compatm, 'med_phases_history_write_inst_atm', rc) - end subroutine med_phases_history_write_inst_atm - - subroutine med_phases_history_write_inst_ice(gcomp, rc) - ! Write mediator history file for ice variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - !--------------------------------------- - rc = ESMF_SUCCESS - call med_phases_history_write_inst_comp(gcomp, compice, 'med_phases_history_write_inst_ice', rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end subroutine med_phases_history_write_inst_ice - - subroutine med_phases_history_write_inst_lnd(gcomp, rc) - ! Write mediator history file for lnd variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - !--------------------------------------- - rc = ESMF_SUCCESS - call med_phases_history_write_inst_comp(gcomp, complnd, 'med_phases_history_write_inst_lnd', rc) - end subroutine med_phases_history_write_inst_lnd - - subroutine med_phases_history_write_inst_glc(gcomp, rc) - ! Write mediator history file for glc variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - ! local variables - integer :: ns - character(len=CS) :: cns - !--------------------------------------- - rc = ESMF_SUCCESS - do ns = 1,num_icesheets - write(cns,*) ns - call med_phases_history_write_inst_comp(gcomp, compglc(ns), 'med_phases_history_write_inst_glc'//trim(cns), rc) + alarmname = 'alarm_history_inst_all' + 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 - end do - end subroutine med_phases_history_write_inst_glc - - subroutine med_phases_history_write_inst_ocn(gcomp, rc) - ! Write mediator history file for ocn variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - !--------------------------------------- - rc = ESMF_SUCCESS - call med_phases_history_write_inst_comp(gcomp, compocn, 'med_phases_history_write_inst_ocn', rc) - end subroutine med_phases_history_write_inst_ocn - - subroutine med_phases_history_write_inst_rof(gcomp, rc) - ! Write mediator history file for rof variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - !--------------------------------------- - rc = ESMF_SUCCESS - call med_phases_history_write_inst_comp(gcomp, comprof, 'med_phases_history_write_inst_rof', rc) - end subroutine med_phases_history_write_inst_rof + 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 - subroutine med_phases_history_write_inst_wav(gcomp, rc) - ! Write mediator history file for wav variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - !--------------------------------------- - rc = ESMF_SUCCESS - call med_phases_history_write_inst_comp(gcomp, compwav, 'med_phases_history_write_inst_wav', rc) - end subroutine med_phases_history_write_inst_wav + if (hist_option /= 'none' .and. hist_option /= 'never') then + ! First create hclock from mclock - THIS CALL DOES NOT COPY ALARMS + call NUOPC_ModelGet(gcomp, modelClock=mclock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + hclock_inst_all = ESMF_ClockCreate(mclock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - !=========================================================== - ! Time averaged mediator history files - !=========================================================== + ! Set alarm for instantaneous history output + ! Advance history clock to trigger alarms then reset history clock back to mcurrtime + call ESMF_ClockGet(hclock_inst_all, startTime=StartTime, currTime=CurrTime, timeStep=timestep, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_time_alarmInit(hclock_inst_all, alarm, option=hist_option, opt_n=hist_n, & + reftime=StartTime, alarmname=trim(alarmname), rc=rc) + call ESMF_AlarmSet(alarm, clock=hclock_inst_all, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockAdvance(hclock_inst_all,rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockSet(hclock_inst_all, currTime=currtime) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Write mediator average history file for atm variables - subroutine med_phases_history_write_avg_atm(gcomp, rc) - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - !--------------------------------------- - rc = ESMF_SUCCESS - call med_phases_history_write_avg_comp(gcomp, compatm, 'med_phases_history_write_avg_atm', rc) - end subroutine med_phases_history_write_avg_atm + ! Write diagnostic info + if (mastertask) then + call ESMF_TimeIntervalGet(timestep, s=timestep_length, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(logunit,'(a,2x,i8)') " initialized instantaneous history alarm "//& + trim(alarmname)//" with option "//trim(hist_option)//" and frequency ",hist_n + write(logunit,'(a,2x,i8)') " history clock timestep = ",timestep_length + end if + end if - ! Write mediator average history file for ice variables - subroutine med_phases_history_write_avg_ice(gcomp, rc) - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - !--------------------------------------- - rc = ESMF_SUCCESS - call med_phases_history_write_avg_comp(gcomp, compice, 'med_phases_history_write_avg_ice', rc) - end subroutine med_phases_history_write_avg_ice + first_time = .false. + end if - ! Write mediator average history file for glc variables - subroutine med_phases_history_write_avg_glc(gcomp, rc) - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - ! local variables - integer :: ns - character(len=CS) :: cns - !--------------------------------------- - rc = ESMF_SUCCESS - do ns = 1,num_icesheets - write(cns,*) ns - call med_phases_history_write_avg_comp(gcomp, compglc(ns), 'med_phases_history_write_avg_glc'//trim(cns), rc) + if (ESMF_ClockIsCreated(hclock_inst_all)) then + ! Advance the clock + call ESMF_ClockAdvance(hclock_inst_all, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - end do - end subroutine med_phases_history_write_avg_glc - ! Write mediator average history file for lnd variables - subroutine med_phases_history_write_avg_lnd(gcomp, rc) - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - !--------------------------------------- - rc = ESMF_SUCCESS - call med_phases_history_write_avg_comp(gcomp, complnd, 'med_phases_history_write_avg_lnd', rc) - end subroutine med_phases_history_write_avg_lnd + ! Write the instantaneous history file for all relevant components + call med_phases_history_write_hfile(gcomp, 'all', hclock_inst_all, 'alarm_history_inst_all', .false., rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if - ! Write mediator average history file for ocn variables - subroutine med_phases_history_write_avg_ocn(gcomp, rc) - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - !--------------------------------------- - rc = ESMF_SUCCESS - call med_phases_history_write_avg_comp(gcomp, compocn, 'med_phases_history_write_avg_ocn', rc) - end subroutine med_phases_history_write_avg_ocn + call t_stopf('MED:'//subname) - ! Write mediator average history file for rof variables - subroutine med_phases_history_write_avg_rof(gcomp, rc) - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - !--------------------------------------- - rc = ESMF_SUCCESS - call med_phases_history_write_avg_comp(gcomp, comprof, 'med_phases_history_write_avg_rof', rc) - end subroutine med_phases_history_write_avg_rof + end subroutine med_phases_history_write - ! Write mediator average history file for wav variables - subroutine med_phases_history_write_avg_wav(gcomp, rc) + !=============================================================================== + subroutine med_phases_history_write_med(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 + ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc + logical :: first_time = .true. !--------------------------------------- rc = ESMF_SUCCESS - call med_phases_history_write_avg_comp(gcomp, compwav, 'med_phases_history_write_avg_wav', rc) - end subroutine med_phases_history_write_avg_wav - - !=========================================================== - ! Auxiliary mediator history files - !=========================================================== + call med_phases_history_write_inst_comp(gcomp, compmed, & + first_time, 'med_phases_history_write_inst_med', rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (first_time) first_time = .false. + end subroutine med_phases_history_write_med - ! Write mediator history file for atm variables - subroutine med_phases_history_write_aux_atm(gcomp, rc) + !=============================================================================== + subroutine med_phases_history_write_atm(gcomp, rc) + ! Write mediator history file for atm variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc - logical :: first_time = .true. + logical :: first_time = .true. !--------------------------------------- rc = ESMF_SUCCESS - call med_phases_history_write_aux_comp(gcomp, compatm, first_time, 'med_phases_history_write_aux_atm', rc) + call med_phases_history_write_inst_comp(gcomp, compatm, & + first_time, 'med_phases_history_write_inst_atm', rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (first_time) first_time = .false. - end subroutine med_phases_history_write_aux_atm + call med_phases_history_write_avg_comp(gcomp, compatm, & + first_time, 'med_phases_history_write_avg_atm', rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_phases_history_write_aux_comp(gcomp, compatm, & + first_time, 'med_phases_history_write_aux_atm', rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (first_time) first_time = .false. + end subroutine med_phases_history_write_atm + !=============================================================================== ! Write mediator history file for ice variables - subroutine med_phases_history_write_aux_ice(gcomp, rc) + subroutine med_phases_history_write_ice(gcomp, rc) type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc - logical :: first_time = .true. + logical :: first_time = .true. !--------------------------------------- rc = ESMF_SUCCESS - call med_phases_history_write_aux_comp(gcomp, compice, first_time, 'med_phases_history_write_aux_ice', rc) + call med_phases_history_write_inst_comp(gcomp, compice, & + first_time, 'med_phases_history_write_inst_ice', rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_phases_history_write_avg_comp(gcomp, compice, & + first_time, 'med_phases_history_write_avg_ice', rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_phases_history_write_aux_comp(gcomp, compice, & + first_time, 'med_phases_history_write_aux_ice', rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (first_time) first_time = .false. - end subroutine med_phases_history_write_aux_ice + end subroutine med_phases_history_write_ice + !=============================================================================== ! Write mediator history file for glc variables - subroutine med_phases_history_write_aux_glc(gcomp, rc) + subroutine med_phases_history_write_glc(gcomp, rc) type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc - integer :: ns - character(len=CS) :: cns - logical :: first_time = .true. + integer :: ns + character(len=CS) :: cns + logical :: first_time = .true. !--------------------------------------- rc = ESMF_SUCCESS do ns = 1,num_icesheets write(cns,*) ns - call med_phases_history_write_aux_comp(gcomp, compglc(ns), first_time, 'med_phases_history_write_aux_glc'//trim(cns), rc) + call med_phases_history_write_inst_comp(gcomp, compglc(ns), & + first_time, 'med_phases_history_write_inst_glc'//trim(cns), rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_phases_history_write_avg_comp(gcomp, compglc(ns), & + first_time, 'med_phases_history_write_avg_glc'//trim(cns), rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_phases_history_write_aux_comp(gcomp, compglc(ns), & + first_time, 'med_phases_history_write_aux_glc'//trim(cns), rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end do if (first_time) first_time = .false. - end subroutine med_phases_history_write_aux_glc + end subroutine med_phases_history_write_glc + !=============================================================================== ! Write mediator history file for lnd variables - subroutine med_phases_history_write_aux_lnd(gcomp, rc) + subroutine med_phases_history_write_lnd(gcomp, rc) type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc - logical :: first_time = .true. + logical :: first_time = .true. !--------------------------------------- rc = ESMF_SUCCESS - call med_phases_history_write_aux_comp(gcomp, complnd, first_time, 'med_phases_history_write_aux_lnd', rc) + call med_phases_history_write_inst_comp(gcomp, complnd, & + first_time, 'med_phases_history_write_inst_lnd', rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_phases_history_write_avg_comp(gcomp, complnd, & + first_time, 'med_phases_history_write_avg_lnd', rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_phases_history_write_aux_comp(gcomp, complnd, & + first_time, 'med_phases_history_write_aux_lnd', rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (first_time) first_time = .false. - end subroutine med_phases_history_write_aux_lnd + end subroutine med_phases_history_write_lnd + !=============================================================================== ! Write mediator history file for ocn variables - subroutine med_phases_history_write_aux_ocn(gcomp, rc) + subroutine med_phases_history_write_ocn(gcomp, rc) type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc - logical :: first_time = .true. + logical :: first_time = .true. !--------------------------------------- rc = ESMF_SUCCESS - call med_phases_history_write_aux_comp(gcomp, compocn, first_time, 'med_phases_history_write_aux_ocn', rc) + call med_phases_history_write_inst_comp(gcomp, compocn, & + first_time, 'med_phases_history_write_inst_ocn', rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_phases_history_write_avg_comp(gcomp, compocn, & + first_time, 'med_phases_history_write_avg_ocn', rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_phases_history_write_aux_comp(gcomp, compocn, & + first_time, 'med_phases_history_write_aux_ocn', rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (first_time) first_time = .false. - end subroutine med_phases_history_write_aux_ocn + end subroutine med_phases_history_write_ocn + !=============================================================================== ! Write mediator history file for rof variables - subroutine med_phases_history_write_aux_rof(gcomp, rc) + subroutine med_phases_history_write_rof(gcomp, rc) type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc - logical :: first_time = .true. + logical :: first_time = .true. !--------------------------------------- rc = ESMF_SUCCESS - call med_phases_history_write_aux_comp(gcomp, comprof, first_time, 'med_phases_history_write_aux_rof', rc) + call med_phases_history_write_inst_comp(gcomp, comprof, & + first_time, 'med_phases_history_write_inst_rof', rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_phases_history_write_avg_comp(gcomp, comprof, & + first_time, 'med_phases_history_write_avg_rof', rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_phases_history_write_aux_comp(gcomp, comprof, & + first_time, 'med_phases_history_write_aux_rof', rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (first_time) first_time = .false. - end subroutine med_phases_history_write_aux_rof + end subroutine med_phases_history_write_rof + !=============================================================================== ! Write mediator history file for wav variables - subroutine med_phases_history_write_aux_wav(gcomp, rc) + subroutine med_phases_history_write_wav(gcomp, rc) type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc - logical :: first_time = .true. + logical :: first_time = .true. !--------------------------------------- rc = ESMF_SUCCESS - call med_phases_history_write_aux_comp(gcomp, compwav, first_time, 'med_phases_history_write_aux_wav', rc) + call med_phases_history_write_inst_comp(gcomp, compwav, & + first_time, 'med_phases_history_write_inst_wav', rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_phases_history_write_avg_comp(gcomp, compwav, & + first_time, 'med_phases_history_write_avg_wav', rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_phases_history_write_aux_comp(gcomp, compwav, & + first_time, 'med_phases_history_write_aux_wav', rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (first_time) first_time = .false. - end subroutine med_phases_history_write_aux_wav - - !=========================================================== - ! Private Routines - !=========================================================== + end subroutine med_phases_history_write_wav - subroutine med_phases_history_init_inst(gcomp, alarmname, hclock, compid, rc) - ! -------------------------------------- - ! Initialize instantaneous history file - ! -------------------------------------- + !=============================================================================== + subroutine med_phases_history_write_inst_comp(gcomp, compid, first_time, subname, rc) + ! Write instantaneous mediator history file for component compid ! input/output variables type(ESMF_GridComp) , intent(inout) :: gcomp - character(len=*) , intent(in) :: alarmname ! alarm name - type(ESMF_Clock) , intent(inout) :: hclock + integer , intent(in) :: compid + logical , intent(in) :: first_time + character(len=*) , intent(in) :: subname integer , intent(out) :: rc - integer, optional , intent(in) :: compid ! local variables + character(CL) :: alarmname type(ESMF_Clock) :: mclock type(ESMF_Alarm) :: alarm type(ESMF_Time) :: CurrTime type(ESMF_Time) :: StartTime type(ESMF_TimeInterval) :: timestep integer :: timestep_length - 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 + character(CL) :: cvalue ! attribute string logical :: isPresent logical :: isSet - character(len=*), parameter :: subname=' (med_phases_history_init_inst)' !--------------------------------------- - rc = ESMF_SUCCESS + call t_startf('MED:'//subname) - ! Determine instantaneous mediator output frequency and type - 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) + alarmname = 'alarm_history_inst_'//trim(compname(compid)) + + if (first_time) then + + ! Determine attribute prefix + write(hist_option_in,'(a)') 'history_inst_option_'//trim(compname(compid)) + write(hist_n_in,'(a)') 'history_inst_n_'//trim(compname(compid)) + + ! 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 - read(cvalue,*) hist_n - else - ! If attribute is not present - don't write history output - hist_option = 'none' - hist_n = -999 - end if + 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 - ! First create hclock from mclock - THIS CALL DOES NOT COPY ALARMS - call NUOPC_ModelGet(gcomp, modelClock=mclock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - hclock = ESMF_ClockCreate(mclock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (hist_option /= 'none' .and. hist_option /= 'never') then + ! First create hclock from mclock - THIS CALL DOES NOT COPY ALARMS + call NUOPC_ModelGet(gcomp, modelClock=mclock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + hclock_inst_comp(compid) = ESMF_ClockCreate(mclock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Set alarm for instantaneous history output - ! Advance history clock to trigger alarms then reset history clock back to mcurrtime - call ESMF_ClockGet(hclock, startTime=StartTime, currTime=CurrTime, timeStep=timestep, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_time_alarmInit(hclock, alarm, option=hist_option, opt_n=hist_n, & - reftime=StartTime, alarmname=trim(alarmname), rc=rc) - call ESMF_AlarmSet(alarm, clock=hclock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockAdvance(hclock,rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockSet(hclock, currTime=currtime) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Set alarm for instantaneous history output + ! Advance history clock to trigger alarms then reset history clock back to mcurrtime + call ESMF_ClockGet(hclock_inst_comp(compid), startTime=StartTime, currTime=CurrTime, timeStep=timestep, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_time_alarmInit(hclock_inst_comp(compid), alarm, option=hist_option, opt_n=hist_n, & + reftime=StartTime, alarmname=trim(alarmname), rc=rc) + call ESMF_AlarmSet(alarm, clock=hclock_inst_comp(compid), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockAdvance(hclock_inst_comp(compid),rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockSet(hclock_inst_comp(compid), currTime=currtime) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Write diagnostic info - if (mastertask) then - call ESMF_TimeIntervalGet(timestep, s=timestep_length, rc=rc) + ! Write diagnostic info + if (mastertask) then + call ESMF_TimeIntervalGet(timestep, s=timestep_length, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(logunit,'(a,2x,i8)') " initialized instantaneous history alarm "//& + trim(alarmname)//" with option "//trim(hist_option)//" and frequency ",hist_n + write(logunit,'(a,2x,i8)') " history clock timestep = ",timestep_length + end if + end if + end if + + if (ESMF_ClockIsCreated(hclock_inst_comp(compid))) then + ! Advance the clock + call ESMF_ClockAdvance(hclock_inst_comp(compid), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Write the instantaneous history file + call med_phases_history_write_hfile(gcomp, trim(compname(compid)), hclock_inst_comp(compid), & + trim(alarmname), .false., rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - write(logunit,*) - write(logunit,'(a,2x,i8)') trim(subname)//" Initialized instantaneous history alarm "//& - trim(alarmname)//" with option "//trim(hist_option)//" and frequency ",hist_n - write(logunit,'(a,2x,i8)') trim(subname)//" history clock timestep = ",timestep_length end if - end subroutine med_phases_history_init_inst + call t_stopf('MED:'//subname) + + end subroutine med_phases_history_write_inst_comp !=============================================================================== - subroutine med_phases_history_init_avg(gcomp, compid, alarmname, hclock, rc) + subroutine med_phases_history_write_avg_comp(gcomp, compid, first_time, subname, rc) - ! ----------------------------- - ! Initialize time average history file - ! ----------------------------- + ! Write mediator average history file variables for component compid ! input/output variables type(ESMF_GridComp) , intent(inout) :: gcomp - integer , intent(in) :: compid - character(len=*) , intent(in) :: alarmname ! alarm name - type(ESMF_Clock) , intent(inout) :: hclock + integer , intent(in) :: compid + logical , intent(in) :: first_time + character(len=*) , intent(in) :: subname integer , intent(out) :: rc - ! local variables - type(InternalState) :: is_local - type(ESMF_Clock) :: mclock - type(ESMF_Alarm) :: alarm - type(ESMF_Time) :: CurrTime - type(ESMF_Time) :: StartTime - type(ESMF_TimeInterval) :: timestep - integer :: timestep_length - 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 - logical :: isPresent - logical :: isSet - character(len=*), parameter :: subname=' (med_phases_history_init)' + integer :: n + character(CL) :: alarmname + type(InternalState) :: is_local + type(ESMF_Clock) :: mclock + type(ESMF_Alarm) :: alarm + type(ESMF_Time) :: CurrTime + type(ESMF_Time) :: StartTime + type(ESMF_TimeInterval) :: timestep + integer :: timestep_length + 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 !--------------------------------------- + rc = ESMF_SUCCESS + call t_startf('MED:'//subname) - ! ! Determine time average mediator output frequency and type - hist_option = 'none' - hist_n = -999 - call NUOPC_CompAttributeGet(gcomp, name='history_avg_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_avg_option', value=hist_option, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(gcomp, name='history_avg_n', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) hist_n - end if + alarmname = 'alarm_history_avg_'//trim(compname(compid)) - ! Set alarm for time averaged history output - ! Advance history clock to trigger alarms then reset history clock back to mcurrtime - call ESMF_ClockGet(hclock, startTime=StartTime, currTime=CurrTime, timeStep=timestep, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_time_alarmInit(hclock, alarm, option=hist_option, opt_n=hist_n, & - reftime=StartTime, alarmname=trim(alarmname), rc=rc) - call ESMF_AlarmSet(alarm, clock=hclock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockAdvance(hclock,rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockSet(hclock, currTime=currtime) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (first_time) then - ! Create time average field bundles (module variables) - if (hist_option /= 'never' .and. hist_option /= 'none') then + ! Determine attribute prefix + write(hist_option_in,'(a)') 'history_avg_option_'//trim(compname(compid)) + write(hist_n_in,'(a)') 'history_avg_n_'//trim(compname(compid)) - nullify(is_local%wrap) - call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + ! 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 (compid /= compmed) then + ! Create time average field bundles (module variables) + if (hist_option /= 'never' .and. hist_option /= 'none') then - ! create accumulated import fields - if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(compid,compid),rc=rc)) then - if (.not. ESMF_FieldBundleIsCreated(avgfiles_import(compid)%FBaccum)) then - call med_methods_fb_init(avgfiles_import(compid)%FBaccum, is_local%wrap%flds_scalar_name, & - FBgeom=is_local%wrap%FBImp(compid,compid), STflds=is_local%wrap%NStateImp(compid), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call med_methods_FB_reset(avgfiles_import(compid)%FBaccum, czero, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - avgfiles_import(compid)%accumcnt = 0 - end if - end if - ! accumulated export fields - if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(compid), rc=rc)) then - if (.not. ESMF_FieldBundleIsCreated(avgfiles_export(compid)%FBaccum)) then - call med_methods_fb_init(avgfiles_export(compid)%FBaccum, is_local%wrap%flds_scalar_name, & - FBgeom=is_local%wrap%FBExp(compid), STflds=is_local%wrap%NstateExp(compid), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call med_methods_FB_reset(avgfiles_export(compid)%FBaccum, czero, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - avgfiles_export(compid)%accumcnt = 0 - end if - end if + ! First create hclock from mclock - THIS CALL DOES NOT COPY ALARMS + call NUOPC_ModelGet(gcomp, modelClock=mclock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + hclock_avg_comp(compid) = ESMF_ClockCreate(mclock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - else ! compid is compmed + ! Set alarm for time averaged history output + ! Advance history clock to trigger alarms then reset history clock back to mcurrtime + call ESMF_ClockGet(hclock_avg_comp(compid), startTime=StartTime, currTime=CurrTime, timeStep=timestep, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_time_alarmInit(hclock_avg_comp(compid), alarm, option=hist_option, opt_n=hist_n, & + reftime=StartTime, alarmname=trim(alarmname), rc=rc) + call ESMF_AlarmSet(alarm, clock=hclock_avg_comp(compid), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockAdvance(hclock_avg_comp(compid),rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockSet(hclock_avg_comp(compid), currTime=currtime) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! accumulated atm/ocn flux on ocn mesh - if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_o, rc=rc)) then - if (.not. ESMF_FieldBundleIsCreated(avgfiles_aoflux_ocn%FBaccum)) then - call med_methods_fb_init(avgfiles_aoflux_ocn%FBaccum, is_local%wrap%flds_scalar_name, & - FBgeom=is_local%wrap%FBMed_aoflux_o, FBflds=is_local%wrap%FBMed_aoflux_o, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call med_methods_FB_reset(avgfiles_aoflux_ocn%FBaccum, czero, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - avgfiles_aoflux_ocn%accumcnt = 0 + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (compid /= compmed) then + ! create accumulated import fields + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(compid,compid),rc=rc)) then + if (.not. ESMF_FieldBundleIsCreated(avgfiles_import(compid)%FBaccum)) then + call med_methods_fb_init(avgfiles_import(compid)%FBaccum, is_local%wrap%flds_scalar_name, & + FBgeom=is_local%wrap%FBImp(compid,compid), STflds=is_local%wrap%NStateImp(compid), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call med_methods_FB_reset(avgfiles_import(compid)%FBaccum, czero, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + avgfiles_import(compid)%accumcnt = 0 + end if end if - end if - ! accumulated atm/ocn flux on atm mesh - if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a, rc=rc)) then - if (.not. ESMF_FieldBundleIsCreated(avgfiles_aoflux_atm%FBaccum)) then - call med_methods_fb_init(avgfiles_aoflux_atm%FBaccum, is_local%wrap%flds_scalar_name, & - FBgeom=is_local%wrap%FBMed_aoflux_a, FBflds=is_local%wrap%FBMed_aoflux_a, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call med_methods_FB_reset(avgfiles_aoflux_atm%FBaccum, czero, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - avgfiles_aoflux_atm%accumcnt = 0 + ! accumulated export fields + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(compid), rc=rc)) then + if (.not. ESMF_FieldBundleIsCreated(avgfiles_export(compid)%FBaccum)) then + call med_methods_fb_init(avgfiles_export(compid)%FBaccum, is_local%wrap%flds_scalar_name, & + FBgeom=is_local%wrap%FBExp(compid), STflds=is_local%wrap%NstateExp(compid), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call med_methods_FB_reset(avgfiles_export(compid)%FBaccum, czero, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + avgfiles_export(compid)%accumcnt = 0 + end if end if - end if - ! accumulated ocean albedo on ocn mesh - if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o, rc=rc)) then - if (.not. ESMF_FieldBundleIsCreated(avgfiles_ocnalb_ocn%FBaccum)) then - call med_methods_fb_init(avgfiles_ocnalb_ocn%FBaccum, is_local%wrap%flds_scalar_name, & - FBgeom=is_local%wrap%FBMed_ocnalb_o, FBflds=is_local%wrap%FBMed_ocnalb_o, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call med_methods_FB_reset(avgfiles_ocnalb_ocn%FBaccum, czero, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - avgfiles_ocnalb_ocn%accumcnt = 0 + else ! compid is compmed + ! accumulated atm/ocn flux on ocn mesh + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_o, rc=rc)) then + if (.not. ESMF_FieldBundleIsCreated(avgfiles_aoflux_ocn%FBaccum)) then + call med_methods_fb_init(avgfiles_aoflux_ocn%FBaccum, is_local%wrap%flds_scalar_name, & + FBgeom=is_local%wrap%FBMed_aoflux_o, FBflds=is_local%wrap%FBMed_aoflux_o, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call med_methods_FB_reset(avgfiles_aoflux_ocn%FBaccum, czero, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + avgfiles_aoflux_ocn%accumcnt = 0 + end if end if - end if - ! accumulated ocean albedo on atm mesh - if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_a, rc=rc)) then - if (.not. ESMF_FieldBundleIsCreated(avgfiles_ocnalb_atm%FBaccum)) then - call med_methods_fb_init(avgfiles_ocnalb_atm%FBaccum, is_local%wrap%flds_scalar_name, & - FBgeom=is_local%wrap%FBMed_ocnalb_a, FBflds=is_local%wrap%FBMed_ocnalb_a, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call med_methods_FB_reset(avgfiles_ocnalb_atm%FBaccum, czero, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - avgfiles_ocnalb_atm%accumcnt = 0 + ! accumulated atm/ocn flux on atm mesh + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a, rc=rc)) then + if (.not. ESMF_FieldBundleIsCreated(avgfiles_aoflux_atm%FBaccum)) then + call med_methods_fb_init(avgfiles_aoflux_atm%FBaccum, is_local%wrap%flds_scalar_name, & + FBgeom=is_local%wrap%FBMed_aoflux_a, FBflds=is_local%wrap%FBMed_aoflux_a, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call med_methods_FB_reset(avgfiles_aoflux_atm%FBaccum, czero, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + avgfiles_aoflux_atm%accumcnt = 0 + end if + end if + ! accumulated ocean albedo on ocn mesh + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o, rc=rc)) then + if (.not. ESMF_FieldBundleIsCreated(avgfiles_ocnalb_ocn%FBaccum)) then + call med_methods_fb_init(avgfiles_ocnalb_ocn%FBaccum, is_local%wrap%flds_scalar_name, & + FBgeom=is_local%wrap%FBMed_ocnalb_o, FBflds=is_local%wrap%FBMed_ocnalb_o, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call med_methods_FB_reset(avgfiles_ocnalb_ocn%FBaccum, czero, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + avgfiles_ocnalb_ocn%accumcnt = 0 + end if + end if + ! accumulated ocean albedo on atm mesh + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_a, rc=rc)) then + if (.not. ESMF_FieldBundleIsCreated(avgfiles_ocnalb_atm%FBaccum)) then + call med_methods_fb_init(avgfiles_ocnalb_atm%FBaccum, is_local%wrap%flds_scalar_name, & + FBgeom=is_local%wrap%FBMed_ocnalb_a, FBflds=is_local%wrap%FBMed_ocnalb_a, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call med_methods_FB_reset(avgfiles_ocnalb_atm%FBaccum, czero, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + avgfiles_ocnalb_atm%accumcnt = 0 + end if end if end if - end if + + end if ! end of initialization (first_time) if block + + if (ESMF_ClockIsCreated(hclock_avg_comp(compid))) then + ! Update clock + call ESMF_ClockAdvance(hclock_avg_comp(compid), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Write history file + call med_phases_history_write_hfile(gcomp, trim(compname(compid)), hclock_avg_comp(compid), & + trim(alarmname), .false., rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - end subroutine med_phases_history_init_avg + call t_stopf('MED:'//subname) + + end subroutine med_phases_history_write_avg_comp !=============================================================================== - subroutine med_phases_history_init_aux(gcomp, ncomp, auxfile, rc) + subroutine med_phases_history_write_aux_comp(gcomp, compid, first_time, subname, rc) ! ----------------------------- + ! Write mediator history file for component compid ! 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 @@ -652,8 +657,9 @@ subroutine med_phases_history_init_aux(gcomp, ncomp, auxfile, rc) ! input/output variables type(ESMF_GridComp) , intent(inout) :: gcomp - integer , intent(in) :: ncomp - type(auxfile_type) , intent(inout) :: auxfile(:) + integer , intent(in) :: compid + logical , intent(in) :: first_time + character(len=*) , intent(in) :: subname integer , intent(out) :: rc ! local variables @@ -678,198 +684,212 @@ subroutine med_phases_history_init_aux(gcomp, ncomp, auxfile, rc) logical :: found character(CS) :: enable_auxfile character(CS), allocatable :: fieldNameList(:) - character(len=*), parameter :: subname=' (med_phases_history_init_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 (first_time) then - ! Initialize number of aux files for this component to zero - nfcnt = 0 - do nfile = 1,max_auxfiles + ! Get the internal state + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Determine attribute prefix - write(prefix,'(a,i0)') 'histaux_'//trim(compname(ncomp))//'2med_file',nfile + ! Initialize number of aux files for this component to zero + nfcnt = 0 + do nfile = 1,max_auxfiles - ! Determine if on/off flag is enabled for this 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=enable_auxfile, rc=rc) + ! Determine attribute prefix + write(prefix,'(a,i0)') 'histaux_'//trim(compname(compid))//'2med_file',nfile + + ! Determine if on/off flag is enabled for this file + call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_enabled', isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if + if (isPresent .and. isSet) then + call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_enabled', value=enable_auxfile, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if - ! If enabled is on - then initailize auxfile(nfcnt) - if (isPresent .and. isSet .and. (trim(enable_auxfile) == 'on')) then + ! If enabled is on - then initialize auxfiles(nfcnt,compid) + if (isPresent .and. isSet .and. (trim(enable_auxfile) == 'on')) then - ! Increment nfcnt - nfcnt = nfcnt + 1 + ! 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,*) auxfile(nfcnt)%ntperfile - if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! 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,*) auxfiles(nfcnt,compid)%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)//'_useavg', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) auxfile(nfcnt)%useavg + ! Determine if will do time average for aux file + call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_useavg', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) auxfiles(nfcnt,compid)%useavg - ! 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 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 + ! 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(ncomp,ncomp), fieldCount=fieldCount, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - allocate(auxfile(nfcnt)%flds(fieldcount)) - call ESMF_FieldBundleGet(is_local%wrap%FBImp(ncomp,ncomp), fieldNameList=auxfile(nfcnt)%flds, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + ! 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(auxfiles(nfcnt,compid)%flds(fieldcount)) + call ESMF_FieldBundleGet(is_local%wrap%FBImp(compid,compid), & + fieldNameList=auxfiles(nfcnt,compid)%flds, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - else + else + + ! Translate the colon deliminted string (auxflds) into a character array (fieldnamelist) + ! Note that the following call allocates the memory for fieldnamelist + call med_phases_history_get_auxflds(auxflds, fieldnamelist, rc) + ! 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 - ! Translate the colon deliminted string (auxflds) into a character array (fieldnamelist) - ! Note that the following call allocates the memory for fieldnamelist - call med_phases_history_get_auxflds(auxflds, fieldnamelist, rc) + ! Create auxfiles(nfcnt,compid)%flds array + allocate(auxfiles(nfcnt,compid)%flds(fieldcount)) + do n = 1,fieldcount + auxfiles(nfcnt,compid)%flds(n) = trim(fieldnamelist(n)) + end do - ! Remove all fields from fieldnamelist that are not in FBImp(ncomp,ncomp) - fieldCount = size(fieldnamelist) - do n = 1,fieldcount - if (.not. med_methods_FB_fldchk(is_local%wrap%FBImp(ncomp,ncomp), 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 auxfile(nfcnt)%flds array - allocate(auxfile(nfcnt)%flds(fieldcount)) - do n = 1,fieldcount - auxfile(nfcnt)%flds(n) = trim(fieldnamelist(n)) - end do + ! Deallocate memory from fieldnamelist + deallocate(fieldnamelist) ! this was allocated in med_phases_history_get_auxflds - ! Deallocate memory from fieldnamelist - deallocate(fieldnamelist) ! this was allocated in med_phases_history_get_auxflds - end if - if (mastertask) then - write(logunit,*) - write(logunit,'(a,i4,a)') trim(subname)//' Writing the following fields to auxfile ',nfcnt,& - ' for component '//trim(compname(ncomp)) - do nfld = 1,size(auxfile(nfcnt)%flds) - write(logunit,'(4x,a)') trim(auxfile(nfcnt)%flds(nfld)) - end do - end if + end if ! end of if auxflds is set to 'all' + + if (mastertask) then + write(logunit,*) + write(logunit,'(a,i4,a)') ' Writing the following fields to auxfile ',nfcnt,& + ' for component '//trim(compname(compid)) + do nfld = 1,size(auxfiles(nfcnt,compid)%flds) + write(logunit,'(8x,a)') trim(auxfiles(nfcnt,compid)%flds(nfld)) + end do + end if - ! Create FBaccum if averaging is on - if (auxfile(nfcnt)%useavg) then - - ! First duplicate all fields in FBImp(ncomp,ncomp) - call ESMF_LogWrite(trim(subname)// ": calling med_methods_fb_init for FBaccum(ncomp)", ESMF_LOGMSG_INFO) - call med_methods_fb_init(auxfile(nfcnt)%FBaccum, is_local%wrap%flds_scalar_name, & - FBgeom=is_local%wrap%FBImp(ncomp,ncomp), STflds=is_local%wrap%NStateImp(ncomp), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! Now remove all fields from FBAccum that are not in the input flds list - call ESMF_FieldBundleGet(is_local%wrap%FBImp(ncomp,ncomp), fieldCount=fieldCount, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - allocate(fieldNameList(fieldCount)) - call ESMF_FieldBundleGet(is_local%wrap%FBImp(ncomp,ncomp), fieldNameList=fieldNameList, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - do n = 1,size(fieldnamelist) - found = .false. - do n1 = 1,size(auxfile(nfcnt)%flds) - if (trim(fieldnamelist(n)) == trim(auxfile(nfcnt)%flds(n1))) then - found = .true. - exit + ! Create FBaccum if averaging is on + if (auxfiles(nfcnt,compid)%useavg) then + + ! First duplicate all fields in FBImp(compid,compid) + call ESMF_LogWrite(trim(subname)// ": calling med_methods_fb_init for FBaccum(compid)", ESMF_LOGMSG_INFO) + call med_methods_fb_init(auxfiles(nfcnt,compid)%FBaccum, is_local%wrap%flds_scalar_name, & + FBgeom=is_local%wrap%FBImp(compid,compid), STflds=is_local%wrap%NStateImp(compid), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! 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(auxfiles(nfcnt,compid)%flds) + if (trim(fieldnamelist(n)) == trim(auxfiles(nfcnt,compid)%flds(n1))) then + found = .true. + exit + end if + end do + if (.not. found) then + call ESMF_FieldBundleRemove(auxfiles(nfcnt,compid)%FBaccum, fieldnamelist(n:n), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return end if end do - if (.not. found) then - call ESMF_FieldBundleRemove(auxfile(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(auxfile(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(auxfile(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) + deallocate(fieldnameList) + + ! Check that FBAccum has at least one field left - if not exit + call ESMF_FieldBundleGet(auxfiles(nfcnt,compid)%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(auxfiles(nfcnt,compid)%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 + end if - end if + ! 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 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 + ! First create hclock from mclock - THIS CALL DOES NOT COPY ALARMS + call NUOPC_ModelGet(gcomp, modelClock=mclock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + auxfiles(nfcnt,compid)%hclock = ESMF_ClockCreate(mclock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! First create hclock from mclock - THIS CALL DOES NOT COPY ALARMS - call NUOPC_ModelGet(gcomp, modelClock=mclock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - auxfile(nfcnt)%hclock = ESMF_ClockCreate(mclock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Set alarm for auxiliary history output + ! Advance history clock to trigger alarms then reset history clock back to mcurrtime + call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_auxname', value=auxfiles(nfcnt,compid)%auxname, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(auxfiles(nfcnt,compid)%alarmname,'(a,i0)') 'alarm_'//trim(prefix) + call ESMF_ClockGet(auxfiles(nfcnt,compid)%hclock, startTime=starttime, currTime=currtime, timeStep=timestep, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_time_alarmInit(auxfiles(nfcnt,compid)%hclock, alarm, option=hist_option, opt_n=hist_n, & + reftime=starttime, alarmname=trim(auxfiles(nfcnt,compid)%alarmname), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_AlarmSet(alarm, clock=auxfiles(nfcnt,compid)%hclock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockAdvance(auxfiles(nfcnt,compid)%hclock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockSet(auxfiles(nfcnt,compid)%hclock, currtime=currtime) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (mastertask) then + write(logunit,'(a,2x,i8)') " created auxiliary history alarm "//& + trim(auxfiles(nfcnt,compid)%alarmname)//" with option "//trim(hist_option)//" and frequency ",hist_n + end if + end if ! end of isPresent and isSet and if flag is on for file n + end do ! end of loop over nfile - ! Set alarm for auxiliary history output - ! Advance history clock to trigger alarms then reset history clock back to mcurrtime - call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_auxname', value=auxfile(nfcnt)%auxname, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - write(auxfile(nfcnt)%alarmname,'(a,i0)') 'alarm_'//trim(prefix) - call ESMF_ClockGet(auxfile(nfcnt)%hclock, startTime=starttime, currTime=currtime, timeStep=timestep, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_time_alarmInit(auxfile(nfcnt)%hclock, alarm, option=hist_option, opt_n=hist_n, & - reftime=starttime, alarmname=trim(auxfile(nfcnt)%alarmname), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_AlarmSet(alarm, clock=auxfile(nfcnt)%hclock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockAdvance(auxfile(nfcnt)%hclock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockSet(auxfile(nfcnt)%hclock, currtime=currtime) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (mastertask) then - write(logunit,'(a,2x,i8)') trim(subname)//" created auxiliary history alarm "//& - trim(auxfile(nfcnt)%alarmname)//" with option "//trim(hist_option)//" and frequency ",hist_n - end if + ! Set number of aux files for this component + num_auxfiles(compid) = nfcnt - end if ! end of isPresent and isSet and if flag is on for file n - end do ! end of loop over files (1->max_auxfiles) + ! Get file name variables + ! TODO: these are general settings that should be set outside of this system + ! These should be moved outside of this modeul + 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 + if (mastertask) write(logunit,*) - ! Set number of aux files for this component - num_auxfiles(ncomp) = nfcnt + end if ! end of initialization (first time) block - ! Get file name variables - ! TODO: these are general settings that should be set outside of this system - ! These should be moved outside of this modeul - 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) + ! Write auxiliary history files for component compid + do n = 1,num_auxfiles(compid) + call ESMF_ClockAdvance(auxfiles(n,compid)%hclock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - inst_tag = "" - endif - - if (mastertask) write(logunit,*) + call med_phases_history_write_hfileaux(gcomp, case_name, inst_tag, n, compid, auxfiles(n,compid), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do + call t_stopf('MED:'//subname) - end subroutine med_phases_history_init_aux + end subroutine med_phases_history_write_aux_comp !=============================================================================== subroutine med_phases_history_write_hfile(gcomp, comptype, hclock, alarmname, doavg, rc) @@ -1291,93 +1311,6 @@ subroutine med_phases_history_write_hfileaux(gcomp, case_name, inst_tag, & end subroutine med_phases_history_write_hfileaux - !=============================================================================== - subroutine med_phases_history_write_inst_comp(gcomp, compid, subname, rc) - ! Write instantaneous mediator history file for component compid - ! input/output variables - type(ESMF_GridComp) , intent(inout) :: gcomp - integer , intent(in) :: compid - character(len=*) , intent(in) :: subname - integer , intent(out) :: rc - ! local variables - character(CL) :: alarmname - !--------------------------------------- - rc = ESMF_SUCCESS - call t_startf('MED:'//subname) - alarmname = 'alarm_history_inst_'//trim(compname(compid)) - if (.not. ESMF_ClockIsCreated(hclock_inst_comp(compid))) then - call med_phases_history_init_inst(gcomp, trim(alarmname), hclock_inst_comp(compid), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - call ESMF_ClockAdvance(hclock_inst_comp(compid), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_write_hfile(gcomp, trim(compname(compid)), hclock_inst_comp(compid), & - trim(alarmname), .false., rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call t_stopf('MED:'//subname) - end subroutine med_phases_history_write_inst_comp - - !=============================================================================== - subroutine med_phases_history_write_avg_comp(gcomp, compid, subname, rc) - ! Write mediator average history file variables for component compid - ! input/output variables - type(ESMF_GridComp) , intent(inout) :: gcomp - integer , intent(in) :: compid - character(len=*) , intent(in) :: subname - integer , intent(out) :: rc - ! local variables - integer :: n - character(CL) :: alarmname - !--------------------------------------- - - rc = ESMF_SUCCESS - call t_startf('MED:'//subname) - alarmname = 'alarm_history_avg_'//trim(compname(compid)) - if (.not. ESMF_ClockIsCreated(hclock_avg_comp(compid))) then - ! init clock and alarm - call med_phases_history_init_avg(gcomp, compid, trim(alarmname), hclock_avg_comp(compid), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - call ESMF_ClockAdvance(hclock_avg_comp(compid), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_write_hfile(gcomp, trim(compname(compid)), hclock_avg_comp(compid), & - trim(alarmname), .false., rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call t_stopf('MED:'//subname) - - end subroutine med_phases_history_write_avg_comp - - !=============================================================================== - subroutine med_phases_history_write_aux_comp(gcomp, compid, first_time, subname, rc) - ! Write mediator history file for component compid - ! input/output variables - type(ESMF_GridComp) , intent(inout) :: gcomp - integer , intent(in) :: compid - logical , intent(in) :: first_time - character(len=*) , intent(in) :: subname - integer , intent(out) :: rc - ! local variables - integer :: n - !--------------------------------------- - rc = ESMF_SUCCESS - call t_startf('MED:'//subname) - if (first_time) then - if (mastertask) then - write(logunit,'(a)') trim(subname) // 'Initialize auxiliary history file and alarms for '//& - trim(compname(compid)) - end if - call med_phases_history_init_aux(gcomp, compid, auxfiles(:,compid), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - do n = 1,num_auxfiles(compid) - call ESMF_ClockAdvance(auxfiles(n,compid)%hclock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_write_hfileaux(gcomp, case_name, inst_tag, n, compid, auxfiles(n,compid), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end do - call t_stopf('MED:'//subname) - end subroutine med_phases_history_write_aux_comp - !=============================================================================== subroutine med_phases_history_get_filename(gcomp, doavg, comptype, hist_file, time_units, days_since, rc) From 662cbe4025ee49e1ef06b11bbea8501242b5cfb1 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 14 Apr 2021 10:51:05 -0600 Subject: [PATCH 24/61] cleanup of namelists and setting of aux enabled flags to logical --- cime_config/buildnml | 5 -- cime_config/config_component_cesm.xml | 9 -- cime_config/config_component_ufs.xml | 9 -- cime_config/namelist_definition_drv.xml | 115 ++++-------------------- drivers/cime/esm.F90 | 9 +- mediator/med_phases_history_mod.F90 | 112 ++++++++++++----------- 6 files changed, 80 insertions(+), 179 deletions(-) diff --git a/cime_config/buildnml b/cime_config/buildnml index af6ba9011..495eccbc7 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -84,11 +84,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 #-------------------------------- diff --git a/cime_config/config_component_cesm.xml b/cime_config/config_component_cesm.xml index cfe118435..8934f2410 100644 --- a/cime_config/config_component_cesm.xml +++ b/cime_config/config_component_cesm.xml @@ -100,15 +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 diff --git a/cime_config/config_component_ufs.xml b/cime_config/config_component_ufs.xml index bb32df7b5..7b07db0ab 100644 --- a/cime_config/config_component_ufs.xml +++ b/cime_config/config_component_ufs.xml @@ -96,15 +96,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 diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index a3cd73166..e093a298d 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -5,7 +5,7 @@ - + @@ -126,58 +126,6 @@ - - char - expdef - DRIVER_attributes - - location of timing checkpoint output. - - - ./timing/checkpoints - - - - - - - - - - - - - - - - - - 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 @@ -253,18 +201,6 @@ - - real - expdef - DRIVER_attributes - - Abort if cplstep time exceeds this value - - - 0. - - - char nuopc @@ -571,15 +507,6 @@ - - logical - expdef - DRIVER_attributes - - only have the mediator reads the restart file regardless of start type - - - char expdef @@ -1422,13 +1349,12 @@ - char + logical aux_hist MED_attributes Auxiliary mediator atm2med instantaneous history output every hour. - off,on - off + .false. @@ -1488,13 +1414,12 @@ - char + logical aux_hist MED_attributes Auxiliary atm2med history output averaged over 1 hour. - off,on - off + .false. @@ -1554,15 +1479,14 @@ - char + logical aux_hist MED_attributes Auxiliary mediator atm2med precipitation history output every 3 hours - off,on - off + .false. @@ -1622,15 +1546,14 @@ - char + logical aux_hist MED_attributes Auxiliary mediator a2x precipitation history output every 3 hours - off,on - off + .false. @@ -1692,13 +1615,12 @@ - char + logical aux_hist MED_attributes Auxiliary mediator a2x precipitation history output every 3 hours - off,on - off + .false. @@ -1911,13 +1833,12 @@ - char + logical aux_hist MED_attributes Auxiliary mediator l2x fields every lnd coupling interval - off,on - off + .false. @@ -1977,13 +1898,12 @@ - char + logical aux_hist MED_attributes Auxiliary mediator lnd2med fields every year - off,on - off + .false. @@ -2145,13 +2065,12 @@ - char + logical aux_hist MED_attributes Auxiliary mediator rof2med precipitation history output every 3 hours - off,on - off + .false. diff --git a/drivers/cime/esm.F90 b/drivers/cime/esm.F90 index 186f40d2f..e322355bf 100644 --- a/drivers/cime/esm.F90 +++ b/drivers/cime/esm.F90 @@ -658,15 +658,10 @@ subroutine AddAttributes(gcomp, driver, config, compid, compname, inst_suffix, n ! Add 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 diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 10e494d65..49a60c979 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -78,8 +78,8 @@ module med_phases_history_mod private :: med_phases_history_output_alarminfo private :: med_phases_history_ymds2rday_offset - character(CL) :: case_name ! case name - character(CS) :: inst_tag ! instance tag + character(CL) :: case_name = 'unset' ! case name + character(CS) :: inst_tag = 'unset' ! instance tag ! Time averaging history files type, public :: avgfile_type @@ -556,7 +556,7 @@ subroutine med_phases_history_write_avg_comp(gcomp, compid, first_time, subname, call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (compid /= compmed) then + if (compid /= compmed) then ! component is not mediator ! create accumulated import fields if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(compid,compid),rc=rc)) then if (.not. ESMF_FieldBundleIsCreated(avgfiles_import(compid)%FBaccum)) then @@ -579,7 +579,7 @@ subroutine med_phases_history_write_avg_comp(gcomp, compid, first_time, subname, avgfiles_export(compid)%accumcnt = 0 end if end if - else ! compid is compmed + else ! component is mediator ! accumulated atm/ocn flux on ocn mesh if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_o, rc=rc)) then if (.not. ESMF_FieldBundleIsCreated(avgfiles_aoflux_ocn%FBaccum)) then @@ -639,7 +639,6 @@ subroutine med_phases_history_write_avg_comp(gcomp, compid, first_time, subname, trim(alarmname), .false., rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - call t_stopf('MED:'//subname) end subroutine med_phases_history_write_avg_comp @@ -682,7 +681,7 @@ subroutine med_phases_history_write_aux_comp(gcomp, compid, first_time, subname, character(CL) :: auxflds integer :: fieldCount logical :: found - character(CS) :: enable_auxfile + logical :: enable_auxfile character(CS), allocatable :: fieldNameList(:) !--------------------------------------- rc = ESMF_SUCCESS @@ -702,16 +701,19 @@ subroutine med_phases_history_write_aux_comp(gcomp, compid, first_time, subname, ! Determine attribute prefix write(prefix,'(a,i0)') 'histaux_'//trim(compname(compid))//'2med_file',nfile - ! Determine if on/off flag is enabled for this file + ! 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=enable_auxfile, rc=rc) + 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 enabled is on - then initialize auxfiles(nfcnt,compid) - if (isPresent .and. isSet .and. (trim(enable_auxfile) == 'on')) then + ! If file will be written - then initialize auxfiles(nfcnt,compid) + if (enable_auxfile) then ! Increment nfcnt nfcnt = nfcnt + 1 @@ -748,6 +750,9 @@ subroutine med_phases_history_write_aux_comp(gcomp, compid, first_time, subname, ! Translate the colon deliminted string (auxflds) into a character array (fieldnamelist) ! Note that the following call allocates the memory for fieldnamelist call med_phases_history_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 @@ -839,10 +844,12 @@ subroutine med_phases_history_write_aux_comp(gcomp, compid, first_time, subname, ! Set alarm for auxiliary history output ! Advance history clock to trigger alarms then reset history clock back to mcurrtime - call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_auxname', value=auxfiles(nfcnt,compid)%auxname, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_auxname', & + value=auxfiles(nfcnt,compid)%auxname, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return write(auxfiles(nfcnt,compid)%alarmname,'(a,i0)') 'alarm_'//trim(prefix) - call ESMF_ClockGet(auxfiles(nfcnt,compid)%hclock, startTime=starttime, currTime=currtime, timeStep=timestep, rc=rc) + call ESMF_ClockGet(auxfiles(nfcnt,compid)%hclock, & + startTime=starttime, currTime=currtime, timeStep=timestep, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call med_time_alarmInit(auxfiles(nfcnt,compid)%hclock, alarm, option=hist_option, opt_n=hist_n, & reftime=starttime, alarmname=trim(auxfiles(nfcnt,compid)%alarmname), rc=rc) @@ -863,28 +870,13 @@ subroutine med_phases_history_write_aux_comp(gcomp, compid, first_time, subname, ! Set number of aux files for this component num_auxfiles(compid) = nfcnt - ! Get file name variables - ! TODO: these are general settings that should be set outside of this system - ! These should be moved outside of this modeul - 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 - if (mastertask) write(logunit,*) - end if ! end of initialization (first time) block ! Write auxiliary history files for component compid do n = 1,num_auxfiles(compid) call ESMF_ClockAdvance(auxfiles(n,compid)%hclock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_write_hfileaux(gcomp, case_name, inst_tag, n, compid, auxfiles(n,compid), rc=rc) + call med_phases_history_write_hfileaux(gcomp, n, compid, auxfiles(n,compid), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end do call t_stopf('MED:'//subname) @@ -1122,13 +1114,10 @@ subroutine med_phases_history_write_hfile(gcomp, comptype, hclock, alarmname, do end subroutine med_phases_history_write_hfile !=============================================================================== - subroutine med_phases_history_write_hfileaux(gcomp, case_name, inst_tag, & - nfile_index, comp_index, auxfile, rc) + subroutine med_phases_history_write_hfileaux(gcomp, nfile_index, comp_index, auxfile, rc) ! input/output variables type(ESMF_GridComp) , intent(inout) :: gcomp - character(len=*) , intent(in) :: case_name - character(len=*) , intent(in) :: inst_tag integer , intent(in) :: nfile_index integer , intent(in) :: comp_index type(auxfile_type) , intent(inout) :: auxfile @@ -1251,6 +1240,10 @@ subroutine med_phases_history_write_hfileaux(gcomp, case_name, inst_tag, & call ESMF_TimeGet(currtime,yy=yr, mm=mon, dd=day, s=sec, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return write(timestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + if (trim(case_name) == 'unset') then + call med_phases_history_set_casename(gcomp, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if write(auxfile%histfile, "(8a)") & trim(case_name),'.cpl',trim(inst_tag),'.hx.', trim(auxfile%auxname),'.',trim(timestr), '.nc' @@ -1335,26 +1328,12 @@ subroutine med_phases_history_get_filename(gcomp, doavg, comptype, hist_file, ti integer :: start_ymd ! Starting date YYYYMMDD integer :: yr,mon,day,sec ! time units logical :: isPresent - character(CL) :: case_name ! case name - character(CS) :: inst_tag ! instance tag - character(len=CS) :: histstr - character(len=*), parameter :: subname='(med_phases_history_get_timeunits)' + character(len=CS) :: histstr + character(len=*), parameter :: subname='(med_phases_history_get_filename)' !--------------------------------------- rc = ESMF_SUCCESS - ! Get case_name and inst_tag - 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 - ! Get time unit attribute value for variables call NUOPC_ModelGet(gcomp, modelClock=mclock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1389,12 +1368,15 @@ subroutine med_phases_history_get_filename(gcomp, doavg, comptype, hist_file, ti if (trim(comptype) /= 'all') then histstr = trim(histstr) // trim(comptype) // '.' end if + if (trim(case_name) == 'unset') then + call med_phases_history_set_casename(gcomp, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if write(hist_file,"(6a)") trim(case_name),'.cpl.',trim(inst_tag),trim(histstr),trim(nexttimestr),'.nc' 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) + write(logunit,' (a)') " writing mediator history file "//trim(hist_file) + write(logunit,' (a)') " currtime = "//trim(currtimestr)//" nexttime = "//trim(nexttimestr) end if end subroutine med_phases_history_get_filename @@ -1552,4 +1534,32 @@ subroutine med_phases_history_ymds2rday_offset(currtime, rdays_offset, & end subroutine med_phases_history_ymds2rday_offset + !=============================================================================== + subroutine med_phases_history_set_casename(gcomp, rc) + + ! Set module variables case_name and inst_tag + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + logical :: isPresent + logical :: isSet + !--------------------------------------- + rc = ESMF_SUCCESS + + 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 subroutine med_phases_history_set_casename + end module med_phases_history_mod From dd39e8d400658c0b1caec47ffb26ab45770e2680 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 14 Apr 2021 20:36:27 -0600 Subject: [PATCH 25/61] more general implementation of multiple ice sheets --- cime_config/namelist_definition_drv.xml | 12 ++++ mediator/esmFlds.F90 | 12 ++-- mediator/med.F90 | 80 +++++++++++++++---------- 3 files changed, 66 insertions(+), 38 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index e093a298d..d2824d2a7 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -2668,6 +2668,18 @@ + + integer + expdef + ALLCOMP_attributes + + number of glc ice sheets + + + 1 + + + logical flds diff --git a/mediator/esmFlds.F90 b/mediator/esmFlds.F90 index 185d52096..13ed53c14 100644 --- a/mediator/esmFlds.F90 +++ b/mediator/esmFlds.F90 @@ -17,7 +17,8 @@ module esmflds integer, public, parameter :: comprof = 6 integer, public, parameter :: compwav = 7 integer, public, parameter :: compglc1 = 8 - integer, public, parameter :: ncomps = 8 + integer, public, parameter :: compglc2 = 9 + integer, public, parameter :: ncomps = 9 character(len=*), public, parameter :: compname(ncomps) = & (/'med ',& @@ -27,11 +28,12 @@ module esmflds 'ice ',& 'rof ',& 'wav ',& - 'glc '/) + 'glc1',& + 'glc2'/) - integer, public, parameter :: max_icesheets = 1 - integer, public :: compglc(max_icesheets) = (/compglc1/) - integer, public :: num_icesheets = 1 + integer, public, parameter :: max_icesheets = 2 + integer, public :: compglc(max_icesheets) = (/compglc1,compglc2/) + integer, public :: num_icesheets ! obtained from attribute logical, public :: ocn2glc_coupling ! obtained from attribute logical, public :: dststatus_print = .false. diff --git a/mediator/med.F90 b/mediator/med.F90 index cc69aeadf..cf470f17e 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -752,6 +752,7 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) use ESMF , only : ESMF_GridComp, ESMF_State, ESMF_Clock, ESMF_SUCCESS, ESMF_LogFoundAllocError use ESMF , only : ESMF_LogMsg_Info, ESMF_LogWrite use ESMF , only : ESMF_END_ABORT, ESMF_Finalize + use ESMF , only : ESMF_StateIsCreated use NUOPC , only : NUOPC_AddNamespace, NUOPC_Advertise, NUOPC_AddNestedState use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_CompAttributeSet, NUOPC_CompAttributeAdd @@ -830,6 +831,14 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) nestedState=is_local%wrap%NStateExp(compwav), rc=rc) ! Only create nested states for active ice sheets + call NUOPC_CompAttributeGet(gcomp, name='num_icesheets', value=cvalue, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) num_icesheets + else + num_icesheets = 0 + end if do ns = 1,num_icesheets write(cnum,'(i0)') ns call NUOPC_AddNestedState(importState, CplSet="GLC"//trim(cnum), & @@ -1016,39 +1025,44 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) do ncomp = 1,ncomps if (ncomp /= compmed) then if (mastertask) write(logunit,*) - nflds = med_fldList_GetNumFlds(fldListFr(ncomp)) - do n = 1,nflds - call med_fldList_GetFldInfo(fldListFr(ncomp), n, stdname, shortname) - if (mastertask) then - write(logunit,'(a)') trim(subname)//':Fr_'//trim(compname(ncomp))//': '//trim(shortname) - end if - if (trim(shortname) == is_local%wrap%flds_scalar_name) then - transferOffer = 'will provide' - else - transferOffer = 'cannot provide' - end if - 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) - end do - - nflds = med_fldList_GetNumFlds(fldListTo(ncomp)) - do n = 1,nflds - call med_fldList_GetFldInfo(fldListTo(ncomp), n, stdname, shortname) - if (mastertask) then - write(logunit,'(a)') trim(subname)//':To_'//trim(compname(ncomp))//': '//trim(shortname) - end if - if (trim(shortname) == is_local%wrap%flds_scalar_name) then - transferOffer = 'will provide' - else - transferOffer = 'cannot provide' - end if - 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) - end do + if (ESMF_StateIsCreated(is_local%wrap%NStateImp(ncomp))) then + nflds = med_fldList_GetNumFlds(fldListFr(ncomp)) + do n = 1,nflds + call med_fldList_GetFldInfo(fldListFr(ncomp), n, stdname, shortname) + if (mastertask) then + write(logunit,'(a)') trim(subname)//':Fr_'//trim(compname(ncomp))//': '//trim(shortname) + end if + if (trim(shortname) == is_local%wrap%flds_scalar_name) then + transferOffer = 'will provide' + else + transferOffer = 'cannot provide' + end if + 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) + end do + end if + if (ESMF_StateIsCreated(is_local%wrap%NStateExp(ncomp))) then + nflds = med_fldList_GetNumFlds(fldListTo(ncomp)) + do n = 1,nflds + call med_fldList_GetFldInfo(fldListTo(ncomp), n, stdname, shortname) + if (mastertask) then + write(logunit,'(a)') trim(subname)//':To_'//trim(compname(ncomp))//': '//trim(shortname) + end if + if (trim(shortname) == is_local%wrap%flds_scalar_name) then + transferOffer = 'will provide' + else + transferOffer = 'cannot provide' + end if + 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) + end do + end if end if end do ! end of ncomps loop From 1adf5d0b4b68521e43852cd75102f0ff652de5f3 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 25 Apr 2021 21:00:18 -0600 Subject: [PATCH 26/61] updates for prep glc phase --- mediator/med_phases_prep_glc_mod.F90 | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/mediator/med_phases_prep_glc_mod.F90 b/mediator/med_phases_prep_glc_mod.F90 index 4c0879a2c..93044dd01 100644 --- a/mediator/med_phases_prep_glc_mod.F90 +++ b/mediator/med_phases_prep_glc_mod.F90 @@ -167,7 +167,7 @@ subroutine med_phases_prep_glc_init(gcomp, rc) ! Initialize prepglc_clock ! ------------------------------- - ! Initialize prepglc_clock from mclock - THIS CALL DOES NOT COPY ALARMS + ! Initialize mediator 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) @@ -605,9 +605,6 @@ subroutine med_phases_prep_glc(gcomp, rc) type(ESMF_Clock) :: med_clock type(ESMF_Time) :: med_currtime type(ESMF_Time) :: prepglc_currtime - type(ESMF_ALARM) :: glc_avg_alarm - character(len=CS) :: glc_avg_period - integer :: glc_cpl_dt integer :: yr_med, mon_med, day_med, sec_med integer :: yr_prepglc, mon_prepglc, day_prepglc, sec_prepglc type(ESMF_Alarm) :: alarm From 215bc3b57058af1910570b7eabea4f61e0a0f8e6 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Fri, 16 Jul 2021 15:06:34 -0600 Subject: [PATCH 27/61] add albedo fields ice->atm --- mediator/esmFldsExchange_nems_mod.F90 | 16 ++++++++++++---- 1 file changed, 12 insertions(+), 4 deletions(-) diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90 index c46635818..f6d88ab46 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -106,10 +106,6 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) end if ! unused fields from ice - but that are needed to be realized by the cice cap - call addfld(fldListFr(compice)%flds, 'Si_avsdf') - call addfld(fldListFr(compice)%flds, 'Si_avsdr') - call addfld(fldListFr(compice)%flds, 'Si_anidf') - call addfld(fldListFr(compice)%flds, 'Si_anidr') call addfld(fldListFr(compice)%flds, 'Faii_evap') call addfld(fldListFr(compice)%flds, 'mean_sw_pen_to_ocn') @@ -145,6 +141,18 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) end do deallocate(flds) + allocate(flds(4)) + flds = (/'avsdr ', 'avsdf ', & + 'anidr ', 'anidf '/) + do n = 1,size(flds) + fldname = 'Si_'//trim(flds(n)) + call addfld(fldListFr(compice)%flds, trim(fldname)) + call addfld(fldListTo(compatm)%flds, trim(fldname)) + call addmap(fldListFr(compice)%flds, trim(fldname), compatm, maptype, 'ifrac', 'unset') + call addmrg(fldListTo(compatm)%flds, trim(fldname), mrg_from=compice, mrg_fld=trim(fldname), mrg_type='copy') + end do + deallocate(flds) + ! to atm: unmerged surface temperatures from ocn call addfld(fldListFr(compocn)%flds, 'So_t') call addfld(fldListTo(compatm)%flds, 'So_t') From ac0ef28f5e8f719be5e04a24b5122c6c5142f596 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Tue, 20 Jul 2021 14:03:14 -0600 Subject: [PATCH 28/61] change order of history options in config * append component name and averaging type to history_n and history_option variables * trailing whitespace cleanup --- mediator/med.F90 | 2 +- mediator/med_phases_history_mod.F90 | 28 ++++++++++++++-------------- mediator/med_phases_prep_atm_mod.F90 | 2 +- mediator/med_phases_prep_ice_mod.F90 | 12 ++++++------ mediator/med_phases_prep_ocn_mod.F90 | 10 +++++----- mediator/med_phases_restart_mod.F90 | 4 ++-- 6 files changed, 29 insertions(+), 29 deletions(-) diff --git a/mediator/med.F90 b/mediator/med.F90 index d649b7060..96e682e74 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -764,7 +764,7 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) use ESMF , only : ESMF_StateIsCreated use ESMF , only : ESMF_LogMsg_Info, ESMF_LogWrite use ESMF , only : ESMF_END_ABORT, ESMF_Finalize - use ESMF , only : ESMF_StateIsCreated + use ESMF , only : ESMF_StateIsCreated use NUOPC , only : NUOPC_AddNamespace, NUOPC_Advertise, NUOPC_AddNestedState use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_CompAttributeSet, NUOPC_CompAttributeAdd diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 49a60c979..ed55c9d31 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -67,7 +67,7 @@ module med_phases_history_mod public :: med_phases_history_write_rof ! inst, avg, aux public :: med_phases_history_write_wav ! inst, avg, aux - ! Private routines + ! Private routines private :: med_phases_history_write_inst_comp ! write instantaneous file for a given component private :: med_phases_history_write_avg_comp ! write averaged file for a given component private :: med_phases_history_write_aux_comp ! write auxiliary file for a given component @@ -228,7 +228,7 @@ subroutine med_phases_history_write_med(gcomp, rc) call med_phases_history_write_inst_comp(gcomp, compmed, & first_time, 'med_phases_history_write_inst_med', rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (first_time) first_time = .false. + if (first_time) first_time = .false. end subroutine med_phases_history_write_med !=============================================================================== @@ -248,7 +248,7 @@ subroutine med_phases_history_write_atm(gcomp, rc) call med_phases_history_write_aux_comp(gcomp, compatm, & first_time, 'med_phases_history_write_aux_atm', rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (first_time) first_time = .false. + if (first_time) first_time = .false. end subroutine med_phases_history_write_atm !=============================================================================== @@ -321,7 +321,7 @@ end subroutine med_phases_history_write_lnd subroutine med_phases_history_write_ocn(gcomp, rc) type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc - logical :: first_time = .true. + logical :: first_time = .true. !--------------------------------------- rc = ESMF_SUCCESS call med_phases_history_write_inst_comp(gcomp, compocn, & @@ -341,7 +341,7 @@ end subroutine med_phases_history_write_ocn subroutine med_phases_history_write_rof(gcomp, rc) type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc - logical :: first_time = .true. + logical :: first_time = .true. !--------------------------------------- rc = ESMF_SUCCESS call med_phases_history_write_inst_comp(gcomp, comprof, & @@ -361,7 +361,7 @@ end subroutine med_phases_history_write_rof subroutine med_phases_history_write_wav(gcomp, rc) type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc - logical :: first_time = .true. + logical :: first_time = .true. !--------------------------------------- rc = ESMF_SUCCESS call med_phases_history_write_inst_comp(gcomp, compwav, & @@ -382,8 +382,8 @@ subroutine med_phases_history_write_inst_comp(gcomp, compid, first_time, subname ! input/output variables type(ESMF_GridComp) , intent(inout) :: gcomp - integer , intent(in) :: compid - logical , intent(in) :: first_time + integer , intent(in) :: compid + logical , intent(in) :: first_time character(len=*) , intent(in) :: subname integer , intent(out) :: rc @@ -411,8 +411,8 @@ subroutine med_phases_history_write_inst_comp(gcomp, compid, first_time, subname if (first_time) then ! Determine attribute prefix - write(hist_option_in,'(a)') 'history_inst_option_'//trim(compname(compid)) - write(hist_n_in,'(a)') 'history_inst_n_'//trim(compname(compid)) + 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) @@ -513,8 +513,8 @@ subroutine med_phases_history_write_avg_comp(gcomp, compid, first_time, subname, if (first_time) then ! Determine attribute prefix - write(hist_option_in,'(a)') 'history_avg_option_'//trim(compname(compid)) - write(hist_n_in,'(a)') 'history_avg_n_'//trim(compname(compid)) + 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) @@ -657,7 +657,7 @@ subroutine med_phases_history_write_aux_comp(gcomp, compid, first_time, subname, ! input/output variables type(ESMF_GridComp) , intent(inout) :: gcomp integer , intent(in) :: compid - logical , intent(in) :: first_time + logical , intent(in) :: first_time character(len=*) , intent(in) :: subname integer , intent(out) :: rc @@ -774,7 +774,7 @@ subroutine med_phases_history_write_aux_comp(gcomp, compid, first_time, subname, ! 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' + end if ! end of if auxflds is set to 'all' if (mastertask) then write(logunit,*) diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index e26f3b5f1..c27dd281a 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -193,7 +193,7 @@ subroutine med_phases_prep_atm(gcomp, rc) end if ! Note - the following needs a custom merge since Faoo_fco2_ocn is scaled by (ifrac+ofrac) - ! in the merge to the atm + ! in the merge to the atm if ( FB_FldChk(is_local%wrap%FBExp(compatm) , 'Faoo_fco2_ocn', rc=rc) .and. & FB_FldChk(is_local%wrap%FBImp(compocn,compocn), 'Faoo_fco2_ocn', rc=rc)) then call ESMF_FieldGet(lfield, farrayPtr=dataptr1, rc=rc) diff --git a/mediator/med_phases_prep_ice_mod.F90 b/mediator/med_phases_prep_ice_mod.F90 index 4f12f97ad..5046ed3bf 100644 --- a/mediator/med_phases_prep_ice_mod.F90 +++ b/mediator/med_phases_prep_ice_mod.F90 @@ -29,7 +29,7 @@ subroutine med_phases_prep_ice(gcomp, rc) use ESMF , only : ESMF_FieldBundleGet, ESMF_FieldGet, ESMF_Field use ESMF , only : ESMF_LOGMSG_ERROR, ESMF_FAILURE use ESMF , only : ESMF_StateItem_Flag, ESMF_STATEITEM_NOTFOUND - use ESMF , only : ESMF_VMBroadCast + use ESMF , only : ESMF_VMBroadCast use med_utils_mod , only : chkerr => med_utils_ChkErr use med_methods_mod , only : FB_fldchk => med_methods_FB_FldChk use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose @@ -91,12 +91,12 @@ subroutine med_phases_prep_ice(gcomp, rc) ! Apply precipitation factor from ocean (that scales atm rain and snow to ice) if appropriate if (trim(coupling_mode) == 'cesm' .and. is_local%wrap%flds_scalar_index_precip_factor /= 0) then - ! Note that in med_internal_mod.F90 all is_local%wrap%flds_scalar_index_precip_factor + ! Note that in med_internal_mod.F90 all is_local%wrap%flds_scalar_index_precip_factor ! is initialized to 0. - ! In addition, in med.F90, if this attribute is not present as a mediator component attribute, - ! it is set to 0. + ! In addition, in med.F90, if this attribute is not present as a mediator component attribute, + ! it is set to 0. if (mastertask) then - call ESMF_StateGet(is_local%wrap%NstateImp(compocn), & + call ESMF_StateGet(is_local%wrap%NstateImp(compocn), & itemName=trim(is_local%wrap%flds_scalar_name), field=lfield, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldGet(lfield, farrayPtr=dataptr_scalar_ocn, rc=rc) @@ -111,7 +111,7 @@ subroutine med_phases_prep_ice(gcomp, rc) end if call ESMF_VMBroadCast(is_local%wrap%vm, precip_fact, 1, 0, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - is_local%wrap%flds_scalar_precip_factor = precip_fact(1) + is_local%wrap%flds_scalar_precip_factor = precip_fact(1) if (dbug_flag > 5) then write(cvalue,*) precip_fact(1) call ESMF_LogWrite(trim(subname)//" precip_fact is "//trim(cvalue), ESMF_LOGMSG_INFO) diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index 705d8a595..51724336d 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -438,12 +438,12 @@ subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc) ! Apply precipitation factor from ocean (that scales atm rain and snow back to ocn ) if appropriate if (trim(coupling_mode) == 'cesm' .and. is_local%wrap%flds_scalar_index_precip_factor /= 0) then - ! Note that in med_internal_mod.F90 all is_local%wrap%flds_scalar_index_precip_factor + ! Note that in med_internal_mod.F90 all is_local%wrap%flds_scalar_index_precip_factor ! is initialized to 0. - ! In addition, in med.F90, if this attribute is not present as a mediator component attribute, - ! it is set to 0. + ! In addition, in med.F90, if this attribute is not present as a mediator component attribute, + ! it is set to 0. if (mastertask) then - call ESMF_StateGet(is_local%wrap%NstateImp(compocn), & + call ESMF_StateGet(is_local%wrap%NstateImp(compocn), & itemName=trim(is_local%wrap%flds_scalar_name), field=lfield, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldGet(lfield, farrayPtr=dataptr_scalar_ocn, rc=rc) @@ -458,7 +458,7 @@ subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc) end if call ESMF_VMBroadCast(is_local%wrap%vm, precip_fact, 1, 0, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - is_local%wrap%flds_scalar_precip_factor = precip_fact(1) + is_local%wrap%flds_scalar_precip_factor = precip_fact(1) if (dbug_flag > 5) then write(cvalue,*) precip_fact(1) call ESMF_LogWrite(trim(subname)//" precip_fact is "//trim(cvalue), ESMF_LOGMSG_INFO) diff --git a/mediator/med_phases_restart_mod.F90 b/mediator/med_phases_restart_mod.F90 index 860a5a90a..353d8551c 100644 --- a/mediator/med_phases_restart_mod.F90 +++ b/mediator/med_phases_restart_mod.F90 @@ -9,7 +9,7 @@ module med_phases_restart_mod 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_phases_history_mod, only : num_auxfiles, auxfiles + use med_phases_history_mod, only : num_auxfiles, auxfiles use med_time_mod , only : med_time_AlarmInit use esmFlds , only : ncomps, compname, compocn use perf_mod , only : t_startf, t_stopf @@ -432,7 +432,7 @@ subroutine med_phases_restart_write(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - ! Write auxiliary files accumulation - + ! 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 From 4445e35f62bd59808c49f7e9cc78c2d1cfbd5e31 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Tue, 20 Jul 2021 17:24:12 -0400 Subject: [PATCH 29/61] propagate name changes * change history config variables to match code --- cime_config/namelist_definition_drv.xml | 56 ++++++++++++------------- 1 file changed, 28 insertions(+), 28 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 615228593..40827e598 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -1351,7 +1351,7 @@ - + char time MED_attributes @@ -1363,7 +1363,7 @@ $HIST_OPTION_ATM - + integer time MED_attributes @@ -1374,7 +1374,7 @@ $HIST_N_ATM - + char time MED_attributes @@ -1386,7 +1386,7 @@ $AVGHIST_OPTION_ATM - + integer time MED_attributes @@ -1733,7 +1733,7 @@ - + char time MED_attributes @@ -1745,7 +1745,7 @@ $HIST_OPTION_ICE - + integer time MED_attributes @@ -1756,7 +1756,7 @@ $HIST_N_ICE - + char time MED_attributes @@ -1768,7 +1768,7 @@ $AVGHIST_OPTION_ICE - + integer time MED_attributes @@ -1784,7 +1784,7 @@ - + char time MED_attributes @@ -1796,7 +1796,7 @@ $HIST_OPTION_GLC - + integer time MED_attributes @@ -1807,7 +1807,7 @@ $HIST_N_GLC - + char time MED_attributes @@ -1819,7 +1819,7 @@ $AVGHIST_OPTION_GLC - + integer time MED_attributes @@ -1835,7 +1835,7 @@ - + char time MED_attributes @@ -1847,7 +1847,7 @@ $HIST_OPTION_LND - + integer time MED_attributes @@ -1858,7 +1858,7 @@ $HIST_N_LND - + char time MED_attributes @@ -1870,7 +1870,7 @@ $AVGHIST_OPTION_LND - + integer time MED_attributes @@ -2016,7 +2016,7 @@ - + char time MED_attributes @@ -2028,7 +2028,7 @@ $HIST_OPTION_OCN - + integer time MED_attributes @@ -2039,7 +2039,7 @@ $HIST_N_OCN - + char time MED_attributes @@ -2051,7 +2051,7 @@ $AVGHIST_OPTION_OCN - + integer time MED_attributes @@ -2067,7 +2067,7 @@ - + char time MED_attributes @@ -2079,7 +2079,7 @@ $HIST_OPTION_ROF - + integer time MED_attributes @@ -2090,7 +2090,7 @@ $HIST_N_ROF - + char time MED_attributes @@ -2102,7 +2102,7 @@ $AVGHIST_OPTION_ROF - + integer time MED_attributes @@ -2183,7 +2183,7 @@ - + char time MED_attributes @@ -2195,7 +2195,7 @@ $HIST_OPTION_WAV - + integer time MED_attributes @@ -2206,7 +2206,7 @@ $HIST_N_WAV - + char time MED_attributes @@ -2218,7 +2218,7 @@ $AVGHIST_OPTION_WAV - + integer time MED_attributes From 89c720f93942558a974fa8dafc08e948aafd1dc7 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Wed, 21 Jul 2021 09:14:46 -0400 Subject: [PATCH 30/61] white space and config changes --- cime_config/config_component.xml | 32 ++++++++++++++++++++++++++++ cime_config/config_component_ufs.xml | 9 ++++++++ mediator/med.F90 | 2 -- mediator/med_time_mod.F90 | 2 +- 4 files changed, 42 insertions(+), 3 deletions(-) diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index 2ecd59ca3..95b0c801c 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -2307,6 +2307,38 @@ 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 diff --git a/cime_config/config_component_ufs.xml b/cime_config/config_component_ufs.xml index 7b07db0ab..bb32df7b5 100644 --- a/cime_config/config_component_ufs.xml +++ b/cime_config/config_component_ufs.xml @@ -96,6 +96,15 @@ 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 diff --git a/mediator/med.F90 b/mediator/med.F90 index 96e682e74..ab919717a 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -97,7 +97,6 @@ subroutine SetServices(gcomp, rc) use med_phases_history_mod , only: med_phases_history_write_rof use med_phases_history_mod , only: med_phases_history_write_wav use med_phases_history_mod , only: med_phases_history_write_med - use med_phases_restart_mod , only: med_phases_restart_write use med_phases_prep_atm_mod , only: med_phases_prep_atm use med_phases_prep_ice_mod , only: med_phases_prep_ice @@ -764,7 +763,6 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) use ESMF , only : ESMF_StateIsCreated use ESMF , only : ESMF_LogMsg_Info, ESMF_LogWrite use ESMF , only : ESMF_END_ABORT, ESMF_Finalize - use ESMF , only : ESMF_StateIsCreated use NUOPC , only : NUOPC_AddNamespace, NUOPC_Advertise, NUOPC_AddNestedState use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_CompAttributeSet, NUOPC_CompAttributeAdd diff --git a/mediator/med_time_mod.F90 b/mediator/med_time_mod.F90 index 415f8282c..fbdf51541 100644 --- a/mediator/med_time_mod.F90 +++ b/mediator/med_time_mod.F90 @@ -85,7 +85,7 @@ subroutine med_time_alarmInit( clock, alarm, option, & type(ESMF_Time) :: NextAlarm ! Next restart alarm time type(ESMF_TimeInterval) :: AlarmInterval ! Alarm interval integer :: sec - character(len=*), parameter :: subname = ' (med_time_alarmInit): ' + character(len=*), parameter :: subname = '(med_time_alarmInit): ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS From 3cdfe02debd238cda5e7ec87b7c6b2ef30051872 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Wed, 21 Jul 2021 09:23:23 -0400 Subject: [PATCH 31/61] wrap long line --- mediator/med.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/mediator/med.F90 b/mediator/med.F90 index ab919717a..d1263429d 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -1047,7 +1047,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) @@ -1065,7 +1066,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) From 9b53ff7528dc2cdfc8bef444d6db566219c944d0 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Wed, 21 Jul 2021 19:04:32 -0600 Subject: [PATCH 32/61] make diag_init optional --- mediator/med.F90 | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) diff --git a/mediator/med.F90 b/mediator/med.F90 index d1263429d..893e3f72a 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -1859,6 +1859,7 @@ subroutine DataInitialize(gcomp, rc) type(ESMF_Field) :: field type(ESMF_StateItem_Flag) :: itemType logical :: atCorrectTime, connected + logical :: isPresent, isSet integer :: n1,n2,n,ns integer :: nsrc,ndst integer :: cntn1, cntn2 @@ -2521,11 +2522,17 @@ subroutine DataInitialize(gcomp, rc) !--------------------------------------- ! Initialize mediator water/heat budget diags !--------------------------------------- - 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 + call NUOPC_CompAttributeGet(gcomp, name="do_budgets", 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.') then + 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 + end if + end if !--------------------------------------- ! read mediator restarts From fde3e012a2a0b80cffefde170d5b2e49962c36ca Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 27 Aug 2021 20:21:33 -0600 Subject: [PATCH 33/61] merge to master --- .github/workflows/extbuild.yml | 2 +- .travis.yml | 4 +- cime_config/buildnml | 21 +- cime_config/config_component_cesm.xml | 46 +- cime_config/namelist_definition_drv.xml | 325 +- cime_config/namelist_definition_drv_flds.xml | 16 + cime_config/runseq/gen_runseq.py | 19 +- cime_config/runseq/runseq_general.py | 15 +- cime_config/testdefs/testlist_drv.xml | 267 +- drivers/cime/esm_time_mod.F90 | 6 +- mediator/esmFlds.F90 | 1 + mediator/esmFldsExchange_cesm_mod.F90 | 2873 ++++++++++++------ mediator/fd_cesm.yaml | 4 + mediator/med.F90 | 167 +- mediator/med_diag_mod.F90 | 72 +- mediator/med_internalstate_mod.F90 | 9 +- mediator/med_io_mod.F90 | 2 +- mediator/med_map_mod.F90 | 293 +- mediator/med_phases_aofluxes_mod.F90 | 1369 +++++++-- mediator/med_phases_post_lnd_mod.F90 | 17 +- mediator/med_phases_prep_atm_mod.F90 | 23 +- mediator/med_phases_prep_glc_mod.F90 | 260 +- mediator/med_phases_restart_mod.F90 | 97 +- mediator/med_time_mod.F90 | 23 +- nuopc_cap_share/nuopc_shr_methods.F90 | 12 +- 25 files changed, 3780 insertions(+), 2163 deletions(-) diff --git a/.github/workflows/extbuild.yml b/.github/workflows/extbuild.yml index 69ad954a3..a90bf338d 100644 --- a/.github/workflows/extbuild.yml +++ b/.github/workflows/extbuild.yml @@ -19,7 +19,7 @@ jobs: CXX: mpicxx CPPFLAGS: "-I/usr/include -I/usr/local/include" # Versions of all dependencies can be updated here - ESMF_VERSION: ESMF_8_1_0_beta_snapshot_47 + ESMF_VERSION: ESMF_8_2_0_beta_snapshot_14 PNETCDF_VERSION: pnetcdf-1.12.2 NETCDF_FORTRAN_VERSION: v4.5.2 # PIO version is awkward diff --git a/.travis.yml b/.travis.yml index 0a14a61ba..b81231976 100644 --- a/.travis.yml +++ b/.travis.yml @@ -4,9 +4,9 @@ install: - pip install pylint python: - - '2.7' - - '3.6' + - '3.7' - '3.8' + - '3.9' branches: only: diff --git a/cime_config/buildnml b/cime_config/buildnml index 40868bd27..b6400ab21 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -47,8 +47,27 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): config['bfbflag'] = 'on' if case.get_value('BFBFLAG') else 'off' config['continue_run'] = '.true.' if case.get_value('CONTINUE_RUN') else '.false.' config['flux_epbal'] = 'ocn' if case.get_value('CPL_EPBAL') == 'ocn' else 'off' - config['atm_grid'] = case.get_value('ATM_GRID') config['mask_grid'] = case.get_value('MASK_GRID') + config['rest_option'] = case.get_value('REST_OPTION') + + atm_grid = case.get_value('ATM_GRID') + lnd_grid = case.get_value('LND_GRID') + ice_grid = case.get_value('ICE_GRID') + ocn_grid = case.get_value('OCN_GRID') + rof_grid = case.get_value('ROF_GRID') + wav_grid = case.get_value('WAV_GRID') + #pylint: disable=unused-variable + glc_grid = case.get_value('GLC_GRID') + + config['atm_grid'] = atm_grid + config['lnd_grid'] = lnd_grid + config['ice_grid'] = ice_grid + config['ocn_grid'] = ocn_grid + config['samegrid_atm_lnd'] = 'true' if atm_grid == lnd_grid else 'false' + config['samegrid_atm_ice'] = 'true' if atm_grid == ice_grid else 'false' + config['samegrid_atm_ocn'] = 'true' if atm_grid == ocn_grid else 'false' + config['samegrid_atm_wav'] = 'true' if atm_grid == wav_grid else 'false' + config['samegrid_lnd_rof'] = 'true' if lnd_grid == rof_grid else 'false' # determine if need to set atm_domainfile scol_lon = float(case.get_value('PTS_LON')) diff --git a/cime_config/config_component_cesm.xml b/cime_config/config_component_cesm.xml index 8934f2410..d434a5854 100644 --- a/cime_config/config_component_cesm.xml +++ b/cime_config/config_component_cesm.xml @@ -100,20 +100,6 @@ We will not document this further in this guide. - - 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 @@ -201,7 +187,7 @@ 24 24 - + @@ -421,25 +407,29 @@ char - TIGHT,RASM + TIGHT,OPTION1,OPTION2 TIGHT - RASM - RASM - RASM - RASM - RASM - RASM - RASM - RASM + OPTION2 + OPTION2 + OPTION1 + OPTION1 + OPTION1 + OPTION2 + OPTION2 + OPTION2 run_coupling env_run.xml - RASM runs prep ocean before the ocean coupling reducing - most of the lags and field inconsistency but still allowing the ocean to run - concurrently with the ice and atmosphere. - TIGHT are consistent with the old variables ocean_tight_coupling = true in the driver. + OPTION1 (like RASM_OPTION1 in CPL7) runs prep_ocn_avg, + BEFORE the aoflux and ocnalb calculations, thereby reducing + most of the lags and field inconsistency but still allowing the + ocean to run concurrently with the ice and atmosphere. + OPTION2 (like CESM1_MOD in CPL7) runs prep_ocn_avg, + AFTER the aoflux and ocnalb calculations, thereby permitting maximum + concurrency + TIGHT (like CESM1_MOD_TIGHT), is a tight coupling run sequence diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 40827e598..c31ac0a11 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -359,6 +359,16 @@ + + logical + nuopc + ALLCOMP_attributes + + .false. + .true. + + + char nuopc @@ -1136,13 +1146,13 @@ char mapping MED_attributes - ocn,atm,exch + ogrid,agrid,xgrid Grid for atm ocn flux calc (untested) default: ocn - ocn + ogrid @@ -2242,251 +2252,100 @@ to 3d cartesian space, map from src->dest, then rotate back .true. + .false. - - char - mapping - abs - MED_attributes - atm to ocn flux mapping file for fluxes - - $ATM2OCN_FMAPNAME - - - - - char - mapping - abs - MED_attributes - - atm to ocn state mapping file for states - - - $ATM2OCN_SMAPNAME - - - - - char - mapping - abs - MED_attributes - - atm to ocn state mapping file for velocity - - - $ATM2OCN_VMAPNAME - - - - - char - mapping - abs - MED_attributes - - ocn to atm mapping file for fluxes - - - $OCN2ATM_FMAPNAME - - - - - char - mapping - abs - MED_attributes - - ocn to atm mapping file for states - - - $OCN2ATM_SMAPNAME - - - - - char - mapping - abs - MED_attributes - - atm to ice flux mapping file for fluxes - - - $ATM2OCN_FMAPNAME - - - - - char - mapping - abs - MED_attributes - - atm to ice state mapping file for states - - - $ATM2OCN_SMAPNAME - - - - - char - mapping - abs - MED_attributes - - atm to ice state mapping file for velocity - - - $ATM2OCN_VMAPNAME - - - - - char - mapping - abs - MED_attributes - - ice to atm mapping file for fluxes - - - $OCN2ATM_FMAPNAME - - - - - char - mapping - abs - MED_attributes - - ice to atm mapping file for states - - - $OCN2ATM_SMAPNAME - - - - + char mapping - abs MED_attributes - - atm to land mapping file for fluxes - + atm to ocn mapping, 'unset' or 'idmap' are normal possible values - $ATM2LND_FMAPNAME + unset + idmap - - + char mapping - abs MED_attributes - - atm to land mapping file for states - + atm to ocn mapping, 'unset' or 'idmap' are normal possible values - $ATM2LND_SMAPNAME + unset + idmap - - + char mapping - abs MED_attributes - - atm to land mapping file for states - + atm to lnd mapping, 'unset' or 'idmap' are normal possible values - $ATM2LND_SMAPNAME + unset + idmap - - + char mapping - abs MED_attributes - - land to atm mapping file for fluxes - + ocn to atm mapping, 'unset' or 'idmap' are normal possible values - $LND2ATM_FMAPNAME + unset + idmap - - + char mapping - abs MED_attributes - - land to atm mapping file for states - + ice to atm mapping, 'unset' or 'idmap' are normal possible values - $LND2ATM_SMAPNAME + unset + idmap - - + char mapping - abs MED_attributes - - lnd to runoff conservative mapping file - + lnd to atm mapping, 'unset' or 'idmap' are normal possible values - $LND2ROF_FMAPNAME + unset + idmap - - + char mapping abs MED_attributes - - runoff to lnd conservative mapping file - + lnd to rof mapping, 'unset' or 'idmap' are normal possible values - $ROF2LND_FMAPNAME + unset + idmap - - + char mapping abs MED_attributes - - runoff to lnd conservative mapping file - + rof to lnd mapping, 'unset' or 'idmap' are normal possible values - $ROF2LND_FMAPNAME + unset + idmap - - + char mapping - abs MED_attributes - - runoff to ocn area overlap conservative mapping file - + atm to wav mapping, 'unset' or 'idmap' are normal possible values - $ROF2OCN_FMAPNAME + unset + idmap @@ -2502,7 +2361,6 @@ $GLC2OCN_LIQ_RMAPNAME - char mapping @@ -2515,7 +2373,6 @@ $GLC2ICE_RMAPNAME - char mapping @@ -2528,21 +2385,19 @@ $GLC2OCN_ICE_RMAPNAME - - + char mapping abs MED_attributes - runoff to ocn nearest neighbor plus smoothing conservative mapping file + runoff to ocn area overlap conservative mapping file - $ROF2OCN_LIQ_RMAPNAME + $ROF2OCN_FMAPNAME - - + char mapping abs @@ -2551,85 +2406,21 @@ runoff to ocn nearest neighbor plus smoothing conservative mapping file - $ROF2OCN_ICE_RMAPNAME - - - - - char - mapping - abs - MED_attributes - - land to glc mapping file for fluxes - - - $LND2GLC_FMAPNAME - - - - char - mapping - abs - MED_attributes - - land to glc mapping file for states - - - $LND2GLC_SMAPNAME - - - - char - mapping - abs - MED_attributes - - glc to land mapping file for fluxes - - - $GLC2LND_FMAPNAME - - - - char - mapping - abs - MED_attributes - - glc to land mapping file for states - - - $GLC2LND_SMAPNAME - - - - - char - mapping - abs - MED_attributes - - atm to wav state mapping file for states - - - $ATM2WAV_SMAPNAME + $ROF2OCN_LIQ_RMAPNAME - - + char mapping abs MED_attributes - atm to wav state mapping file for states + runoff to ocn nearest neighbor plus smoothing conservative mapping file - $ATM2WAV_SMAPNAME + $ROF2OCN_ICE_RMAPNAME - char mapping @@ -2642,7 +2433,6 @@ $OCN2WAV_SMAPNAME - char mapping @@ -2655,7 +2445,6 @@ $ICE2WAV_SMAPNAME - char mapping diff --git a/cime_config/namelist_definition_drv_flds.xml b/cime_config/namelist_definition_drv_flds.xml index cef475978..beceb238c 100644 --- a/cime_config/namelist_definition_drv_flds.xml +++ b/cime_config/namelist_definition_drv_flds.xml @@ -145,4 +145,20 @@ + + + + + + char + ozone_coupling + ozone_coupling_nl + + Frequency of surface ozone field passed from CAM to surface components. + Surface ozone is passed every coupling interval, but this namelist flag + indicates whether the timestep-level values are interpolated from a + coarser temporal resolution. + + + diff --git a/cime_config/runseq/gen_runseq.py b/cime_config/runseq/gen_runseq.py index ab68327ec..5a4d35d91 100644 --- a/cime_config/runseq/gen_runseq.py +++ b/cime_config/runseq/gen_runseq.py @@ -30,9 +30,12 @@ def active_depth(self): else: return -1 - def enter_time_loop(self, coupling_time, active=True, newtime=True): + def enter_time_loop(self, coupling_time, active=True, newtime=True, addextra_atsign=False): if newtime: - self.__outfile.write ("@" + str(coupling_time) + " \n" ) + if addextra_atsign: + self.__outfile.write ("@@" + str(coupling_time) + " \n" ) + else: + self.__outfile.write ("@" + str(coupling_time) + " \n" ) if active: self.__time_loop.append((self.time_loop+1, self.active_depth+1)) else: @@ -42,14 +45,24 @@ def add_action(self, action, if_add): if if_add: self.__outfile.write (" {}\n".format(action)) - def leave_time_loop(self, leave_time, if_write_hist_rest=False ): + def leave_time_loop(self, leave_time, if_write_hist_rest=False, addextra_atsign=False ): if leave_time and self.__time_loop: _, active_depth = self.__time_loop.pop() if if_write_hist_rest or active_depth == 0: +<<<<<<< HEAD self.__outfile.write (" MED med_phases_history_write \n" ) self.__outfile.write (" MED med_phases_restart_write \n" ) self.__outfile.write (" MED med_phases_profile \n" ) self.__outfile.write ("@ \n" ) +======= + self.__outfile.write (" MED med_phases_history_write \n" ) + self.__outfile.write (" MED med_phases_restart_write \n" ) + self.__outfile.write (" MED med_phases_profile \n" ) + if addextra_atsign: + self.__outfile.write ("@@ \n" ) + else: + self.__outfile.write ("@ \n" ) +>>>>>>> master def __exit_sequence(self): while self.__time_loop: diff --git a/cime_config/runseq/runseq_general.py b/cime_config/runseq/runseq_general.py index 6a72d3cff..67a41c412 100644 --- a/cime_config/runseq/runseq_general.py +++ b/cime_config/runseq/runseq_general.py @@ -86,20 +86,29 @@ def gen_runseq(case, coupling_times): runseq.enter_time_loop(ocn_cpl_time, newtime=ocn_outer_loop) #------------------ - runseq.add_action("MED med_phases_prep_ocn_avg" , med_to_ocn and ocn_outer_loop) - runseq.add_action("MED -> OCN :remapMethod=redist" , med_to_ocn and ocn_outer_loop) + if (cpl_seq_option == 'OPTION2'): + runseq.add_action("MED med_phases_prep_ocn_avg" , med_to_ocn and ocn_outer_loop) + runseq.add_action("MED -> OCN :remapMethod=redist" , med_to_ocn and ocn_outer_loop) #------------------ runseq.enter_time_loop(atm_cpl_time, newtime=inner_loop) #------------------ - if (cpl_seq_option == 'RASM'): + if (cpl_seq_option == 'OPTION1' or cpl_seq_option == 'OPTION2'): if cpl_add_aoflux: runseq.add_action("MED med_phases_aofluxes_run" , run_ocn and run_atm and (med_to_ocn or med_to_atm)) runseq.add_action("MED med_phases_prep_ocn_accum" , med_to_ocn) runseq.add_action("MED med_phases_ocnalb_run" , (run_ocn and run_atm and (med_to_ocn or med_to_atm)) and not xcompset) runseq.add_action("MED med_phases_diag_ocn" , run_ocn and diag_mode) + if (cpl_seq_option == 'OPTION1'): + if ocn_cpl_time != atm_cpl_time: + runseq.enter_time_loop(ocn_cpl_time, newtime=inner_loop, addextra_atsign=True) + runseq.add_action("MED med_phases_prep_ocn_avg" , med_to_ocn and ocn_outer_loop) + runseq.add_action("MED -> OCN :remapMethod=redist" , med_to_ocn and ocn_outer_loop) + if ocn_cpl_time != atm_cpl_time: + runseq.leave_time_loop(inner_loop, addextra_atsign=True) + runseq.add_action("MED med_phases_prep_lnd" , med_to_lnd) runseq.add_action("MED -> LND :remapMethod=redist" , med_to_lnd) diff --git a/cime_config/testdefs/testlist_drv.xml b/cime_config/testdefs/testlist_drv.xml index d255baa18..730f4d3a8 100644 --- a/cime_config/testdefs/testlist_drv.xml +++ b/cime_config/testdefs/testlist_drv.xml @@ -7,9 +7,8 @@ - - - + + @@ -17,19 +16,8 @@ - - - - - - - - - - - - - + + @@ -37,19 +25,8 @@ - - - - - - - - - - - - - + + @@ -57,19 +34,8 @@ - - - - - - - - - - - - - + + @@ -77,19 +43,8 @@ - - - - - - - - - - - - - + + @@ -102,19 +57,8 @@ - - - - - - - - - - - - - + + @@ -122,55 +66,31 @@ - - - + + - - - - - - - - - - - - - - - - - - - - - + - - - + + - - + - - - + + @@ -183,9 +103,8 @@ - - - + + @@ -193,9 +112,8 @@ - - - + + @@ -203,34 +121,13 @@ - - - + + - - - - - - - - - - - - - - - - - - - - @@ -238,9 +135,8 @@ - - - + + @@ -248,19 +144,8 @@ - - - - - - - - - - - - - + + @@ -268,45 +153,22 @@ - - - + + - - - - - - - - - - - - - - - - - - - - - - - - + + @@ -314,52 +176,32 @@ - + - + - - - + - + - - - - - - - - - - - - - - - - - - + + - + - - - + - + @@ -369,9 +211,8 @@ - - - + + @@ -379,9 +220,8 @@ - - - + + @@ -389,9 +229,8 @@ - - - + + @@ -399,8 +238,8 @@ - - + + @@ -413,7 +252,7 @@ - + @@ -422,7 +261,7 @@ - + diff --git a/drivers/cime/esm_time_mod.F90 b/drivers/cime/esm_time_mod.F90 index 49c0226bb..40c57b87c 100644 --- a/drivers/cime/esm_time_mod.F90 +++ b/drivers/cime/esm_time_mod.F90 @@ -161,9 +161,9 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert return end if close(unitn) - call ESMF_LogWrite(trim(subname)//" read driver restart from file = "//trim(restart_file), & - ESMF_LOGMSG_ERROR) - + if (mastertask) then + write(logunit,'(a)') trim(subname)//" reading driver restart from file = "//trim(restart_file) + end if call esm_time_read_restart(restart_file, start_ymd, start_tod, curr_ymd, curr_tod, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/mediator/esmFlds.F90 b/mediator/esmFlds.F90 index 70057f340..a2bf9f98b 100644 --- a/mediator/esmFlds.F90 +++ b/mediator/esmFlds.F90 @@ -35,6 +35,7 @@ module esmflds integer, public :: compglc(max_icesheets) = (/compglc1,compglc2/) integer, public :: num_icesheets ! obtained from attribute logical, public :: ocn2glc_coupling ! obtained from attribute + logical, public :: lnd2glc_coupling ! obtained in med.F90 logical, public :: dststatus_print = .false. diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 3b84c7223..92893793c 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -27,25 +27,34 @@ module esmFldsExchange_cesm_mod public :: esmFldsExchange_cesm - character(len=CX) :: atm2ice_fmap='unset', atm2ice_smap='unset', atm2ice_vmap='unset' - character(len=CX) :: atm2ocn_fmap='unset', atm2ocn_smap='unset', atm2ocn_vmap='unset' - character(len=CX) :: atm2lnd_fmap='unset', atm2lnd_smap='unset' - character(len=CX) :: glc2ice_rmap='unset' - character(len=CX) :: glc2ocn_liq_rmap='unset' - character(len=CX) :: glc2ocn_ice_rmap='unset' - character(len=CX) :: ice2atm_fmap='unset', ice2atm_smap='unset' - character(len=CX) :: ocn2atm_fmap='unset', ocn2atm_smap='unset' - character(len=CX) :: lnd2atm_fmap='unset', lnd2atm_smap='unset' - character(len=CX) :: lnd2rof_fmap='unset' - character(len=CX) :: rof2lnd_fmap='unset' - character(len=CX) :: rof2ocn_fmap='unset', rof2ocn_ice_rmap='unset', rof2ocn_liq_rmap='unset' - character(len=CX) :: atm2wav_smap='unset', ice2wav_smap='unset', ocn2wav_smap='unset' - character(len=CX) :: wav2ocn_smap='unset' + ! currently required mapping files + character(len=CX) :: glc2ice_rmap ='unset' + character(len=CX) :: glc2ocn_liq_rmap ='unset' + character(len=CX) :: glc2ocn_ice_rmap ='unset' + character(len=CX) :: rof2ocn_fmap ='unset' + character(len=CX) :: rof2ocn_ice_rmap ='unset' + character(len=CX) :: rof2ocn_liq_rmap ='unset' + character(len=CX) :: wav2ocn_smap ='unset' + character(len=CX) :: ice2wav_smap ='unset' + character(len=CX) :: ocn2wav_smap ='unset' + + ! no mapping files (value is 'idmap' or 'unset') + character(len=CX) :: atm2ice_map='unset' + character(len=CX) :: atm2ocn_map='unset' + character(len=CX) :: atm2lnd_map='unset' + character(len=CX) :: ice2atm_map='unset' + character(len=CX) :: ocn2atm_map='unset' + character(len=CX) :: lnd2atm_map='unset' + character(len=CX) :: lnd2rof_map='unset' + character(len=CX) :: rof2lnd_map='unset' + character(len=CX) :: atm2wav_map='unset' + logical :: mapuv_with_cart3d logical :: flds_i2o_per_cat logical :: flds_co2a logical :: flds_co2b logical :: flds_co2c + logical :: flds_wiso character(*), parameter :: u_FILE_u = & __FILE__ @@ -82,20 +91,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! local variables: type(InternalState) :: is_local integer :: n, ns - logical :: is_lnd, is_glc - character(len=5) :: iso(2) character(len=CL) :: cvalue - character(len=CS) :: name, fldname - character(len=CS), allocatable :: flds(:) - character(len=CS), allocatable :: suffix(:) + character(len=CS) :: name character(len=*) , parameter :: subname=' (esmFldsExchange_cesm) ' !-------------------------------------- rc = ESMF_SUCCESS - iso(1) = ' ' - iso(2) = '_wiso' - !--------------------------------------- ! Get the internal state !--------------------------------------- @@ -109,74 +111,42 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (phase == 'advertise') then ! mapping to atm - call NUOPC_CompAttributeGet(gcomp, name='ice2atm_fmapname', value=ice2atm_fmap, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit, '(a)') trim(subname)//'ice2atm_fmapname = '// trim(ice2atm_fmap) - call NUOPC_CompAttributeGet(gcomp, name='ice2atm_smapname', value=ice2atm_smap, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit, '(a)') trim(subname)//'ice2atm_smapname = '// trim(ice2atm_smap) - call NUOPC_CompAttributeGet(gcomp, name='lnd2atm_fmapname', value=lnd2atm_fmap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='ice2atm_map', value=ice2atm_map, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit, '(a)') trim(subname)//'lnd2atm_fmapname = '// trim(lnd2atm_fmap) - call NUOPC_CompAttributeGet(gcomp, name='ocn2atm_smapname', value=ocn2atm_smap, rc=rc) + if (mastertask) write(logunit, '(a)') trim(subname)//'ice2atm_map = '// trim(ice2atm_map) + call NUOPC_CompAttributeGet(gcomp, name='lnd2atm_map', value=lnd2atm_map, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit, '(a)') trim(subname)//'ocn2atm_smapname = '// trim(ocn2atm_smap) - call NUOPC_CompAttributeGet(gcomp, name='ocn2atm_fmapname', value=ocn2atm_fmap, rc=rc) + if (mastertask) write(logunit, '(a)') trim(subname)//'lnd2atm_map = '// trim(lnd2atm_map) + call NUOPC_CompAttributeGet(gcomp, name='ocn2atm_map', value=ocn2atm_map, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit, '(a)') trim(subname)//'ocn2atm_fmapname = '// trim(ocn2atm_fmap) - call NUOPC_CompAttributeGet(gcomp, name='lnd2atm_smapname', value=lnd2atm_smap, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit, '(a)') trim(subname)//'lnd2atm_smapname = '// trim(lnd2atm_smap) + if (mastertask) write(logunit, '(a)') trim(subname)//'ocn2atm_map = '// trim(ocn2atm_map) ! mapping to lnd - call NUOPC_CompAttributeGet(gcomp, name='atm2lnd_fmapname', value=atm2lnd_fmap, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit, '(a)') trim(subname)//'atm2lnd_fmapname = '// trim(atm2lnd_fmap) - call NUOPC_CompAttributeGet(gcomp, name='atm2lnd_smapname', value=atm2lnd_smap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='atm2lnd_map', value=atm2lnd_map, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit, '(a)') trim(subname)//'atm2lnd_smapname = '// trim(atm2lnd_smap) - call NUOPC_CompAttributeGet(gcomp, name='rof2lnd_fmapname', value=rof2lnd_fmap, rc=rc) + if (mastertask) write(logunit, '(a)') trim(subname)//'atm2lnd_map = '// trim(atm2lnd_map) + call NUOPC_CompAttributeGet(gcomp, name='rof2lnd_map', value=rof2lnd_map, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit, '(a)') trim(subname)//'rof2lnd_fmapname = '// trim(rof2lnd_fmap) + if (mastertask) write(logunit, '(a)') trim(subname)//'rof2lnd_map = '// trim(rof2lnd_map) ! mapping to ice - call NUOPC_CompAttributeGet(gcomp, name='atm2ice_fmapname', value=atm2ice_fmap, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit, '(a)') trim(subname)//'atm2ice_fmapname = '// trim(atm2ice_fmap) - - call NUOPC_CompAttributeGet(gcomp, name='atm2ice_smapname', value=atm2ice_smap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='atm2ice_map', value=atm2ice_map, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit, '(a)') trim(subname)//'atm2ice_smapname = '// trim(atm2ice_smap) - - call NUOPC_CompAttributeGet(gcomp, name='atm2ice_vmapname', value=atm2ice_vmap, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit, '(a)') trim(subname)//'atm2ice_vmapname = '// trim(atm2ice_vmap) - + if (mastertask) write(logunit, '(a)') trim(subname)//'atm2ice_map = '// trim(atm2ice_map) call NUOPC_CompAttributeGet(gcomp, name='glc2ice_rmapname', value=glc2ice_rmap, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (mastertask) write(logunit, '(a)') trim(subname)//'glc2ice_rmapname = '// trim(glc2ice_rmap) ! mapping to ocn - call NUOPC_CompAttributeGet(gcomp, name='atm2ocn_fmapname', value=atm2ocn_fmap, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit, '(a)') trim(subname)//'atm2ocn_fmapname = '// trim(atm2ocn_fmap) - - call NUOPC_CompAttributeGet(gcomp, name='atm2ocn_smapname', value=atm2ocn_smap, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit, '(a)') trim(subname)//'atm2ocn_smapname = '// trim(atm2ocn_smap) - - call NUOPC_CompAttributeGet(gcomp, name='atm2ocn_vmapname', value=atm2ocn_vmap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='atm2ocn_map', value=atm2ocn_map, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit, '(a)') trim(subname)//'atm2ocn_vmapname = '// trim(atm2ocn_vmap) - + if (mastertask) write(logunit, '(a)') trim(subname)//'atm2ocn_map = '// trim(atm2ocn_map) call NUOPC_CompAttributeGet(gcomp, name='glc2ocn_liq_rmapname', value=glc2ocn_liq_rmap, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (mastertask) write(logunit, '(a)') trim(subname)//'glc2ocn_liq_rmapname = '// trim(glc2ocn_liq_rmap) - call NUOPC_CompAttributeGet(gcomp, name='glc2ocn_ice_rmapname', value=glc2ocn_ice_rmap, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (mastertask) write(logunit, '(a)') trim(subname)//'glc2ocn_ice_rmapname = '// trim(glc2ocn_ice_rmap) - call NUOPC_CompAttributeGet(gcomp, name='wav2ocn_smapname', value=wav2ocn_smap, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (mastertask) write(logunit, '(a)') trim(subname)//'wav2ocn_smapname = '// trim(wav2ocn_smap) @@ -188,20 +158,20 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call NUOPC_CompAttributeGet(gcomp, name='rof2ocn_liq_rmapname', value=rof2ocn_liq_rmap, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (mastertask) write(logunit, '(a)') trim(subname)//'rof2ocn_liq_rmapname = '// trim(rof2ocn_liq_rmap) - call NUOPC_CompAttributeGet(gcomp, name='rof2ocn_ice_rmapname', value=rof2ocn_ice_rmap, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (mastertask) write(logunit, '(a)') trim(subname)//'rof2ocn_ice_rmapname = '// trim(rof2ocn_ice_rmap) ! mapping to rof - call NUOPC_CompAttributeGet(gcomp, name='lnd2rof_fmapname', value=lnd2rof_fmap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='lnd2rof_map', value=lnd2rof_map, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit, '(a)') trim(subname)//'lnd2rof_fmapname = '// trim(lnd2rof_fmap) + if (mastertask) write(logunit, '(a)') trim(subname)//'lnd2rof_map = '// trim(lnd2rof_map) ! mapping to wav - call NUOPC_CompAttributeGet(gcomp, name='atm2wav_smapname', value=atm2wav_smap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='atm2wav_map', value=atm2wav_map, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit,'(a)') trim(subname)//'atm2wav_smapname = '// trim(atm2wav_smap) + if (mastertask) write(logunit,'(a)') trim(subname)//'atm2wav_map = '// trim(atm2wav_map) + call NUOPC_CompAttributeGet(gcomp, name='ice2wav_smapname', value=ice2wav_smap, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (mastertask) write(logunit,'(a)') trim(subname)//'ice2wav_smapname = '// trim(ice2wav_smap) @@ -212,10 +182,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! uv cart3d mapping call NUOPC_CompAttributeGet(gcomp, name='mapuv_with_cart3d', value=cvalue, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit,'(a)') trim(subname)//'mapuv_with_cart3d = '// trim(cvalue) read(cvalue,*) mapuv_with_cart3d - ! co2 transfer between componetns + ! is co2 transfer between components enabled? call NUOPC_CompAttributeGet(gcomp, name='flds_co2a', value=cvalue, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) flds_co2a @@ -236,13 +205,20 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) ocn2glc_coupling + ! are water isotope exchanges enabled? + call NUOPC_CompAttributeGet(gcomp, name='flds_wiso', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) flds_wiso + ! write diagnostic output if (mastertask) then - write(logunit,'(a)') trim(subname)//' flds_co2a = '// trim(cvalue) - write(logunit,'(a)') trim(subname)//' flds_co2b = '// trim(cvalue) - write(logunit,'(a)') trim(subname)//' flds_co2c = '// trim(cvalue) - write(logunit,'(a)') trim(subname)//' flds_i2o_per_cat = '// trim(cvalue) - write(logunit,'(a)') trim(subname)//' ocn2glc_coupling = '// trim(cvalue) + write(logunit,'(a,l7)') trim(subname)//' flds_co2a = ',flds_co2a + write(logunit,'(a,l7)') trim(subname)//' flds_co2b = ',flds_co2b + write(logunit,'(a,l7)') trim(subname)//' flds_co2c = ',flds_co2b + write(logunit,'(a,l7)') trim(subname)//' flds_wiso = ',flds_wiso + write(logunit,'(a,l7)') trim(subname)//' flds_i2o_per_cat = ',flds_i2o_per_cat + write(logunit,'(a,l7)') trim(subname)//' ocn2glc_coupling = ',ocn2glc_coupling + write(logunit,'(a,l7)') trim(subname)//' mapuv_with_cart3d = ',mapuv_with_cart3d end if end if @@ -281,53 +257,50 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! --------------------------------------------------------------------- ! to med: atm and ocn fields required for atm/ocn flux calculation' ! --------------------------------------------------------------------- - if (phase /= 'advertise') then + if (phase == 'advertise') then call addfld(fldListFr(compatm)%flds, 'Sa_u') call addfld(fldListFr(compatm)%flds, 'Sa_v') - if (mapuv_with_cart3d) then - call addmap(fldListFr(compatm)%flds, 'Sa_u' , compocn, mappatch_uv3d, 'one', atm2ocn_vmap) - call addmap(fldListFr(compatm)%flds, 'Sa_v' , compocn, mappatch_uv3d, 'one', atm2ocn_vmap) - else - call addmap(fldListFr(compatm)%flds, 'Sa_u' , compocn, mappatch, 'one', atm2ocn_vmap) - call addmap(fldListFr(compatm)%flds, 'Sa_v' , compocn, mappatch, 'one', atm2ocn_vmap) - end if - call addfld(fldListFr(compatm)%flds, 'Sa_z') - call addmap(fldListFr(compatm)%flds, 'Sa_z' , compocn, mapbilnr, 'one', atm2ocn_smap) - call addfld(fldListFr(compatm)%flds, 'Sa_tbot') - call addmap(fldListFr(compatm)%flds, 'Sa_tbot', compocn, mapbilnr, 'one', atm2ocn_smap) - call addfld(fldListFr(compatm)%flds, 'Sa_pbot') - call addmap(fldListFr(compatm)%flds, 'Sa_pbot', compocn, mapbilnr, 'one', atm2ocn_smap) - call addfld(fldListFr(compatm)%flds, 'Sa_shum') - call addmap(fldListFr(compatm)%flds, 'Sa_shum', compocn, mapbilnr, 'one', atm2ocn_smap) - call addfld(fldListFr(compatm)%flds, 'Sa_ptem') - call addmap(fldListFr(compatm)%flds, 'Sa_ptem', compocn, mapbilnr, 'one', atm2ocn_smap) - call addfld(fldListFr(compatm)%flds, 'Sa_dens') - call addmap(fldListFr(compatm)%flds, 'Sa_dens', compocn, mapbilnr, 'one', atm2ocn_smap) - - if (fldchk(is_local%wrap%FBImp(compatm,compatm), 'Sa_shum_wiso', rc=rc)) then + if (flds_wiso) then call addfld(fldListFr(compatm)%flds, 'Sa_shum_wiso') - call addmap(fldListFr(compatm)%flds, 'Sa_shum_wiso', compocn, mapbilnr, 'one', atm2ocn_smap) + end if + else + if (is_local%wrap%aoflux_grid == 'ogrid') then + if (mapuv_with_cart3d) then + call addmap(fldListFr(compatm)%flds, 'Sa_u' , compocn, mappatch_uv3d, 'one', atm2ocn_map) + call addmap(fldListFr(compatm)%flds, 'Sa_v' , compocn, mappatch_uv3d, 'one', atm2ocn_map) + else + call addmap(fldListFr(compatm)%flds, 'Sa_u' , compocn, mappatch, 'one', atm2ocn_map) + call addmap(fldListFr(compatm)%flds, 'Sa_v' , compocn, mappatch, 'one', atm2ocn_map) + end if + call addmap(fldListFr(compatm)%flds, 'Sa_z' , compocn, mapbilnr, 'one', atm2ocn_map) + call addmap(fldListFr(compatm)%flds, 'Sa_tbot', compocn, mapbilnr, 'one', atm2ocn_map) + call addmap(fldListFr(compatm)%flds, 'Sa_pbot', compocn, mapbilnr, 'one', atm2ocn_map) + call addmap(fldListFr(compatm)%flds, 'Sa_shum', compocn, mapbilnr, 'one', atm2ocn_map) + call addmap(fldListFr(compatm)%flds, 'Sa_ptem', compocn, mapbilnr, 'one', atm2ocn_map) + call addmap(fldListFr(compatm)%flds, 'Sa_dens', compocn, mapbilnr, 'one', atm2ocn_map) + if (fldchk(is_local%wrap%FBImp(compatm,compatm), 'Sa_shum_wiso', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Sa_shum_wiso', compocn, mapbilnr, 'one', atm2ocn_map) + end if end if end if ! --------------------------------------------------------------------- ! to med: swnet fluxes used for budget calculation ! --------------------------------------------------------------------- - ! TODO (mvertens, 2019-01-11): budget implemention needs to be done in CMEPS if (phase == 'advertise') then call addfld(fldListFr(complnd)%flds, 'Fall_swnet') call addfld(fldListFr(compice)%flds, 'Faii_swnet') call addfld(fldListFr(compatm)%flds, 'Faxa_swnet') else if (fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swnet', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_swnet', compice, mapconsf, 'one' , atm2ice_fmap) - call addmap(fldListFr(compatm)%flds, 'Faxa_swnet', compocn, mapconsf, 'one' , atm2ocn_fmap) + call addmap(fldListFr(compatm)%flds, 'Faxa_swnet', compice, mapconsf, 'one' , atm2ice_map) + call addmap(fldListFr(compatm)%flds, 'Faxa_swnet', compocn, mapconsf, 'one' , atm2ocn_map) end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_swnet', rc=rc)) then call addmap(fldListFr(compice)%flds, 'Faii_swnet', compocn, mapfcopy, 'unset', 'unset') @@ -339,53 +312,248 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) !===================================================================== ! --------------------------------------------------------------------- - ! from atm: ! to lnd: height at the lowest model level from atm + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Sa_z') + call addfld(fldListTo(complnd)%flds, 'Sa_z') + else + if ( fldchk(is_local%wrap%FBexp(complnd) , 'Sa_z', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_z', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Sa_z', complnd, mapbilnr, 'one', atm2lnd_map) + call addmrg(fldListTo(complnd)%flds, 'Sa_z', mrg_from=compatm, mrg_fld='Sa_z', mrg_type='copy') + end if + end if + ! --------------------------------------------------------------------- ! to lnd: surface height from atm + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Sa_topo') + call addfld(fldListTo(complnd)%flds, 'Sa_topo') + else + if ( fldchk(is_local%wrap%FBexp(complnd) , 'Sa_topo', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_topo', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Sa_topo', complnd, mapbilnr, 'one', atm2lnd_map) + call addmrg(fldListTo(complnd)%flds, 'Sa_topo', mrg_from=compatm, mrg_fld='Sa_topo', mrg_type='copy') + end if + end if + ! --------------------------------------------------------------------- ! to lnd: zonal wind at the lowest model level from atm ! to lnd: meridional wind at the lowest model level from atm - ! to lnd: Temperature at the lowest model level from atm + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Sa_u') + call addfld(fldListTo(complnd)%flds, 'Sa_u') + else + if ( fldchk(is_local%wrap%FBexp(complnd) , 'Sa_u', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_u', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Sa_u', complnd, mapbilnr, 'one', atm2lnd_map) + call addmrg(fldListTo(complnd)%flds, 'Sa_u', mrg_from=compatm, mrg_fld='Sa_u', mrg_type='copy') + end if + end if + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Sa_v') + call addfld(fldListTo(complnd)%flds, 'Sa_v') + else + if ( fldchk(is_local%wrap%FBexp(complnd) , 'Sa_v', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_v', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Sa_v', complnd, mapbilnr, 'one', atm2lnd_map) + call addmrg(fldListTo(complnd)%flds, 'Sa_v', mrg_from=compatm, mrg_fld='Sa_v', mrg_type='copy') + end if + end if + ! --------------------------------------------------------------------- + ! to lnd: pressure at the lowest model level from atm + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Sa_pbot') + call addfld(fldListTo(complnd)%flds, 'Sa_pbot') + else + if ( fldchk(is_local%wrap%FBexp(complnd) , 'Sa_pbot', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_pbot', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Sa_pbot', complnd, mapbilnr, 'one', atm2lnd_map) + call addmrg(fldListTo(complnd)%flds, 'Sa_pbot', mrg_from=compatm, mrg_fld='Sa_pbot', mrg_type='copy') + end if + end if + ! --------------------------------------------------------------------- + ! to lnd: o3 at the lowest model level from atm + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Sa_o3') + call addfld(fldListTo(complnd)%flds, 'Sa_o3') + else + if ( fldchk(is_local%wrap%FBexp(complnd) , 'Sa_o3', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_o3', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Sa_o3', complnd, mapbilnr, 'one', atm2lnd_map) + call addmrg(fldListTo(complnd)%flds, 'Sa_o3', mrg_from=compatm, mrg_fld='Sa_o3', mrg_type='copy') + end if + end if + ! --------------------------------------------------------------------- + ! to lnd: temperature at the lowest model level from atm + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Sa_tbot') + call addfld(fldListTo(complnd)%flds, 'Sa_tbot') + else + if ( fldchk(is_local%wrap%FBexp(complnd) , 'Sa_tbot', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_tbot', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Sa_tbot', complnd, mapbilnr, 'one', atm2lnd_map) + call addmrg(fldListTo(complnd)%flds, 'Sa_tbot', mrg_from=compatm, mrg_fld='Sa_tbot', mrg_type='copy') + end if + end if + ! --------------------------------------------------------------------- ! to lnd: potential temperature at the lowest model level from atm - ! to lnd: Pressure at the lowest model level from atm + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Sa_ptem') + call addfld(fldListTo(complnd)%flds, 'Sa_ptem') + else + if ( fldchk(is_local%wrap%FBexp(complnd) , 'Sa_ptem', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_ptem', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Sa_ptem', complnd, mapbilnr, 'one', atm2lnd_map) + call addmrg(fldListTo(complnd)%flds, 'Sa_ptem', mrg_from=compatm, mrg_fld='Sa_ptem', mrg_type='copy') + end if + end if + ! --------------------------------------------------------------------- ! to lnd: specific humidity at the lowest model level from atm ! --------------------------------------------------------------------- - - allocate(flds(9)) - flds = (/'Sa_z ',& - 'Sa_topo ',& - 'Sa_u ',& - 'Sa_v ',& - 'Sa_tbot ',& - 'Sa_ptem ',& - 'Sa_pbot ',& - 'Sa_shum ',& - 'Sa_shum_wiso'/) - - do n = 1,size(flds) - fldname = trim(flds(n)) + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Sa_shum') + call addfld(fldListTo(complnd)%flds, 'Sa_shum') + else + if ( fldchk(is_local%wrap%FBexp(complnd) , 'Sa_shum', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_shum', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Sa_shum', complnd, mapbilnr, 'one', atm2lnd_map) + call addmrg(fldListTo(complnd)%flds, 'Sa_shum', mrg_from=compatm, mrg_fld='Sa_shum', mrg_type='copy') + end if + end if + if (flds_wiso) then if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, trim(fldname)) - call addfld(fldListTo(complnd)%flds, trim(fldname)) + call addfld(fldListFr(compatm)%flds, 'Sa_shum_wiso') + call addfld(fldListTo(complnd)%flds, 'Sa_shum_wiso') else - if ( fldchk(is_local%wrap%FBexp(complnd) , trim(fldname), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm ), trim(fldname), rc=rc)) then - call addmap(fldListFr(compatm)%flds, trim(fldname), & - complnd, mapbilnr, 'one', atm2lnd_smap) - call addmrg(fldListTo(complnd)%flds, trim(fldname), & - mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') + if ( fldchk(is_local%wrap%FBexp(complnd) , 'Sa_shum_wiso', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_shum_wiso', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Sa_shum_wiso', complnd, mapbilnr, 'one', atm2lnd_map) + call addmrg(fldListTo(complnd)%flds, 'Sa_shum_wiso', mrg_from=compatm, mrg_fld='Sa_shum_wiso', mrg_type='copy') end if end if - end do - deallocate(flds) - + end if ! --------------------------------------------------------------------- ! to lnd: convective and large scale precipitation rate water equivalent from atm + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Faxa_rainc') + call addfld(fldListTo(complnd)%flds, 'Faxa_rainc') + else + if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_rainc', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_rainc', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_rainc', complnd, mapconsf, 'one', atm2lnd_map) + call addmrg(fldListTo(complnd)%flds, 'Faxa_rainc', mrg_from=compatm, mrg_fld='Faxa_rainc', mrg_type='copy') + end if + end if + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Faxa_rainl') + call addfld(fldListTo(complnd)%flds, 'Faxa_rainl') + else + if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_rainl', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_rainl', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_rainl', complnd, mapconsf, 'one', atm2lnd_map) + call addmrg(fldListTo(complnd)%flds, 'Faxa_rainl', mrg_from=compatm, mrg_fld='Faxa_rainl', mrg_type='copy') + end if + end if + ! --------------------------------------------------------------------- ! to lnd: convective and large-scale (stable) snow rate from atm + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Faxa_snowc') + call addfld(fldListTo(complnd)%flds, 'Faxa_snowc') + else + if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_snowc', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_snowc', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_snowc', complnd, mapconsf, 'one', atm2lnd_map) + call addmrg(fldListTo(complnd)%flds, 'Faxa_snowc', mrg_from=compatm, mrg_fld='Faxa_snowc', mrg_type='copy') + end if + end if + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Faxa_snowl') + call addfld(fldListTo(complnd)%flds, 'Faxa_snowl') + else + if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_snowl', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_snowl', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_snowl', complnd, mapconsf, 'one', atm2lnd_map) + call addmrg(fldListTo(complnd)%flds, 'Faxa_snowl', mrg_from=compatm, mrg_fld='Faxa_snowl', mrg_type='copy') + end if + end if + ! --------------------------------------------------------------------- ! to lnd: downward longwave heat flux from atm + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Faxa_lwdn') + call addfld(fldListTo(complnd)%flds, 'Faxa_lwdn') + else + if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_lwdn', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_lwdn', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_lwdn', complnd, mapconsf, 'one', atm2lnd_map) + call addmrg(fldListTo(complnd)%flds, 'Faxa_lwdn', mrg_from=compatm, mrg_fld='Faxa_lwdn', mrg_type='copy') + end if + end if + ! --------------------------------------------------------------------- ! to lnd: downward direct near-infrared incident solar radiation from atm ! to lnd: downward direct visible incident solar radiation from atm ! to lnd: downward diffuse near-infrared incident solar radiation from atm ! to lnd: downward Diffuse visible incident solar radiation from atm + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Faxa_swndr') + call addfld(fldListTo(complnd)%flds, 'Faxa_swndr') + else + if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_swndr', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_swndr', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_swndr', complnd, mapconsf, 'one', atm2lnd_map) + call addmrg(fldListTo(complnd)%flds, 'Faxa_swndr', mrg_from=compatm, mrg_fld='Faxa_swndr', mrg_type='copy') + end if + end if + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Faxa_swvdr') + call addfld(fldListTo(complnd)%flds, 'Faxa_swvdr') + else + if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_swvdr', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_swvdr', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_swvdr', complnd, mapconsf, 'one', atm2lnd_map) + call addmrg(fldListTo(complnd)%flds, 'Faxa_swvdr', mrg_from=compatm, mrg_fld='Faxa_swvdr', mrg_type='copy') + end if + end if + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Faxa_swndf') + call addfld(fldListTo(complnd)%flds, 'Faxa_swndf') + else + if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_swndf', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_swndf', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_swndf', complnd, mapconsf, 'one', atm2lnd_map) + call addmrg(fldListTo(complnd)%flds, 'Faxa_swndf', mrg_from=compatm, mrg_fld='Faxa_swndf', mrg_type='copy') + end if + end if + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Faxa_swvdf') + call addfld(fldListTo(complnd)%flds, 'Faxa_swvdf') + else + if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_swvdf', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_swvdf', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_swvdf', complnd, mapconsf, 'one', atm2lnd_map) + call addmrg(fldListTo(complnd)%flds, 'Faxa_swvdf', mrg_from=compatm, mrg_fld='Faxa_swvdf', mrg_type='copy') + end if + end if + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Faxa_bcph') + call addfld(fldListTo(complnd)%flds, 'Faxa_bcph') + else + if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_bcph', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_bcph', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_bcph', complnd, mapconsf, 'one', atm2lnd_map) + call addmrg(fldListTo(complnd)%flds, 'Faxa_bcph', mrg_from=compatm, mrg_fld='Faxa_bcph', mrg_type='copy') + end if + end if + ! --------------------------------------------------------------------- ! to lnd: black carbon deposition fluxes from atm ! - hydrophylic black carbon dry deposition flux ! - hydrophobic black carbon dry deposition flux @@ -394,77 +562,126 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! - hydrophylic organic carbon dry deposition flux ! - hydrophobic organic carbon dry deposition flux ! - hydrophylic organic carbon wet deposition flux + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Faxa_ocph') + call addfld(fldListTo(complnd)%flds, 'Faxa_ocph') + else + if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_ocph', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_ocph', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_ocph', complnd, mapconsf, 'one', atm2lnd_map) + call addmrg(fldListTo(complnd)%flds, 'Faxa_ocph', mrg_from=compatm, mrg_fld='Faxa_ocph', mrg_type='copy') + end if + end if + ! --------------------------------------------------------------------- ! to lnd: dust wet deposition flux (sizes 1-4) from atm ! to lnd: dust dry deposition flux (sizes 1-4) from atm + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Faxa_dstwet') + call addfld(fldListTo(complnd)%flds, 'Faxa_dstwet') + else + if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_dstwet', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_dstwet', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_dstwet', complnd, mapconsf, 'one', atm2lnd_map) + call addmrg(fldListTo(complnd)%flds, 'Faxa_dstwet', mrg_from=compatm, mrg_fld='Faxa_dstwet', mrg_type='copy') + end if + end if + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Faxa_dstdry') + call addfld(fldListTo(complnd)%flds, 'Faxa_dstdry') + else + if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_dstdry', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_dstdry', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_dstdry', complnd, mapconsf, 'one', atm2lnd_map) + call addmrg(fldListTo(complnd)%flds, 'Faxa_dstdry', mrg_from=compatm, mrg_fld='Faxa_dstdry', mrg_type='copy') + end if + end if + ! --------------------------------------------------------------------- ! to lnd: nitrogen deposition fields from atm ! --------------------------------------------------------------------- - - ! TODO (mvertens, 2018-12-13): the nitrogen deposition fluxes here - ! are not treated the same was as in cesm2.0 release - ! TODO (mvertens, 2019-03-10): add water isotopes from atm - - allocate(flds(14)) - flds = (/'Faxa_rainc ',& - 'Faxa_rainl ',& - 'Faxa_snowc ',& - 'Faxa_snowl ',& - 'Faxa_lwdn ',& - 'Faxa_swndr ',& - 'Faxa_swvdr ',& - 'Faxa_swndf ',& - 'Faxa_swvdf ',& - 'Faxa_bcph ',& - 'Faxa_ocph ',& - 'Faxa_dstwet',& - 'Faxa_dstdry',& - 'Faxa_ndep ' /) - - do n = 1,size(flds) - fldname = trim(flds(n)) - if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, trim(fldname)) - call addfld(fldListTo(complnd)%flds, trim(fldname)) - else - if (fldchk(is_local%wrap%FBexp(complnd) , trim(fldname), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm ), trim(fldname), rc=rc)) then - call addmap(fldListFr(compatm)%flds, trim(fldname), & - complnd, mapconsf, 'one', atm2lnd_fmap) - call addmrg(fldListTo(complnd)%flds, trim(fldname), & - mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') - end if + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Faxa_ndep') + call addfld(fldListTo(complnd)%flds, 'Faxa_ndep') + else + if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_ndep', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_ndep', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_ndep', complnd, mapconsf, 'one', atm2lnd_map) + call addmrg(fldListTo(complnd)%flds, 'Faxa_ndep', mrg_from=compatm, mrg_fld='Faxa_ndep', mrg_type='copy') end if - end do - deallocate(flds) + end if ! --------------------------------------------------------------------- ! to lnd: river channel total water volume from rof ! to lnd: river channel main channel water volume from rof ! to lnd: river water flux back to land due to flooding ! --------------------------------------------------------------------- - allocate(flds(6)) - flds = (/'Flrr_volr ',& - 'Flrr_volr_wiso ',& - 'Flrr_volrmch ',& - 'Flrr_volrmch_wiso',& - 'Flrr_flood ',& - 'Flrr_flood_wiso '/) + if (phase == 'advertise') then + call addfld(fldListFr(comprof)%flds, 'Flrr_volr') + call addfld(fldListTo(complnd)%flds, 'Flrr_volr') + else + if ( fldchk(is_local%wrap%FBExp(complnd) , 'Flrr_volr', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_volr', rc=rc)) then + call addmap(fldListFr(comprof)%flds, 'Flrr_volr', complnd, mapconsf, 'one', rof2lnd_map) + call addmrg(fldListTo(complnd)%flds, 'Flrr_volr', mrg_from=comprof, mrg_fld='Flrr_volr', mrg_type='copy') + end if + end if + if (phase == 'advertise') then + call addfld(fldListFr(comprof)%flds, 'Flrr_volrmch') + call addfld(fldListTo(complnd)%flds, 'Flrr_volrmch') + else + if ( fldchk(is_local%wrap%FBExp(complnd) , 'Flrr_volrmch', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_volrmch', rc=rc)) then + call addmap(fldListFr(comprof)%flds, 'Flrr_volrmch', complnd, mapconsf, 'one', rof2lnd_map) + call addmrg(fldListTo(complnd)%flds, 'Flrr_volrmch', mrg_from=comprof, mrg_fld='Flrr_volrmch', mrg_type='copy') + end if + end if + if (phase == 'advertise') then + call addfld(fldListFr(comprof)%flds, 'Flrr_flood') + call addfld(fldListTo(complnd)%flds, 'Flrr_flood') + else + if ( fldchk(is_local%wrap%FBExp(complnd) , 'Flrr_flood', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_flood', rc=rc)) then + call addmap(fldListFr(comprof)%flds, 'Flrr_flood', complnd, mapconsf, 'one', rof2lnd_map) + call addmrg(fldListTo(complnd)%flds, 'Flrr_flood', mrg_from=comprof, mrg_fld='Flrr_flood', mrg_type='copy') + end if + end if - do n = 1,size(flds) - fldname = trim(flds(n)) + if (flds_wiso) then + if (phase == 'advertise') then + call addfld(fldListFr(comprof)%flds, 'Flrr_volr_wiso') + call addfld(fldListTo(complnd)%flds, 'Flrr_volr_wiso') + else + if ( fldchk(is_local%wrap%FBExp(complnd) , 'Flrr_volr_wiso', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_volr_wiso', rc=rc)) then + call addmap(fldListFr(comprof)%flds, 'Flrr_volr_wiso', complnd, mapconsf, 'one', rof2lnd_map) + call addmrg(fldListTo(complnd)%flds, 'Flrr_volr_wiso', & + mrg_from=comprof, mrg_fld='Flrr_volr_wiso', mrg_type='copy') + end if + end if + if (phase == 'advertise') then + call addfld(fldListFr(comprof)%flds, 'Flrr_volrmch_wiso') + call addfld(fldListTo(complnd)%flds, 'Flrr_volrmch_wiso') + else + if ( fldchk(is_local%wrap%FBExp(complnd) , 'Flrr_volrmch_wiso', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_volrmch_wiso', rc=rc)) then + call addmap(fldListFr(comprof)%flds, 'Flrr_volrmch_wiso', complnd, mapconsf, 'one', rof2lnd_map) + call addmrg(fldListTo(complnd)%flds, 'Flrr_volrmch_wiso', & + mrg_from=comprof, mrg_fld='Flrr_volrmch_wiso', mrg_type='copy') + end if + end if if (phase == 'advertise') then - call addfld(fldListFr(comprof)%flds, trim(fldname)) - call addfld(fldListTo(complnd)%flds, trim(fldname)) + call addfld(fldListFr(comprof)%flds, 'Flrr_flood_wiso') + call addfld(fldListTo(complnd)%flds, 'Flrr_flood_wiso') else - if ( fldchk(is_local%wrap%FBExp(complnd) , trim(fldname), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(comprof, comprof), trim(fldname), rc=rc)) then - call addmap(fldListFr(comprof)%flds, trim(fldname), & - complnd, mapconsf, 'one', rof2lnd_fmap) - call addmrg(fldListTo(complnd)%flds, trim(fldname), & - mrg_from=comprof, mrg_fld=trim(fldname), mrg_type='copy') + if ( fldchk(is_local%wrap%FBExp(complnd) , 'Flrr_flood_wiso', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_flood_wiso', rc=rc)) then + call addmap(fldListFr(comprof)%flds, 'Flrr_flood_wiso', complnd, mapconsf, 'one', rof2lnd_map) + call addmrg(fldListTo(complnd)%flds, 'Flrr_flood_wiso', & + mrg_from=comprof, mrg_fld='Flrr_flood_wiso', mrg_type='copy') end if end if - end do - deallocate(flds) + end if ! --------------------------------------------------------------------- ! to lnd: ice sheet grid coverage on global grid from glc @@ -530,44 +747,113 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to atm: merged direct albedo (near-infrared radiation) ! to atm: merged diffuse albedo (near-infrared radiation) ! --------------------------------------------------------------------- - allocate(suffix(4)) - suffix = (/'avsdr',& - 'avsdf',& - 'anidr',& - 'anidf'/) + if (phase == 'advertise') then + call addfld(fldListFr(complnd)%flds, 'Sl_avsdr') + call addfld(fldListFr(compice)%flds, 'Si_avsdr') + call addfld(fldListMed_ocnalb%flds , 'So_avsdr') + call addfld(fldListTo(compatm)%flds, 'Sx_avsdr') + else + if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_avsdr', rc=rc)) then + ! Note that for aqua-plant there will be no import from complnd or compice - and the + ! current logic below takes care of this. + if (fldchk(is_local%wrap%FBImp(complnd,complnd), 'Sl_avsdr', rc=rc)) then + call addmap(fldListFr(complnd)%flds, 'Sl_avsdr', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg(fldListTo(compatm)%flds, 'Sx_avsdr', & + mrg_from=complnd, mrg_fld='Sl_avsdr', mrg_type='merge', mrg_fracname='lfrac') + end if + if (fldchk(is_local%wrap%FBImp(compice,compice), 'Si_avsdr', rc=rc)) then + call addmap(fldListFr(compice)%flds, 'Si_avsdr', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg(fldListTo(compatm)%flds, 'Sx_avsdr', & + mrg_from=compice, mrg_fld='Si_avsdr', mrg_type='merge', mrg_fracname='ifrac') + end if + if (fldchk(is_local%wrap%FBMed_ocnalb_a, 'So_avsdr', rc=rc)) then + call addmap(fldListMed_ocnalb%flds , 'So_avsdr', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addmrg(fldListTo(compatm)%flds, 'Sx_avsdr', & + mrg_from=compmed, mrg_fld='So_avsdr', mrg_type='merge', mrg_fracname='ofrac') + end if + end if + end if - do n = 1,size(suffix) - if (phase == 'advertise') then - call addfld(fldListFr(complnd)%flds, 'Sl_'//trim(suffix(n))) - call addfld(fldListFr(compice)%flds, 'Si_'//trim(suffix(n))) - call addfld(fldListMed_ocnalb%flds , 'So_'//trim(suffix(n))) - call addfld(fldListTo(compatm)%flds, 'Sx_'//trim(suffix(n))) - else - if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_'//trim(suffix(n)), rc=rc)) then - ! Note that for aqua-plant there will be no import from complnd or compice - and the - ! current logic below takes care of this. - if (fldchk(is_local%wrap%FBImp(complnd,complnd), 'Sl_'//trim(suffix(n)), rc=rc)) then - call addmap(fldListFr(complnd)%flds, 'Sl_'//trim(suffix(n)), & - compatm, mapconsf, 'lfrin', lnd2atm_smap) - call addmrg(fldListTo(compatm)%flds, 'Sx_'//trim(suffix(n)), & - mrg_from=complnd, mrg_fld='Sl_'//trim(suffix(n)), mrg_type='merge', mrg_fracname='lfrac') - end if - if (fldchk(is_local%wrap%FBImp(compice,compice), 'Si_'//trim(suffix(n)), rc=rc)) then - call addmap(fldListFr(compice)%flds, 'Si_'//trim(suffix(n)), & - compatm, mapconsf, 'ifrac', ice2atm_smap) - call addmrg(fldListTo(compatm)%flds, 'Sx_'//trim(suffix(n)), & - mrg_from=compice, mrg_fld='Si_'//trim(suffix(n)), mrg_type='merge', mrg_fracname='ifrac') - end if - if (fldchk(is_local%wrap%FBMed_ocnalb_a, 'So_'//trim(suffix(n)), rc=rc)) then - call addmap(fldListMed_ocnalb%flds , 'So_'//trim(suffix(n)), & - compatm, mapconsf, 'ofrac', ocn2atm_smap) - call addmrg(fldListTo(compatm)%flds, 'Sx_'//trim(suffix(n)), & - mrg_from=compmed, mrg_fld='So_'//trim(suffix(n)), mrg_type='merge', mrg_fracname='ofrac') - end if + if (phase == 'advertise') then + call addfld(fldListFr(complnd)%flds, 'Sl_avsdf') + call addfld(fldListFr(compice)%flds, 'Si_avsdf') + call addfld(fldListMed_ocnalb%flds , 'So_avsdf') + call addfld(fldListTo(compatm)%flds, 'Sx_avsdf') + else + if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_avsdf', rc=rc)) then + ! Note that for aqua-plant there will be no import from complnd or compice - and the + ! current logic below takes care of this. + if (fldchk(is_local%wrap%FBImp(complnd,complnd), 'Sl_avsdf', rc=rc)) then + call addmap(fldListFr(complnd)%flds, 'Sl_avsdf', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg(fldListTo(compatm)%flds, 'Sx_avsdf', & + mrg_from=complnd, mrg_fld='Sl_avsdf', mrg_type='merge', mrg_fracname='lfrac') + end if + if (fldchk(is_local%wrap%FBImp(compice,compice), 'Si_avsdf', rc=rc)) then + call addmap(fldListFr(compice)%flds, 'Si_avsdf', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg(fldListTo(compatm)%flds, 'Sx_avsdf', & + mrg_from=compice, mrg_fld='Si_avsdf', mrg_type='merge', mrg_fracname='ifrac') + end if + if (fldchk(is_local%wrap%FBMed_ocnalb_a, 'So_avsdf', rc=rc)) then + call addmap(fldListMed_ocnalb%flds , 'So_avsdf', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addmrg(fldListTo(compatm)%flds, 'Sx_avsdf', & + mrg_from=compmed, mrg_fld='So_avsdf', mrg_type='merge', mrg_fracname='ofrac') + end if + end if + end if + + if (phase == 'advertise') then + call addfld(fldListFr(complnd)%flds, 'Sl_anidr') + call addfld(fldListFr(compice)%flds, 'Si_anidr') + call addfld(fldListMed_ocnalb%flds , 'So_anidr') + call addfld(fldListTo(compatm)%flds, 'Sx_anidr') + else + if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_anidr', rc=rc)) then + ! Note that for aqua-plant there will be no import from complnd or compice - and the + ! current logic below takes care of this. + if (fldchk(is_local%wrap%FBImp(complnd,complnd), 'Sl_anidr', rc=rc)) then + call addmap(fldListFr(complnd)%flds, 'Sl_anidr', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg(fldListTo(compatm)%flds, 'Sx_anidr', & + mrg_from=complnd, mrg_fld='Sl_anidr', mrg_type='merge', mrg_fracname='lfrac') + end if + if (fldchk(is_local%wrap%FBImp(compice,compice), 'Si_anidr', rc=rc)) then + call addmap(fldListFr(compice)%flds, 'Si_anidr', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg(fldListTo(compatm)%flds, 'Sx_anidr', & + mrg_from=compice, mrg_fld='Si_anidr', mrg_type='merge', mrg_fracname='ifrac') + end if + if (fldchk(is_local%wrap%FBMed_ocnalb_a, 'So_anidr', rc=rc)) then + call addmap(fldListMed_ocnalb%flds , 'So_anidr', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addmrg(fldListTo(compatm)%flds, 'Sx_anidr', & + mrg_from=compmed, mrg_fld='So_anidr', mrg_type='merge', mrg_fracname='ofrac') + end if + end if + end if + + if (phase == 'advertise') then + call addfld(fldListFr(complnd)%flds, 'Sl_anidf') + call addfld(fldListFr(compice)%flds, 'Si_anidf') + call addfld(fldListMed_ocnalb%flds , 'So_anidf') + call addfld(fldListTo(compatm)%flds, 'Sx_anidf') + else + if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_anidf', rc=rc)) then + ! Note that for aqua-plant there will be no import from complnd or compice - and the + ! current logic below takes care of this. + if (fldchk(is_local%wrap%FBImp(complnd,complnd), 'Sl_anidf', rc=rc)) then + call addmap(fldListFr(complnd)%flds, 'Sl_anidf', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg(fldListTo(compatm)%flds, 'Sx_anidf', & + mrg_from=complnd, mrg_fld='Sl_anidf', mrg_type='merge', mrg_fracname='lfrac') + end if + if (fldchk(is_local%wrap%FBImp(compice,compice), 'Si_anidf', rc=rc)) then + call addmap(fldListFr(compice)%flds, 'Si_anidf', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg(fldListTo(compatm)%flds, 'Sx_anidf', & + mrg_from=compice, mrg_fld='Si_anidf', mrg_type='merge', mrg_fracname='ifrac') + end if + if (fldchk(is_local%wrap%FBMed_ocnalb_a, 'So_anidf', rc=rc)) then + call addmap(fldListMed_ocnalb%flds , 'So_anidf', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addmrg(fldListTo(compatm)%flds, 'Sx_anidf', & + mrg_from=compmed, mrg_fld='So_anidf', mrg_type='merge', mrg_fracname='ofrac') end if end if - end do - deallocate(suffix) + end if ! --------------------------------------------------------------------- ! to atm: merged reference temperature at 2 meters @@ -575,42 +861,233 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to atm: merged reference specific humidity at 2 meters ! to atm: merged reference specific water isoptope humidity at 2 meters ! --------------------------------------------------------------------- - allocate(suffix(4)) - suffix = (/'tref ',& - 'u10 ',& - 'qref ',& - 'qref_wiso'/) - do n = 1,size(suffix) - if (phase == 'advertise') then - call addfld(fldListFr(complnd)%flds , 'Sl_'//trim(suffix(n))) - call addfld(fldListFr(compice)%flds , 'Si_'//trim(suffix(n))) - call addfld(fldListMed_aoflux%flds , 'So_'//trim(suffix(n))) - call addfld(fldListTo(compatm)%flds , 'Sx_'//trim(suffix(n))) - else - if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_'//trim(suffix(n)), rc=rc)) then - if (fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_'//trim(suffix(n)), rc=rc)) then - call addmap(fldListFr(complnd)%flds , 'Sl_'//trim(suffix(n)), compatm, mapconsf, 'lfrin', lnd2atm_fmap) - call addmrg(fldListTo(compatm)%flds , 'Sx_'//trim(suffix(n)), & - mrg_from=complnd, mrg_fld='Sl_'//trim(suffix(n)), mrg_type='merge', mrg_fracname='lfrac') + if (phase == 'advertise') then + call addfld(fldListFr(complnd)%flds , 'Sl_tref') + call addfld(fldListFr(compice)%flds , 'Si_tref') + call addfld(fldListMed_aoflux%flds , 'So_tref') + call addfld(fldListTo(compatm)%flds , 'Sx_tref') + else + if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_tref', rc=rc)) then + if (fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_tref', rc=rc)) then + call addmap(fldListFr(complnd)%flds , 'Sl_tref', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg(fldListTo(compatm)%flds , 'Sx_tref', & + mrg_from=complnd, mrg_fld='Sl_tref', mrg_type='merge', mrg_fracname='lfrac') + end if + if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_tref', rc=rc)) then + call addmap(fldListFr(compice)%flds , 'Si_tref', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg(fldListTo(compatm)%flds , 'Sx_tref', & + mrg_from=compice, mrg_fld='Si_tref', mrg_type='merge', mrg_fracname='ifrac') + end if + if (fldchk(is_local%wrap%FBMed_aoflux_o, 'So_tref', rc=rc)) then + if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then + call addmap(fldListMed_aoflux%flds , 'So_tref', compatm, mapconsf, 'ofrac', ocn2atm_map) end if - if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_'//trim(suffix(n)), rc=rc)) then - call addmap(fldListFr(compice)%flds , 'Si_'//trim(suffix(n)), compatm, mapconsf, 'ifrac', ice2atm_fmap) - call addmrg(fldListTo(compatm)%flds , 'Sx_'//trim(suffix(n)), & - mrg_from=compice, mrg_fld='Si_'//trim(suffix(n)), mrg_type='merge', mrg_fracname='ifrac') + call addmrg(fldListTo(compatm)%flds , 'Sx_tref', & + mrg_from=compmed, mrg_fld='So_tref', mrg_type='merge', mrg_fracname='ofrac') + end if + end if + end if + + if (phase == 'advertise') then + call addfld(fldListFr(complnd)%flds , 'Sl_u10') + call addfld(fldListFr(compice)%flds , 'Si_u10') + call addfld(fldListMed_aoflux%flds , 'So_u10') + call addfld(fldListTo(compatm)%flds , 'Sx_u10') + else + if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_u10', rc=rc)) then + if (fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_u10', rc=rc)) then + call addmap(fldListFr(complnd)%flds , 'Sl_u10', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg(fldListTo(compatm)%flds , 'Sx_u10', & + mrg_from=complnd, mrg_fld='Sl_u10', mrg_type='merge', mrg_fracname='lfrac') + end if + if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_u10', rc=rc)) then + call addmap(fldListFr(compice)%flds , 'Si_u10', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg(fldListTo(compatm)%flds , 'Sx_u10', & + mrg_from=compice, mrg_fld='Si_u10', mrg_type='merge', mrg_fracname='ifrac') + end if + if (fldchk(is_local%wrap%FBMed_aoflux_o, 'So_u10', rc=rc)) then + if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then + call addmap(fldListMed_aoflux%flds, 'So_u10', compatm, mapconsf, 'ofrac', ocn2atm_map) end if - if (fldchk(is_local%wrap%FBMed_aoflux_o, 'So_'//trim(suffix(n)), rc=rc)) then - call addmap(fldListMed_aoflux%flds , 'So_'//trim(suffix(n)), compocn, mapbilnr, 'one' , atm2ocn_fmap) ! map atm->ocn - call addmap(fldListMed_aoflux%flds , 'So_'//trim(suffix(n)), compatm, mapconsf, 'ofrac', ocn2atm_fmap) ! map ocn->atm - call addmrg(fldListTo(compatm)%flds , 'Sx_'//trim(suffix(n)), & - mrg_from=compmed, mrg_fld='So_'//trim(suffix(n)), mrg_type='merge', mrg_fracname='ofrac') + call addmrg(fldListTo(compatm)%flds , 'Sx_u10', & + mrg_from=compmed, mrg_fld='So_u10', mrg_type='merge', mrg_fracname='ofrac') + end if + end if + end if + + if (phase == 'advertise') then + call addfld(fldListFr(complnd)%flds , 'Sl_qref') + call addfld(fldListFr(compice)%flds , 'Si_qref') + call addfld(fldListMed_aoflux%flds , 'So_qref') + call addfld(fldListTo(compatm)%flds , 'Sx_qref') + else + if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_qref', rc=rc)) then + if (fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_qref', rc=rc)) then + call addmap(fldListFr(complnd)%flds , 'Sl_qref', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg(fldListTo(compatm)%flds , 'Sx_qref', & + mrg_from=complnd, mrg_fld='Sl_qref', mrg_type='merge', mrg_fracname='lfrac') + end if + if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_qref', rc=rc)) then + call addmap(fldListFr(compice)%flds , 'Si_qref', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg(fldListTo(compatm)%flds , 'Sx_qref', & + mrg_from=compice, mrg_fld='Si_qref', mrg_type='merge', mrg_fracname='ifrac') + end if + if (fldchk(is_local%wrap%FBMed_aoflux_o, 'So_qref', rc=rc)) then + if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then + call addmap(fldListMed_aoflux%flds, 'So_qref', compatm, mapconsf, 'ofrac', ocn2atm_map) end if + call addmrg(fldListTo(compatm)%flds , 'Sx_qref', & + mrg_from=compmed, mrg_fld='So_qref', mrg_type='merge', mrg_fracname='ofrac') end if end if - end do - deallocate(suffix) + end if - ! --------------------------------------------------------------------- + if (flds_wiso) then + if (phase == 'advertise') then + call addfld(fldListFr(complnd)%flds , 'Sl_qref_wiso') + call addfld(fldListFr(compice)%flds , 'Si_qref_wiso') + call addfld(fldListMed_aoflux%flds , 'So_qref_wiso') + call addfld(fldListTo(compatm)%flds , 'Sx_qref_wiso') + else + if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_qref_wiso', rc=rc)) then + if (fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_qref_wiso', rc=rc)) then + call addmap(fldListFr(complnd)%flds , 'Sl_qref_wiso', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg(fldListTo(compatm)%flds , 'Sx_qref_wiso', & + mrg_from=complnd, mrg_fld='Sl_qref_wiso', mrg_type='merge', mrg_fracname='lfrac') + end if + if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_qref_wiso', rc=rc)) then + call addmap(fldListFr(compice)%flds , 'Si_qref_wiso', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg(fldListTo(compatm)%flds , 'Sx_qref_wiso', & + mrg_from=compice, mrg_fld='Si_qref_wiso', mrg_type='merge', mrg_fracname='ifrac') + end if + if (fldchk(is_local%wrap%FBMed_aoflux_o, 'So_qref_wiso', rc=rc)) then + if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then + call addmap(fldListMed_aoflux%flds , 'So_qref_wiso', compatm, mapconsf, 'ofrac', ocn2atm_map) ! map ocn->atm + end if + call addmrg(fldListTo(compatm)%flds , 'Sx_qref_wiso', & + mrg_from=compmed, mrg_fld='So_qref_wiso', mrg_type='merge', mrg_fracname='ofrac') + end if + end if + end if + end if + + ! --------------------------------------------------------------------- + ! to atm: merged reference temperature at 2 meters + ! to atm: merged 10m wind speed + ! to atm: merged reference specific humidity at 2 meters + ! to atm: merged reference specific water isoptope humidity at 2 meters + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(complnd)%flds , 'Sl_tref') + call addfld(fldListFr(compice)%flds , 'Si_tref') + call addfld(fldListMed_aoflux%flds , 'So_tref') + call addfld(fldListTo(compatm)%flds , 'Sx_tref') + else + if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_tref', rc=rc)) then + if (fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_tref', rc=rc)) then + call addmap(fldListFr(complnd)%flds , 'Sl_tref', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg(fldListTo(compatm)%flds , 'Sx_tref', & + mrg_from=complnd, mrg_fld='Sl_tref', mrg_type='merge', mrg_fracname='lfrac') + end if + if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_tref', rc=rc)) then + call addmap(fldListFr(compice)%flds , 'Si_tref', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg(fldListTo(compatm)%flds , 'Sx_tref', & + mrg_from=compice, mrg_fld='Si_tref', mrg_type='merge', mrg_fracname='ifrac') + end if + if (fldchk(is_local%wrap%FBMed_aoflux_o, 'So_tref', rc=rc)) then + if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then + call addmap(fldListMed_aoflux%flds , 'So_tref', compatm, mapconsf, 'ofrac', ocn2atm_map) + end if + call addmrg(fldListTo(compatm)%flds , 'Sx_tref', & + mrg_from=compmed, mrg_fld='So_tref', mrg_type='merge', mrg_fracname='ofrac') + end if + end if + end if + + if (phase == 'advertise') then + call addfld(fldListFr(complnd)%flds , 'Sl_u10') + call addfld(fldListFr(compice)%flds , 'Si_u10') + call addfld(fldListMed_aoflux%flds , 'So_u10') + call addfld(fldListTo(compatm)%flds , 'Sx_u10') + else + if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_u10', rc=rc)) then + if (fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_u10', rc=rc)) then + call addmap(fldListFr(complnd)%flds , 'Sl_u10', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg(fldListTo(compatm)%flds , 'Sx_u10', & + mrg_from=complnd, mrg_fld='Sl_u10', mrg_type='merge', mrg_fracname='lfrac') + end if + if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_u10', rc=rc)) then + call addmap(fldListFr(compice)%flds , 'Si_u10', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg(fldListTo(compatm)%flds , 'Sx_u10', & + mrg_from=compice, mrg_fld='Si_u10', mrg_type='merge', mrg_fracname='ifrac') + end if + if (fldchk(is_local%wrap%FBMed_aoflux_o, 'So_u10', rc=rc)) then + if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then + call addmap(fldListMed_aoflux%flds, 'So_u10', compatm, mapconsf, 'ofrac', ocn2atm_map) + end if + call addmrg(fldListTo(compatm)%flds , 'Sx_u10', & + mrg_from=compmed, mrg_fld='So_u10', mrg_type='merge', mrg_fracname='ofrac') + end if + end if + end if + + if (phase == 'advertise') then + call addfld(fldListFr(complnd)%flds , 'Sl_qref') + call addfld(fldListFr(compice)%flds , 'Si_qref') + call addfld(fldListMed_aoflux%flds , 'So_qref') + call addfld(fldListTo(compatm)%flds , 'Sx_qref') + else + if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_qref', rc=rc)) then + if (fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_qref', rc=rc)) then + call addmap(fldListFr(complnd)%flds , 'Sl_qref', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg(fldListTo(compatm)%flds , 'Sx_qref', & + mrg_from=complnd, mrg_fld='Sl_qref', mrg_type='merge', mrg_fracname='lfrac') + end if + if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_qref', rc=rc)) then + call addmap(fldListFr(compice)%flds , 'Si_qref', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg(fldListTo(compatm)%flds , 'Sx_qref', & + mrg_from=compice, mrg_fld='Si_qref', mrg_type='merge', mrg_fracname='ifrac') + end if + if (fldchk(is_local%wrap%FBMed_aoflux_o, 'So_qref', rc=rc)) then + if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then + call addmap(fldListMed_aoflux%flds, 'So_qref', compatm, mapconsf, 'ofrac', ocn2atm_map) + end if + call addmrg(fldListTo(compatm)%flds , 'Sx_qref', & + mrg_from=compmed, mrg_fld='So_qref', mrg_type='merge', mrg_fracname='ofrac') + end if + end if + end if + + if (flds_wiso) then + if (phase == 'advertise') then + call addfld(fldListFr(complnd)%flds , 'Sl_qref_wiso') + call addfld(fldListFr(compice)%flds , 'Si_qref_wiso') + call addfld(fldListMed_aoflux%flds , 'So_qref_wiso') + call addfld(fldListTo(compatm)%flds , 'Sx_qref_wiso') + else + if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_qref_wiso', rc=rc)) then + if (fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_qref_wiso', rc=rc)) then + call addmap(fldListFr(complnd)%flds , 'Sl_qref_wiso', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg(fldListTo(compatm)%flds , 'Sx_qref_wiso', & + mrg_from=complnd, mrg_fld='Sl_qref_wiso', mrg_type='merge', mrg_fracname='lfrac') + end if + if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_qref_wiso', rc=rc)) then + call addmap(fldListFr(compice)%flds , 'Si_qref_wiso', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg(fldListTo(compatm)%flds , 'Sx_qref_wiso', & + mrg_from=compice, mrg_fld='Si_qref_wiso', mrg_type='merge', mrg_fracname='ifrac') + end if + if (fldchk(is_local%wrap%FBMed_aoflux_o, 'So_qref_wiso', rc=rc)) then + if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then + call addmap(fldListMed_aoflux%flds, 'So_qref_wiso', compatm, mapconsf, 'ofrac', ocn2atm_map) + end if + call addmrg(fldListTo(compatm)%flds , 'Sx_qref_wiso', & + mrg_from=compmed, mrg_fld='So_qref_wiso', mrg_type='merge', mrg_fracname='ofrac') + end if + end if + end if + end if + ! --------------------------------------------------------------------- ! to atm: merged zonal surface stress ! to atm: merged meridional surface stress ! to atm: merged surface latent heat flux @@ -619,43 +1096,196 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to atm: evaporation water flux from water ! to atm: evaporation water flux from water isotopes ! --------------------------------------------------------------------- - allocate(suffix(7)) - suffix = (/'taux ',& - 'tauy ',& - 'lat ',& - 'sen ',& - 'lwup ',& - 'evap ',& - 'evap_wiso'/) + if (phase == 'advertise') then + call addfld(fldListTo(compatm)%flds, 'Faxx_taux') + call addfld(fldListFr(complnd)%flds, 'Fall_taux') + call addfld(fldListFr(compice)%flds, 'Faii_taux') + call addfld(fldListMed_aoflux%flds , 'Faox_taux') + else + if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_taux', rc=rc)) then + if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_taux', rc=rc)) then + call addmap(fldListFr(complnd)%flds , 'Fall_taux', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg(fldListTo(compatm)%flds , 'Faxx_taux', & + mrg_from=complnd, mrg_fld='Fall_taux', mrg_type='merge', mrg_fracname='lfrac') + end if + if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_taux', rc=rc)) then + call addmap(fldListFr(compice)%flds , 'Faii_taux', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg(fldListTo(compatm)%flds , 'Faxx_taux', & + mrg_from=compice, mrg_fld='Faii_taux', mrg_type='merge', mrg_fracname='ifrac') + end if + if (fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_taux', rc=rc)) then + if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then + call addmap(fldListMed_aoflux%flds , 'Faox_taux', compatm, mapconsf, 'ofrac', ocn2atm_map) + end if + call addmrg(fldListTo(compatm)%flds , 'Faxx_taux', & + mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') + end if + end if + end if + + if (phase == 'advertise') then + call addfld(fldListTo(compatm)%flds, 'Faxx_tauy') + call addfld(fldListFr(complnd)%flds, 'Fall_tauy') + call addfld(fldListFr(compice)%flds, 'Faii_tauy') + call addfld(fldListMed_aoflux%flds , 'Faox_tauy') + else + if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_tauy', rc=rc)) then + if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_tauy', rc=rc)) then + call addmap(fldListFr(complnd)%flds , 'Fall_tauy', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg(fldListTo(compatm)%flds , 'Faxx_tauy', & + mrg_from=complnd, mrg_fld='Fall_tauy', mrg_type='merge', mrg_fracname='lfrac') + end if + if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_tauy', rc=rc)) then + call addmap(fldListFr(compice)%flds , 'Faii_tauy', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg(fldListTo(compatm)%flds , 'Faxx_tauy', & + mrg_from=compice, mrg_fld='Faii_tauy', mrg_type='merge', mrg_fracname='ifrac') + end if + if (fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_tauy', rc=rc)) then + if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then + call addmap(fldListMed_aoflux%flds , 'Faox_tauy', compatm, mapconsf, 'ofrac', ocn2atm_map) + end if + call addmrg(fldListTo(compatm)%flds , 'Faxx_tauy', & + mrg_from=compmed, mrg_fld='Faox_tauy', mrg_type='merge', mrg_fracname='ofrac') + end if + end if + end if + + if (phase == 'advertise') then + call addfld(fldListTo(compatm)%flds, 'Faxx_lat') + call addfld(fldListFr(complnd)%flds, 'Fall_lat') + call addfld(fldListFr(compice)%flds, 'Faii_lat') + call addfld(fldListMed_aoflux%flds , 'Faox_lat') + else + if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_lat', rc=rc)) then + if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_lat', rc=rc)) then + call addmap(fldListFr(complnd)%flds , 'Fall_lat', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg(fldListTo(compatm)%flds , 'Faxx_lat', & + mrg_from=complnd, mrg_fld='Fall_lat', mrg_type='merge', mrg_fracname='lfrac') + end if + if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_lat', rc=rc)) then + call addmap(fldListFr(compice)%flds , 'Faii_lat', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg(fldListTo(compatm)%flds , 'Faxx_lat', & + mrg_from=compice, mrg_fld='Faii_lat', mrg_type='merge', mrg_fracname='ifrac') + end if + if (fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_lat', rc=rc)) then + if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then + call addmap(fldListMed_aoflux%flds , 'Faox_lat', compatm, mapconsf, 'ofrac', ocn2atm_map) + end if + call addmrg(fldListTo(compatm)%flds , 'Faxx_lat', & + mrg_from=compmed, mrg_fld='Faox_lat', mrg_type='merge', mrg_fracname='ofrac') + end if + end if + end if + + if (phase == 'advertise') then + call addfld(fldListTo(compatm)%flds, 'Faxx_sen') + call addfld(fldListFr(complnd)%flds, 'Fall_sen') + call addfld(fldListFr(compice)%flds, 'Faii_sen') + call addfld(fldListMed_aoflux%flds , 'Faox_sen') + else + if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_sen', rc=rc)) then + if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_sen', rc=rc)) then + call addmap(fldListFr(complnd)%flds , 'Fall_sen', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg(fldListTo(compatm)%flds , 'Faxx_sen', & + mrg_from=complnd, mrg_fld='Fall_sen', mrg_type='merge', mrg_fracname='lfrac') + end if + if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_sen', rc=rc)) then + call addmap(fldListFr(compice)%flds , 'Faii_sen', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg(fldListTo(compatm)%flds , 'Faxx_sen', & + mrg_from=compice, mrg_fld='Faii_sen', mrg_type='merge', mrg_fracname='ifrac') + end if + if (fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_sen', rc=rc)) then + if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then + call addmap(fldListMed_aoflux%flds , 'Faox_sen', compatm, mapconsf, 'ofrac', ocn2atm_map) + end if + call addmrg(fldListTo(compatm)%flds , 'Faxx_sen', & + mrg_from=compmed, mrg_fld='Faox_sen', mrg_type='merge', mrg_fracname='ofrac') + end if + end if + end if + + if (phase == 'advertise') then + call addfld(fldListTo(compatm)%flds, 'Faxx_evap') + call addfld(fldListFr(complnd)%flds, 'Fall_evap') + call addfld(fldListFr(compice)%flds, 'Faii_evap') + call addfld(fldListMed_aoflux%flds , 'Faox_evap') + else + if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_evap', rc=rc)) then + if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_evap', rc=rc)) then + call addmap(fldListFr(complnd)%flds , 'Fall_evap', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg(fldListTo(compatm)%flds , 'Faxx_evap', & + mrg_from=complnd, mrg_fld='Fall_evap', mrg_type='merge', mrg_fracname='lfrac') + end if + if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_evap', rc=rc)) then + call addmap(fldListFr(compice)%flds , 'Faii_evap', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg(fldListTo(compatm)%flds , 'Faxx_evap', & + mrg_from=compice, mrg_fld='Faii_evap', mrg_type='merge', mrg_fracname='ifrac') + end if + if (fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_evap', rc=rc)) then + if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then + call addmap(fldListMed_aoflux%flds , 'Faox_evap', compatm, mapconsf, 'ofrac', ocn2atm_map) + end if + call addmrg(fldListTo(compatm)%flds , 'Faxx_evap', & + mrg_from=compmed, mrg_fld='Faox_evap', mrg_type='merge', mrg_fracname='ofrac') + end if + end if + end if + + if (phase == 'advertise') then + call addfld(fldListTo(compatm)%flds, 'Faxx_lwup') + call addfld(fldListFr(complnd)%flds, 'Fall_lwup') + call addfld(fldListFr(compice)%flds, 'Faii_lwup') + call addfld(fldListMed_aoflux%flds , 'Faox_lwup') + else + if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_lwup', rc=rc)) then + if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_lwup', rc=rc)) then + call addmap(fldListFr(complnd)%flds , 'Fall_lwup', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg(fldListTo(compatm)%flds , 'Faxx_lwup', & + mrg_from=complnd, mrg_fld='Fall_lwup', mrg_type='merge', mrg_fracname='lfrac') + end if + if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_lwup', rc=rc)) then + call addmap(fldListFr(compice)%flds , 'Faii_lwup', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg(fldListTo(compatm)%flds , 'Faxx_lwup', & + mrg_from=compice, mrg_fld='Faii_lwup', mrg_type='merge', mrg_fracname='ifrac') + end if + if (fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_lwup', rc=rc)) then + if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then + call addmap(fldListMed_aoflux%flds, 'Faox_lwup', compatm, mapconsf, 'ofrac', ocn2atm_map) + end if + call addmrg(fldListTo(compatm)%flds, 'Faxx_lwup', & + mrg_from=compmed, mrg_fld='Faox_lwup', mrg_type='merge', mrg_fracname='ofrac') + end if + end if + end if - do n = 1,size(suffix) + if (flds_wiso) then if (phase == 'advertise') then - call addfld(fldListTo(compatm)%flds, 'Faxx_'//trim(suffix(n))) - call addfld(fldListFr(complnd)%flds, 'Fall_'//trim(suffix(n))) - call addfld(fldListFr(compice)%flds, 'Faii_'//trim(suffix(n))) - call addfld(fldListMed_aoflux%flds , 'Faox_'//trim(suffix(n))) + call addfld(fldListTo(compatm)%flds, 'Faxx_evap_wiso') + call addfld(fldListFr(complnd)%flds, 'Fall_evap_wiso') + call addfld(fldListFr(compice)%flds, 'Faii_evap_wiso') + call addfld(fldListMed_aoflux%flds , 'Faox_evap_wiso') else - if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_'//trim(suffix(n)), rc=rc)) then - if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_'//trim(suffix(n)), rc=rc)) then - call addmap(fldListFr(complnd)%flds , 'Fall_'//trim(suffix(n)), compatm, mapconsf, 'lfrin', lnd2atm_fmap) - call addmrg(fldListTo(compatm)%flds , 'Faxx_'//trim(suffix(n)), & - mrg_from=complnd, mrg_fld='Fall_'//trim(suffix(n)), mrg_type='merge', mrg_fracname='lfrac') + if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_evap_wiso', rc=rc)) then + if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_evap_wiso', rc=rc)) then + call addmap(fldListFr(complnd)%flds , 'Fall_evap_wiso', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg(fldListTo(compatm)%flds , 'Faxx_evap_wiso', & + mrg_from=complnd, mrg_fld='Fall_evap_wiso', mrg_type='merge', mrg_fracname='lfrac') end if - if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_'//trim(suffix(n)), rc=rc)) then - call addmap(fldListFr(compice)%flds , 'Faii_'//trim(suffix(n)), compatm, mapconsf, 'ifrac', ice2atm_fmap) - call addmrg(fldListTo(compatm)%flds , 'Faxx_'//trim(suffix(n)), & - mrg_from=compice, mrg_fld='Faii_'//trim(suffix(n)), mrg_type='merge', mrg_fracname='ifrac') + if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_evap_wiso', rc=rc)) then + call addmap(fldListFr(compice)%flds , 'Faii_evap_wiso', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg(fldListTo(compatm)%flds , 'Faxx_evap_wiso', & + mrg_from=compice, mrg_fld='Faii_evap_wiso', mrg_type='merge', mrg_fracname='ifrac') end if - if (fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_'//trim(suffix(n)), rc=rc)) then - call addmap(fldListMed_aoflux%flds , 'Faox_'//trim(suffix(n)), compatm, mapconsf, 'ofrac', ocn2atm_fmap) - call addmrg(fldListTo(compatm)%flds , 'Faxx_'//trim(suffix(n)), & - mrg_from=compmed, mrg_fld='Faox_'//trim(suffix(n)), mrg_type='merge', mrg_fracname='ofrac') + if (fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_evap_wiso', rc=rc)) then + if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then + call addmap(fldListMed_aoflux%flds, 'Faox_evap_wiso', compatm, mapconsf, 'ofrac', ocn2atm_map) + end if + call addmrg(fldListTo(compatm)%flds , 'Faxx_evap_wiso', & + mrg_from=compmed, mrg_fld='Faox_evap_wiso', mrg_type='merge', mrg_fracname='ofrac') end if end if end if - end do - deallocate(suffix) - + end if ! --------------------------------------------------------------------- ! to atm: merged surface temperature and unmerged temperatures from ice and ocn ! --------------------------------------------------------------------- @@ -668,24 +1298,23 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if (fldchk(is_local%wrap%FBexp(compatm), 'Sx_t', rc=rc)) then if (fldchk(is_local%wrap%FBImp(complnd,complnd), 'Sl_t', rc=rc)) then - call addmap(fldListFr(complnd)%flds, 'Sl_t', compatm, mapconsf , 'lfrin', lnd2atm_fmap) + call addmap(fldListFr(complnd)%flds, 'Sl_t', compatm, mapconsf , 'lfrin', lnd2atm_map) call addmrg(fldListTo(compatm)%flds, 'Sx_t', & mrg_from=complnd, mrg_fld='Sl_t', mrg_type='merge', mrg_fracname='lfrac') end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Si_t', rc=rc)) then - call addmap(fldListFr(compice)%flds, 'Si_t', compatm, mapconsf , 'ifrac', ice2atm_fmap) + call addmap(fldListFr(compice)%flds, 'Si_t', compatm, mapconsf , 'ifrac', ice2atm_map) call addmrg(fldListTo(compatm)%flds, 'Sx_t', & mrg_from=compice, mrg_fld='Si_t', mrg_type='merge', mrg_fracname='ifrac') end if if (fldchk(is_local%wrap%FBImp(compocn,compocn), 'So_t', rc=rc)) then - call addmap(fldListFr(compocn)%flds, 'So_t', compatm, mapconsf, 'ofrac', ocn2atm_fmap) + call addmap(fldListFr(compocn)%flds, 'So_t', compatm, mapconsf, 'ofrac', ocn2atm_map) call addmrg(fldListTo(compatm)%flds, 'Sx_t', & mrg_from=compocn, mrg_fld='So_t', mrg_type='merge', mrg_fracname='ofrac') end if end if if (fldchk(is_local%wrap%FBexp(compatm), 'So_t', rc=rc)) then - call addmrg(fldListTo(compatm)%flds, 'So_t', & - mrg_from=compocn, mrg_fld='So_t', mrg_type='copy') + call addmrg(fldListTo(compatm)%flds, 'So_t', mrg_from=compocn, mrg_fld='So_t', mrg_type='copy') end if end if @@ -694,158 +1323,179 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to atm: mean ice volume per unit area from ice ! to atm: mean snow volume per unit area from ice ! --------------------------------------------------------------------- - allocate(flds(3)) - flds = (/'Si_snowh',& - 'Si_vice ',& - 'Si_vsno '/) - - do n = 1,size(flds) - fldname = trim(flds(n)) - if (phase == 'advertise') then - call addfld(fldListFr(compice)%flds, trim(fldname)) - call addfld(fldListTo(compatm)%flds, trim(fldname)) - else - if ( fldchk(is_local%wrap%FBexp(compatm) , trim(fldname), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compice,compice), trim(fldname), rc=rc)) then - call addmap(fldListFr(compice)%flds, trim(fldname), & - compatm, mapconsf, 'ifrac', ice2atm_fmap) - call addmrg(fldListTo(compatm)%flds, trim(fldname), & - mrg_from=compice, mrg_fld=trim(fldname), mrg_type='copy') - end if + if (phase == 'advertise') then + call addfld(fldListFr(compice)%flds, 'Si_snowh') + call addfld(fldListTo(compatm)%flds, 'Si_snowh') + else + if ( fldchk(is_local%wrap%FBexp(compatm) , 'Si_snowh', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice), 'Si_snowh', rc=rc)) then + call addmap(fldListFr(compice)%flds, 'Si_snowh', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg(fldListTo(compatm)%flds, 'Si_snowh', mrg_from=compice, mrg_fld='Si_snowh', mrg_type='copy') + end if + end if + if (phase == 'advertise') then + call addfld(fldListFr(compice)%flds, 'Si_vice') + call addfld(fldListTo(compatm)%flds, 'Si_vice') + else + if ( fldchk(is_local%wrap%FBexp(compatm) , 'Si_vice', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice), 'Si_vice', rc=rc)) then + call addmap(fldListFr(compice)%flds, 'Si_vice', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg(fldListTo(compatm)%flds, 'Si_vice', mrg_from=compice, mrg_fld='Si_vice', mrg_type='copy') end if - end do - deallocate(flds) + end if + if (phase == 'advertise') then + call addfld(fldListFr(compice)%flds, 'Si_vsno') + call addfld(fldListTo(compatm)%flds, 'Si_vsno') + else + if ( fldchk(is_local%wrap%FBexp(compatm) , 'Si_vsno', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice), 'Si_vsno', rc=rc)) then + call addmap(fldListFr(compice)%flds, 'Si_vsno', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg(fldListTo(compatm)%flds, 'Si_vsno', mrg_from=compice, mrg_fld='Si_vsno', mrg_type='copy') + end if + end if ! --------------------------------------------------------------------- ! to atm: surface saturation specific humidity in ocean from med aoflux ! to atm: square of exch. coeff (tracers) from med aoflux ! to atm: surface fraction velocity from med aoflux ! --------------------------------------------------------------------- - allocate(flds(3)) - flds = (/'So_ssq ',& - 'So_re ',& - 'So_ustar'/) - - do n = 1,size(flds) - fldname = trim(flds(n)) - if (phase == 'advertise') then - call addfld(fldListMed_aoflux%flds , trim(fldname)) - call addfld(fldListTo(compatm)%flds , trim(fldname)) - else - if ( fldchk(is_local%wrap%FBexp(compatm) , trim(fldname), rc=rc) .and. & - fldchk(is_local%wrap%FBMed_aoflux_o , trim(fldname), rc=rc)) then - call addmap(fldListMed_aoflux%flds , trim(fldname), & - compatm, mapconsf, 'ofrac', ocn2atm_fmap) ! map ocn->atm - call addmrg(fldListTo(compatm)%flds , trim(fldname), & - mrg_from=compmed, mrg_fld=trim(fldname), mrg_type='copy') + if (phase == 'advertise') then + call addfld(fldListMed_aoflux%flds , 'So_ssq') + call addfld(fldListTo(compatm)%flds , 'So_ssq') + else + if ( fldchk(is_local%wrap%FBexp(compatm) , 'So_ssq', rc=rc) .and. & + fldchk(is_local%wrap%FBMed_aoflux_o , 'So_ssq', rc=rc)) then + if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then + call addmap(fldListMed_aoflux%flds , 'So_ssq', compatm, mapconsf, 'ofrac', ocn2atm_map) + end if + call addmrg(fldListTo(compatm)%flds , 'So_ssq', mrg_from=compmed, mrg_fld='So_ssq', mrg_type='copy') + end if + end if + if (phase == 'advertise') then + call addfld(fldListMed_aoflux%flds , 'So_re') + call addfld(fldListTo(compatm)%flds , 'So_re') + else + if ( fldchk(is_local%wrap%FBexp(compatm) , 'So_re', rc=rc) .and. & + fldchk(is_local%wrap%FBMed_aoflux_o , 'So_re', rc=rc)) then + if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then + call addmap(fldListMed_aoflux%flds , 'So_re', compatm, mapconsf, 'ofrac', ocn2atm_map) + end if + call addmrg(fldListTo(compatm)%flds , 'So_re', mrg_from=compmed, mrg_fld='So_re', mrg_type='copy') + end if + end if + if (phase == 'advertise') then + call addfld(fldListMed_aoflux%flds , 'So_ustar') + call addfld(fldListTo(compatm)%flds , 'So_ustar') + else + if ( fldchk(is_local%wrap%FBexp(compatm) , 'So_ustar', rc=rc) .and. & + fldchk(is_local%wrap%FBMed_aoflux_o , 'So_ustar', rc=rc)) then + if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then + call addmap(fldListMed_aoflux%flds , 'So_ustar', compatm, mapconsf, 'ofrac', ocn2atm_map) end if + call addmrg(fldListTo(compatm)%flds , 'So_ustar', mrg_from=compmed, mrg_fld='So_ustar', mrg_type='copy') end if - end do - deallocate(flds) + end if ! --------------------------------------------------------------------- ! to atm: surface fraction velocity from land ! to atm: aerodynamic resistance from land ! to atm: surface snow water equivalent from land ! --------------------------------------------------------------------- - allocate(flds(3)) - flds = (/'Sl_fv ',& - 'Sl_ram1 ',& - 'Sl_snowh'/) - - do n = 1,size(flds) - fldname = trim(flds(n)) - if (phase == 'advertise') then - call addfld(fldListFr(complnd)%flds, trim(fldname)) - call addfld(fldListTo(compatm)%flds, trim(fldname)) - else - if ( fldchk(is_local%wrap%FBexp(compatm) , trim(fldname), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(complnd,complnd ), trim(fldname), rc=rc)) then - call addmap(fldListFr(complnd)%flds, trim(fldname), & - compatm, mapconsf, 'lfrin', lnd2atm_fmap) - call addmrg(fldListTo(compatm)%flds, trim(fldname), & - mrg_from=complnd, mrg_fld=trim(fldname), mrg_type='copy') - end if + if (phase == 'advertise') then + call addfld(fldListFr(complnd)%flds, 'Sl_fv') + call addfld(fldListTo(compatm)%flds, 'Sl_fv') + else + if ( fldchk(is_local%wrap%FBexp(compatm) , 'Sl_fv', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_fv', rc=rc)) then + call addmap(fldListFr(complnd)%flds, 'Sl_fv', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg(fldListTo(compatm)%flds, 'Sl_fv', mrg_from=complnd, mrg_fld='Sl_fv', mrg_type='copy') end if - end do - deallocate(flds) - + end if + if (phase == 'advertise') then + call addfld(fldListFr(complnd)%flds, 'Sl_ram1') + call addfld(fldListTo(compatm)%flds, 'Sl_ram1') + else + if ( fldchk(is_local%wrap%FBexp(compatm) , 'Sl_ram1', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_ram1', rc=rc)) then + call addmap(fldListFr(complnd)%flds, 'Sl_ram1', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg(fldListTo(compatm)%flds, 'Sl_ram1', mrg_from=complnd, mrg_fld='Sl_ram1', mrg_type='copy') + end if + end if + if (phase == 'advertise') then + call addfld(fldListFr(complnd)%flds, 'Sl_snowh') + call addfld(fldListTo(compatm)%flds, 'Sl_snowh') + else + if ( fldchk(is_local%wrap%FBexp(compatm) , 'Sl_snowh', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_snowh', rc=rc)) then + call addmap(fldListFr(complnd)%flds, 'Sl_snowh', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg(fldListTo(compatm)%flds, 'Sl_snowh', mrg_from=complnd, mrg_fld='Sl_snowh', mrg_type='copy') + end if + end if ! --------------------------------------------------------------------- ! to atm: dust fluxes from land (4 sizes) ! --------------------------------------------------------------------- - fldname = 'Fall_flxdst' if (phase == 'advertise') then - call addfld(fldListFr(complnd)%flds, trim(fldname)) - call addfld(fldListTo(compatm)%flds, trim(fldname)) + call addfld(fldListFr(complnd)%flds, 'Fall_flxdst') + call addfld(fldListTo(compatm)%flds, 'Fall_flxdst') else - if ( fldchk(is_local%wrap%FBImp(complnd, complnd), trim(fldname), rc=rc) .and. & - fldchk(is_local%wrap%FBExp(compatm) , trim(fldname), rc=rc)) then - call addmap(fldListFr(complnd)%flds, trim(fldname), compatm, mapconsf, 'lfrin', lnd2atm_fmap) - call addmrg(fldListTo(compatm)%flds, trim(fldname), & - mrg_from=complnd, mrg_fld=trim(fldname), mrg_type='copy_with_weights', mrg_fracname='lfrac') + if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Fall_flxdst', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compatm) , 'Fall_flxdst', rc=rc)) then + call addmap(fldListFr(complnd)%flds, 'Fall_flxdst', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg(fldListTo(compatm)%flds, 'Fall_flxdst', & + mrg_from=complnd, mrg_fld='Fall_flxdst', mrg_type='copy_with_weights', mrg_fracname='lfrac') end if end if - !----------------------------------------------------------------------------- ! to atm: MEGAN emissions fluxes from land !----------------------------------------------------------------------------- - fldname = 'Fall_voc' if (phase == 'advertise') then - call addfld(fldListFr(complnd)%flds, trim(fldname)) - call addfld(fldListTo(compatm)%flds, trim(fldname)) + call addfld(fldListFr(complnd)%flds, 'Fall_voc') + call addfld(fldListTo(compatm)%flds, 'Fall_voc') else - if ( fldchk(is_local%wrap%FBImp(complnd, complnd), trim(fldname), rc=rc) .and. & - fldchk(is_local%wrap%FBExp(compatm) , trim(fldname), rc=rc)) then - call addmap(fldListFr(complnd)%flds, trim(fldname), compatm, mapconsf, 'one', atm2lnd_fmap) - call addmrg(fldListTo(compatm)%flds, trim(fldname), & - mrg_from=complnd, mrg_fld=trim(fldname), mrg_type='merge', mrg_fracname='lfrac') + if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Fall_voc', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compatm) , 'Fall_voc', rc=rc)) then + call addmap(fldListFr(complnd)%flds, 'Fall_voc', compatm, mapconsf, 'one', atm2lnd_map) + call addmrg(fldListTo(compatm)%flds, 'Fall_voc', & + mrg_from=complnd, mrg_fld='Fall_voc', mrg_type='merge', mrg_fracname='lfrac') end if end if - !----------------------------------------------------------------------------- ! to atm: fire emissions fluxes from land !----------------------------------------------------------------------------- ! 'wild fire emission fluxes' - fldname = 'Fall_fire' if (phase == 'advertise') then - call addfld(fldListFr(complnd)%flds, trim(fldname)) - call addfld(fldListTo(compatm)%flds, trim(fldname)) + call addfld(fldListFr(complnd)%flds, 'Fall_fire') + call addfld(fldListTo(compatm)%flds, 'Fall_fire') else - if ( fldchk(is_local%wrap%FBImp(complnd, complnd), trim(fldname), rc=rc) .and. & - fldchk(is_local%wrap%FBExp(compatm) , trim(fldname), rc=rc)) then - call addmap(fldListFr(complnd)%flds, trim(fldname), compatm, mapconsf, 'one', lnd2atm_fmap) - call addmrg(fldListTo(compatm)%flds, trim(fldname), & - mrg_from=complnd, mrg_fld=trim(fldname), mrg_type='merge', mrg_fracname='lfrac') + if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Fall_fire', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compatm) , 'Fall_fire', rc=rc)) then + call addmap(fldListFr(complnd)%flds, 'Fall_fire', compatm, mapconsf, 'one', lnd2atm_map) + call addmrg(fldListTo(compatm)%flds, 'Fall_fire', & + mrg_from=complnd, mrg_fld='Fall_fire', mrg_type='merge', mrg_fracname='lfrac') end if end if - ! 'wild fire plume height' - fldname = 'Sl_fztop' if (phase == 'advertise') then - call addfld(fldListFr(complnd)%flds, trim(fldname)) - call addfld(fldListTo(compatm)%flds, trim(fldname)) + call addfld(fldListFr(complnd)%flds, 'Sl_fztop') + call addfld(fldListTo(compatm)%flds, 'Sl_fztop') else - if ( fldchk(is_local%wrap%FBImp(complnd, complnd), trim(fldname), rc=rc) .and. & - fldchk(is_local%wrap%FBExp(compatm) , trim(fldname), rc=rc)) then - call addmap(fldListFr(complnd)%flds, trim(fldname), compatm, mapconsf, 'one', lnd2atm_smap) - call addmrg(fldListTo(compatm)%flds, trim(fldname), & - mrg_from=complnd, mrg_fld=trim(fldname), mrg_type='copy') + if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Sl_fztop', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compatm) , 'Sl_fztop', rc=rc)) then + call addmap(fldListFr(complnd)%flds, 'Sl_fztop', compatm, mapconsf, 'one', lnd2atm_map) + call addmrg(fldListTo(compatm)%flds, 'Sl_fztop', mrg_from=complnd, mrg_fld='Sl_fztop', mrg_type='copy') end if end if - !----------------------------------------------------------------------------- ! to atm: dry deposition velocities from land !----------------------------------------------------------------------------- - fldname = 'Sl_ddvel' if (phase == 'advertise') then - call addfld(fldListFr(complnd)%flds, trim(fldname)) - call addfld(fldListTo(compatm)%flds, trim(fldname)) + call addfld(fldListFr(complnd)%flds, 'Sl_ddvel') + call addfld(fldListTo(compatm)%flds, 'Sl_ddvel') else - if ( fldchk(is_local%wrap%FBImp(complnd, complnd), trim(fldname), rc=rc) .and. & - fldchk(is_local%wrap%FBExp(compatm) , trim(fldname), rc=rc)) then - call addmap(fldListFr(complnd)%flds, trim(fldname), compatm, mapconsf, 'one', lnd2atm_smap) - call addmrg(fldListTo(compatm)%flds, trim(fldname), & - mrg_from=complnd, mrg_fld=trim(fldname), mrg_type='copy') + if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Sl_ddvel', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compatm) , 'Sl_ddvel', rc=rc)) then + call addmap(fldListFr(complnd)%flds, 'Sl_ddvel', compatm, mapconsf, 'one', lnd2atm_map) + call addmrg(fldListTo(compatm)%flds, 'Sl_ddvel', mrg_from=complnd, mrg_fld='Sl_ddvel', mrg_type='copy') end if end if @@ -871,28 +1521,61 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ocn: downward dirrect visible incident solar radiation from atm ! to ocn: downward diffuse visible incident solar radiation from atm ! --------------------------------------------------------------------- - allocate(flds(5)) - flds = (/'Faxa_lwdn ',& - 'Faxa_swndr',& - 'Faxa_swndf',& - 'Faxa_swvdr',& - 'Faxa_swvdf'/) - - do n = 1,size(flds) - fldname = trim(flds(n)) - if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, trim(fldname)) - call addfld(fldListTo(compocn)%flds, trim(fldname)) - else - if ( fldchk(is_local%wrap%FBExp(compocn) , trim(fldname), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), trim(fldname), rc=rc)) then - call addmap(fldListFr(compatm)%flds, trim(fldname), compocn, mapconsf, 'one', atm2ocn_fmap) - call addmrg(fldListTo(compocn)%flds, trim(fldname), & - mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy_with_weights', mrg_fracname='ofrac') - end if + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Faxa_lwdn') + call addfld(fldListTo(compocn)%flds, 'Faxa_lwdn') + else + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_lwdn', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_lwdn', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_lwdn', compocn, mapconsf, 'one', atm2ocn_map) + call addmrg(fldListTo(compocn)%flds, 'Faxa_lwdn', & + mrg_from=compatm, mrg_fld='Faxa_lwdn', mrg_type='copy_with_weights', mrg_fracname='ofrac') + end if + end if + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Faxa_swndr') + call addfld(fldListTo(compocn)%flds, 'Faxa_swndr') + else + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_swndr', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swndr', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_swndr', compocn, mapconsf, 'one', atm2ocn_map) + call addmrg(fldListTo(compocn)%flds, 'Faxa_swndr', & + mrg_from=compatm, mrg_fld='Faxa_swndr', mrg_type='copy_with_weights', mrg_fracname='ofrac') + end if + end if + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Faxa_swndf') + call addfld(fldListTo(compocn)%flds, 'Faxa_swndf') + else + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_swndf', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swndf', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_swndf', compocn, mapconsf, 'one', atm2ocn_map) + call addmrg(fldListTo(compocn)%flds, 'Faxa_swndf', & + mrg_from=compatm, mrg_fld='Faxa_swndf', mrg_type='copy_with_weights', mrg_fracname='ofrac') + end if + end if + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Faxa_swvdr') + call addfld(fldListTo(compocn)%flds, 'Faxa_swvdr') + else + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_swvdr', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swvdr', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_swvdr', compocn, mapconsf, 'one', atm2ocn_map) + call addmrg(fldListTo(compocn)%flds, 'Faxa_swvdr', & + mrg_from=compatm, mrg_fld='Faxa_swvdr', mrg_type='copy_with_weights', mrg_fracname='ofrac') + end if + end if + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Faxa_swvdf') + call addfld(fldListTo(compocn)%flds, 'Faxa_swvdf') + else + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_swvdf', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swvdf', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_swvdf', compocn, mapconsf, 'one', atm2ocn_map) + call addmrg(fldListTo(compocn)%flds, 'Faxa_swvdf', & + mrg_from=compatm, mrg_fld='Faxa_swvdf', mrg_type='copy_with_weights', mrg_fracname='ofrac') end if - end do - deallocate(flds) + end if ! --------------------------------------------------------------------- ! to ocn: surface upward longwave heat flux from mediator @@ -907,7 +1590,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) mrg_from=compmed, mrg_fld='Faox_lwup', mrg_type='merge', mrg_fracname='ofrac') end if end if - ! --------------------------------------------------------------------- ! to ocn: merged longwave net heat flux ! --------------------------------------------------------------------- @@ -920,14 +1602,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if ( fldchk(is_local%wrap%FBExp(compocn) , 'Foxx_lwnet', rc=rc) .and. & fldchk(is_local%wrap%FBMed_aoflux_o , 'Faox_lwup' , rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_lwdn' , rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_lwdn', compocn, mapconsf, 'one' , atm2ocn_fmap) + call addmap(fldListFr(compatm)%flds, 'Faxa_lwdn', compocn, mapconsf, 'one' , atm2ocn_map) call addmrg(fldListTo(compocn)%flds, 'Foxx_lwnet', & mrg_from=compmed, mrg_fld='Faox_lwup', mrg_type='merge', mrg_fracname='ofrac') call addmrg(fldListTo(compocn)%flds, 'Foxx_lwnet', & mrg_from=compatm, mrg_fld='Faxa_lwdn', mrg_type='merge', mrg_fracname='ofrac') end if end if - ! --------------------------------------------------------------------- ! to ocn: downward shortwave heat flux ! --------------------------------------------------------------------- @@ -937,12 +1618,11 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if (fldchk(is_local%wrap%FBImp(compatm, compatm), 'Faxa_swdn', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_swdn', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_swdn', compocn, mapconsf, 'one', atm2ocn_fmap) + call addmap(fldListFr(compatm)%flds, 'Faxa_swdn', compocn, mapconsf, 'one', atm2ocn_map) call addmrg(fldListTo(compocn)%flds, 'Faxa_swdn', & mrg_from=compatm, mrg_fld='Faxa_swdn', mrg_type='copy') end if end if - ! --------------------------------------------------------------------- ! to ocn: net shortwave radiation from med ! --------------------------------------------------------------------- @@ -992,10 +1672,10 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdf', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idr', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idf', rc=rc))) then - call addmap(fldListFr(compatm)%flds, 'Faxa_swvdr', compocn, mapconsf, 'one', atm2ocn_fmap) - call addmap(fldListFr(compatm)%flds, 'Faxa_swvdf', compocn, mapconsf, 'one', atm2ocn_fmap) - call addmap(fldListFr(compatm)%flds, 'Faxa_swndr', compocn, mapconsf, 'one', atm2ocn_fmap) - call addmap(fldListFr(compatm)%flds, 'Faxa_swndf', compocn, mapconsf, 'one', atm2ocn_fmap) + call addmap(fldListFr(compatm)%flds, 'Faxa_swvdr', compocn, mapconsf, 'one', atm2ocn_map) + call addmap(fldListFr(compatm)%flds, 'Faxa_swvdf', compocn, mapconsf, 'one', atm2ocn_map) + call addmap(fldListFr(compatm)%flds, 'Faxa_swndr', compocn, mapconsf, 'one', atm2ocn_map) + call addmap(fldListFr(compatm)%flds, 'Faxa_swndf', compocn, mapconsf, 'one', atm2ocn_map) end if end if @@ -1041,66 +1721,81 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addfld(fldListFr(compatm)%flds, 'Faxa_rainl') call addfld(fldListFr(compatm)%flds, 'Faxa_rain' ) call addfld(fldListTo(compocn)%flds, 'Faxa_rain' ) - - call addfld(fldListFr(compatm)%flds, 'Faxa_rainc_wiso') - call addfld(fldListFr(compatm)%flds, 'Faxa_rainl_wiso') - call addfld(fldListFr(compatm)%flds, 'Faxa_rain_wiso' ) - call addfld(fldListTo(compocn)%flds, 'Faxa_rain_wiso' ) - call addfld(fldListFr(compatm)%flds, 'Faxa_snowc') call addfld(fldListFr(compatm)%flds, 'Faxa_snowl') call addfld(fldListFr(compatm)%flds, 'Faxa_snow' ) call addfld(fldListTo(compocn)%flds, 'Faxa_snow' ) - - call addfld(fldListFr(compatm)%flds, 'Faxa_snowc_wiso') - call addfld(fldListFr(compatm)%flds, 'Faxa_snowl_wiso') - call addfld(fldListFr(compatm)%flds, 'Faxa_snow_wiso' ) - call addfld(fldListTo(compocn)%flds, 'Faxa_snow_wiso' ) else - do n = 1,2 + ! Note that the mediator atm/ocn flux calculation needs Faxa_rainc for the gustiness parameterization + ! which by default is not actually used + if ( fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainl', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainc', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_rain' , rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_rainl', compocn, mapconsf, 'one', atm2ocn_map) + call addmap(fldListFr(compatm)%flds, 'Faxa_rainc', compocn, mapconsf, 'one', atm2ocn_map) + call addmrg(fldListTo(compocn)%flds, 'Faxa_rain' , mrg_from=compatm, mrg_fld='Faxa_rainc:Faxa_rainl', & + mrg_type='sum_with_weights', mrg_fracname='ofrac') + else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_rain', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rain', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_rain', compocn, mapconsf, 'one', atm2ocn_map) + call addmrg(fldListTo(compocn)%flds, 'Faxa_rain', mrg_from=compatm, mrg_fld='Faxa_rain', mrg_type='copy') + end if + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_snow' , rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowl', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowc', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_snowl', compocn, mapconsf, 'one', atm2ocn_map) + call addmap(fldListFr(compatm)%flds, 'Faxa_snowc', compocn, mapconsf, 'one', atm2ocn_map) + call addmrg(fldListTo(compocn)%flds, 'Faxa_snow' , & + mrg_from=compatm, mrg_fld='Faxa_snowc:Faxa_snowl', mrg_type='sum_with_weights', mrg_fracname='ofrac') + else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_snow', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snow', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_snow', compocn, mapconsf, 'one', atm2ocn_map) + call addmrg(fldListTo(compocn)%flds, 'Faxa_snow', mrg_from=compatm, mrg_fld='Faxa_snow', mrg_type='copy') + end if + end if + + if (flds_wiso) then + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Faxa_rainc_wiso') + call addfld(fldListFr(compatm)%flds, 'Faxa_rainl_wiso') + call addfld(fldListFr(compatm)%flds, 'Faxa_rain_wiso' ) + call addfld(fldListTo(compocn)%flds, 'Faxa_rain_wiso' ) + call addfld(fldListFr(compatm)%flds, 'Faxa_snowc_wiso') + call addfld(fldListFr(compatm)%flds, 'Faxa_snowl_wiso') + call addfld(fldListFr(compatm)%flds, 'Faxa_snow_wiso' ) + call addfld(fldListTo(compocn)%flds, 'Faxa_snow_wiso' ) + else ! Note that the mediator atm/ocn flux calculation needs Faxa_rainc for the gustiness parameterization ! which by default is not actually used - if ( fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainl'//iso(n), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainc'//iso(n), rc=rc) .and. & - fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_rain' //iso(n), rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_rainl'//iso(n), compocn, mapconsf, 'one', atm2ocn_fmap) - call addmap(fldListFr(compatm)%flds, 'Faxa_rainc'//iso(n), compocn, mapconsf, 'one', atm2ocn_fmap) - if (iso(n) == ' ') then - call addmrg(fldListTo(compocn)%flds, 'Faxa_rain'//iso(n) , & - mrg_from=compatm, mrg_fld='Faxa_rainc:Faxa_rainl', & - mrg_type='sum_with_weights', mrg_fracname='ofrac') - else - call addmrg(fldListTo(compocn)%flds, 'Faxa_rain'//iso(n) , & - mrg_from=compatm, mrg_fld=trim('Faxa_rainc'//iso(n))//':'//trim('Faxa_rainl'//iso(n)), & - mrg_type='sum_with_weights', mrg_fracname='ofrac') - end if - else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_rain'//iso(n), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rain'//iso(n), rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_rain'//iso(n), compocn, mapconsf, 'one', atm2ocn_fmap) - call addmrg(fldListTo(compocn)%flds, 'Faxa_rain'//iso(n), & - mrg_from=compatm, mrg_fld='Faxa_rain'//iso(n), mrg_type='copy') - end if - if ( fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_snow' //iso(n), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowl'//iso(n), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowc'//iso(n), rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_snowl'//iso(n), compocn, mapconsf, 'one', atm2ocn_fmap) - call addmap(fldListFr(compatm)%flds, 'Faxa_snowc'//iso(n), compocn, mapconsf, 'one', atm2ocn_fmap) - if (iso(n) == ' ') then - call addmrg(fldListTo(compocn)%flds, 'Faxa_snow' //iso(n) , & - mrg_from=compatm, mrg_fld='Faxa_snowc:Faxa_snowl', & - mrg_type='sum_with_weights', mrg_fracname='ofrac') - else - call addmrg(fldListTo(compocn)%flds, 'Faxa_snow' //iso(n) , & - mrg_from=compatm, mrg_fld=trim('Faxa_snowc'//iso(n))//':'//trim('Faxa_snowl'//iso(n)), & - mrg_type='sum_with_weights', mrg_fracname='ofrac') - end if - else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_snow'//iso(n), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snow'//iso(n), rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_snow'//iso(n), compocn, mapconsf, 'one', atm2ocn_fmap) - call addmrg(fldListTo(compocn)%flds, 'Faxa_snow'//iso(n), & - mrg_from=compatm, mrg_fld='Faxa_snow'//iso(n), mrg_type='copy') + if ( fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainl_wiso', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainc_wiso', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_rain_wiso' , rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_rainl_wiso', compocn, mapconsf, 'one', atm2ocn_map) + call addmap(fldListFr(compatm)%flds, 'Faxa_rainc_wiso', compocn, mapconsf, 'one', atm2ocn_map) + call addmrg(fldListTo(compocn)%flds, 'Faxa_rain_wiso' , & + mrg_from=compatm, mrg_fld=trim('Faxa_rainc_wiso')//':'//trim('Faxa_rainl_wiso'), & + mrg_type='sum_with_weights', mrg_fracname='ofrac') + else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_rain_wiso', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rain_wiso', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_rain_wiso', compocn, mapconsf, 'one', atm2ocn_map) + call addmrg(fldListTo(compocn)%flds, 'Faxa_rain_wiso', & + mrg_from=compatm, mrg_fld='Faxa_rain_wiso', mrg_type='copy') end if - end do + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_snow_wiso', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowl_wiso', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowc_wiso', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_snowl_wiso', compocn, mapconsf, 'one', atm2ocn_map) + call addmap(fldListFr(compatm)%flds, 'Faxa_snowc_wiso', compocn, mapconsf, 'one', atm2ocn_map) + call addmrg(fldListTo(compocn)%flds, 'Faxa_snow_wiso', & + mrg_from=compatm, mrg_fld=trim('Faxa_snowc_wiso')//':'//trim('Faxa_snowl_wiso'), & + mrg_type='sum_with_weights', mrg_fracname='ofrac') + else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_snow_wiso', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snow_wiso', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_snow_wiso', compocn, mapconsf, 'one', atm2ocn_map) + call addmrg(fldListTo(compocn)%flds, 'Faxa_snow_wiso', & + mrg_from=compatm, mrg_fld='Faxa_snow_wiso', mrg_type='copy') + end if + end if end if ! --------------------------------------------------------------------- @@ -1123,49 +1818,46 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ocn: surface latent heat flux and evaporation water flux ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Faxa_lat' ) call addfld(fldListMed_aoflux%flds , 'Faox_lat' ) call addfld(fldListMed_aoflux%flds , 'Faox_evap') call addfld(fldListTo(compocn)%flds, 'Foxx_lat' ) call addfld(fldListTo(compocn)%flds, 'Foxx_evap') else - if ( fldchk(is_local%wrap%FBexp(compocn), 'Foxx_lat', rc=rc) .and. & - fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_lat', rc=rc)) then + if ( fldchk(is_local%wrap%FBexp(compocn), 'Foxx_lat', rc=rc)) then call addmrg(fldListTo(compocn)%flds, 'Foxx_lat', & mrg_from=compmed, mrg_fld='Faox_lat', mrg_type='merge', mrg_fracname='ofrac') end if - if ( fldchk(is_local%wrap%FBExp(compocn), 'Foxx_evap', rc=rc) .and. & - fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_evap', rc=rc)) then + if ( fldchk(is_local%wrap%FBExp(compocn), 'Foxx_evap', rc=rc)) then call addmrg(fldListTo(compocn)%flds, 'Foxx_evap', & mrg_from=compmed, mrg_fld='Faox_evap', mrg_type='merge', mrg_fracname='ofrac') end if end if - if (phase == 'advertise') then - call addfld(fldListMed_aoflux%flds , 'Faox_lat_wiso' ) - call addfld(fldListTo(compocn)%flds, 'Foxx_lat_wiso' ) - else - if ( fldchk(is_local%wrap%FBexp(compocn), 'Foxx_lat_wiso', rc=rc) .and. & - fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_lat_wiso', rc=rc)) then - call addmrg(fldListTo(compocn)%flds, 'Foxx_lat_wiso', & - mrg_from=compmed, mrg_fld='Faox_lat_wiso', mrg_type='merge', mrg_fracname='ofrac') + if (flds_wiso) then + if (phase == 'advertise') then + call addfld(fldListMed_aoflux%flds , 'Faox_lat_wiso' ) + call addfld(fldListTo(compocn)%flds, 'Foxx_lat_wiso' ) + else + if ( fldchk(is_local%wrap%FBexp(compocn), 'Foxx_lat_wiso', rc=rc)) then + call addmrg(fldListTo(compocn)%flds, 'Foxx_lat_wiso', & + mrg_from=compmed, mrg_fld='Faox_lat_wiso', mrg_type='merge', mrg_fracname='ofrac') + end if end if end if ! --------------------------------------------------------------------- ! to ocn: wind speed squared at 10 meters from med ! --------------------------------------------------------------------- + ! Note that this is a field output by the atm/ocn flux computation + ! If the aoflux grid is ogrid - then nothing needs to be done to send to the ocean + ! All other mappings are set in med_phases_aoflux_mod.F90 if (phase == 'advertise') then call addfld(fldListMed_aoflux%flds , 'So_duu10n') call addfld(fldListTo(compocn)%flds, 'So_duu10n') else - if ( fldchk(is_local%wrap%FBMed_aoflux_o, 'So_duu10n', rc=rc) .and. & - fldchk(is_local%wrap%FBExp(compocn), 'So_duu10n', rc=rc)) then - - call addmap(fldListMed_aoflux%flds , 'So_duu10n', compatm, mapconsf, 'ofrac', ocn2atm_fmap) ! map ocn->atm - call addmrg(fldListTo(compocn)%flds, 'So_duu10n', & - mrg_from=compmed, mrg_fld='So_duu10n', mrg_type='copy') + if (fldchk(is_local%wrap%FBExp(compocn), 'So_duu10n', rc=rc)) then + call addmrg(fldListTo(compocn)%flds, 'So_duu10n', mrg_from=compmed, mrg_fld='So_duu10n', mrg_type='copy') end if end if @@ -1178,10 +1870,8 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBImp(compatm, compatm), 'Sa_pslv', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compocn) , 'Sa_pslv', rc=rc)) then - - call addmap(fldListFr(compatm)%flds, 'Sa_pslv', compocn, mapbilnr, 'one', atm2ocn_smap) - call addmap(fldListFr(compatm)%flds, 'Sa_pslv', compice, mapbilnr, 'one', atm2ocn_smap) - + call addmap(fldListFr(compatm)%flds, 'Sa_pslv', compocn, mapbilnr, 'one', atm2ocn_map) + call addmap(fldListFr(compatm)%flds, 'Sa_pslv', compice, mapbilnr, 'one', atm2ocn_map) call addmrg(fldListTo(compocn)%flds, 'Sa_pslv', & mrg_from=compatm, mrg_fld='Sa_pslv', mrg_type='copy') end if @@ -1200,99 +1890,181 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ocn: dust dry deposition flux (sizes 1-4) from atm ! to ocn: nitrogen deposition fields (2) from atm ! --------------------------------------------------------------------- - allocate(flds(5)) - flds = (/'Faxa_bcph ', 'Faxa_ocph ', 'Faxa_dstwet' , 'Faxa_dstdry', 'Faxa_ndep ' /) - - do n = 1,size(flds) - fldname = trim(flds(n)) - if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, trim(fldname)) - call addfld(fldListTo(compocn)%flds, trim(fldname)) - else - if ( fldchk(is_local%wrap%FBImp(compatm,compatm), trim(fldname), rc=rc) .and. & - fldchk(is_local%wrap%FBExp(compocn) , trim(fldname), rc=rc)) then - call addmap(fldListFr(compatm)%flds, trim(fldname), compocn, mapconsf, 'one', atm2ocn_fmap) - call addmrg(fldListTo(compocn)%flds, trim(fldname), & - mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy_with_weights', mrg_fracname='ofrac') - end if + if (phase == 'advertise') then + call addfld(fldListTo(compocn)%flds, 'Faxa_bcph') + call addfld(fldListFr(compatm)%flds, 'Faxa_bcph') + else + if ( fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_bcph', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_bcph', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_bcph', compocn, mapconsf, 'one', atm2ocn_map) + call addmrg(fldListTo(compocn)%flds, 'Faxa_bcph', & + mrg_from=compatm, mrg_fld='Faxa_bcph', mrg_type='copy_with_weights', mrg_fracname='ofrac') + end if + end if + if (phase == 'advertise') then + call addfld(fldListTo(compocn)%flds, 'Faxa_ocph') + call addfld(fldListFr(compatm)%flds, 'Faxa_ocph') + else + if ( fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_ocph', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_ocph', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_ocph', compocn, mapconsf, 'one', atm2ocn_map) + call addmrg(fldListTo(compocn)%flds, 'Faxa_ocph', & + mrg_from=compatm, mrg_fld='Faxa_ocph', mrg_type='copy_with_weights', mrg_fracname='ofrac') + end if + end if + if (phase == 'advertise') then + call addfld(fldListTo(compocn)%flds, 'Faxa_dstwet') + call addfld(fldListFr(compatm)%flds, 'Faxa_dstwet') + else + if ( fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_dstwet', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_dstwet', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_dstwet', compocn, mapconsf, 'one', atm2ocn_map) + call addmrg(fldListTo(compocn)%flds, 'Faxa_dstwet', & + mrg_from=compatm, mrg_fld='Faxa_dstwet', mrg_type='copy_with_weights', mrg_fracname='ofrac') + end if + end if + if (phase == 'advertise') then + call addfld(fldListTo(compocn)%flds, 'Faxa_dstdry') + call addfld(fldListFr(compatm)%flds, 'Faxa_dstdry') + else + if ( fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_dstdry', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_dstdry', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_dstdry', compocn, mapconsf, 'one', atm2ocn_map) + call addmrg(fldListTo(compocn)%flds, 'Faxa_dstdry', & + mrg_from=compatm, mrg_fld='Faxa_dstdry', mrg_type='copy_with_weights', mrg_fracname='ofrac') end if - end do - deallocate(flds) + end if ! --------------------------------------------------------------------- - ! to ocn: merge zonal surface stress from ice and (atm or med) + ! to ocn: merge zonal and meridional surface stress from ice and (atm or med) ! --------------------------------------------------------------------- - allocate(suffix(2)) - suffix = (/'taux', 'tauy'/) - - do n = 1,size(suffix) - if (phase == 'advertise') then - call addfld(fldListMed_aoflux%flds , 'Faox_'//trim(suffix(n))) - call addfld(fldListFr(compice)%flds , 'Fioi_'//trim(suffix(n))) - call addfld(fldListFr(compatm)%flds , 'Faxa_'//trim(suffix(n))) - call addfld(fldListTo(compocn)%flds , 'Foxx_'//trim(suffix(n))) - else - if ( fldchk(is_local%wrap%FBexp(compocn), 'Foxx_'//trim(suffix(n)), rc=rc) .and. & - fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_'//trim(suffix(n)), rc=rc)) then - call addmap(fldListFr(compice)%flds, 'Fioi_'//trim(suffix(n)), compocn, mapfcopy, 'unset', 'unset') - call addmrg(fldListTo(compocn)%flds, 'Foxx_'//trim(suffix(n)), & - mrg_from=compmed, mrg_fld='Faox_'//trim(suffix(n)), mrg_type='merge', mrg_fracname='ofrac') - call addmrg(fldListTo(compocn)%flds, 'Foxx_'//trim(suffix(n)), & - mrg_from=compice, mrg_fld='Fioi_'//trim(suffix(n)), mrg_type='merge', mrg_fracname='ifrac') + if (phase == 'advertise') then + call addfld(fldListTo(compocn)%flds , 'Foxx_taux') + call addfld(fldListFr(compice)%flds , 'Fioi_taux') + call addfld(fldListMed_aoflux%flds , 'Faox_taux') + else + if ( fldchk(is_local%wrap%FBexp(compocn), 'Foxx_taux', rc=rc)) then + if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then + call addmap(fldListFr(compice)%flds, 'Fioi_taux', compocn, mapfcopy, 'unset', 'unset') + call addmrg(fldListTo(compocn)%flds, 'Foxx_taux', & + mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') end if + call addmrg(fldListTo(compocn)%flds, 'Foxx_taux', & + mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') end if - end do - deallocate(suffix) - + end if + if (phase == 'advertise') then + call addfld(fldListTo(compocn)%flds , 'Foxx_tauy') + call addfld(fldListFr(compice)%flds , 'Fioi_tauy') + call addfld(fldListMed_aoflux%flds , 'Faox_tauy') + else + if ( fldchk(is_local%wrap%FBexp(compocn), 'Foxx_tauy', rc=rc)) then + if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_tauy', rc=rc)) then + call addmap(fldListFr(compice)%flds, 'Fioi_tauy', compocn, mapfcopy, 'unset', 'unset') + call addmrg(fldListTo(compocn)%flds, 'Foxx_tauy', & + mrg_from=compice, mrg_fld='Fioi_tauy', mrg_type='merge', mrg_fracname='ifrac') + end if + call addmrg(fldListTo(compocn)%flds, 'Foxx_tauy', & + mrg_from=compmed, mrg_fld='Faox_tauy', mrg_type='merge', mrg_fracname='ofrac') + end if + end if ! --------------------------------------------------------------------- ! to ocn: water flux due to melting ice from ice ! --------------------------------------------------------------------- - do n = 1,size(iso) + if (phase == 'advertise') then + call addfld(fldListFr(compice)%flds , 'Fioi_meltw') + call addfld(fldListTo(compocn)%flds , 'Fioi_meltw') + else + if ( fldchk(is_local%wrap%FBexp(compocn) , 'Fioi_meltw', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice, compice), 'Fioi_meltw', rc=rc)) then + call addmap(fldListFr(compice)%flds, 'Fioi_meltw', compocn, mapfcopy, 'unset', 'unset') + call addmrg(fldListTo(compocn)%flds, 'Fioi_meltw', & + mrg_from=compice, mrg_fld='Fioi_meltw', mrg_type='copy_with_weights', mrg_fracname='ifrac') + end if + end if + if (flds_wiso) then if (phase == 'advertise') then - call addfld(fldListFr(compice)%flds , 'Fioi_meltw'//iso(n)) - call addfld(fldListTo(compocn)%flds , 'Fioi_meltw'//iso(n)) + call addfld(fldListFr(compice)%flds , 'Fioi_meltw_wiso') + call addfld(fldListTo(compocn)%flds , 'Fioi_meltw_wiso') else - if ( fldchk(is_local%wrap%FBexp(compocn) , 'Fioi_meltw'//iso(n), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compice, compice), 'Fioi_meltw'//iso(n), rc=rc)) then - call addmap(fldListFr(compice)%flds, 'Fioi_meltw'//iso(n), compocn, mapfcopy, 'unset', 'unset') - call addmrg(fldListTo(compocn)%flds, 'Fioi_meltw'//iso(n), & - mrg_from=compice, mrg_fld='Fioi_meltw'//iso(n), mrg_type='copy_with_weights', mrg_fracname='ifrac') + if ( fldchk(is_local%wrap%FBexp(compocn) , 'Fioi_meltw_wiso', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice, compice), 'Fioi_meltw_wiso', rc=rc)) then + call addmap(fldListFr(compice)%flds, 'Fioi_meltw_wiso', compocn, mapfcopy, 'unset', 'unset') + call addmrg(fldListTo(compocn)%flds, 'Fioi_meltw_wiso', & + mrg_from=compice, mrg_fld='Fioi_meltw_wiso', mrg_type='copy_with_weights', mrg_fracname='ifrac') end if end if - end do - + end if ! --------------------------------------------------------------------- ! to ocn: heat flux from melting ice from ice + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compice)%flds, 'Fioi_melth') + call addfld(fldListTo(compocn)%flds, 'Fioi_melth') + else + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Fioi_melth', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice, compice), 'Fioi_melth', rc=rc)) then + call addmap(fldListFr(compice)%flds, 'Fioi_melth', compocn, mapfcopy, 'unset', 'unset') + call addmrg(fldListTo(compocn)%flds, 'Fioi_melth', & + mrg_from=compice, mrg_fld='Fioi_melth', mrg_type='copy_with_weights', mrg_fracname='ifrac') + end if + end if + ! --------------------------------------------------------------------- ! to ocn: salt flux from ice + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compice)%flds, 'Fioi_salt') + call addfld(fldListTo(compocn)%flds, 'Fioi_salt') + else + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Fioi_salt', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice, compice), 'Fioi_salt', rc=rc)) then + call addmap(fldListFr(compice)%flds, 'Fioi_salt', compocn, mapfcopy, 'unset', 'unset') + call addmrg(fldListTo(compocn)%flds, 'Fioi_salt', & + mrg_from=compice, mrg_fld='Fioi_salt', mrg_type='copy_with_weights', mrg_fracname='ifrac') + end if + end if + ! --------------------------------------------------------------------- ! to ocn: hydrophylic black carbon deposition flux from ice + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compice)%flds, 'Fioi_bcphi') + call addfld(fldListTo(compocn)%flds, 'Fioi_bcphi') + else + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Fioi_bcphi', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice, compice), 'Fioi_bcphi', rc=rc)) then + call addmap(fldListFr(compice)%flds, 'Fioi_bcphi', compocn, mapfcopy, 'unset', 'unset') + call addmrg(fldListTo(compocn)%flds, 'Fioi_bcphi', & + mrg_from=compice, mrg_fld='Fioi_bcphi', mrg_type='copy_with_weights', mrg_fracname='ifrac') + end if + end if + ! --------------------------------------------------------------------- ! to ocn: hydrophobic black carbon deposition flux from ice + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compice)%flds, 'Fioi_bcpho') + call addfld(fldListTo(compocn)%flds, 'Fioi_bcpho') + else + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Fioi_bcpho', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice, compice), 'Fioi_bcpho', rc=rc)) then + call addmap(fldListFr(compice)%flds, 'Fioi_bcpho', compocn, mapfcopy, 'unset', 'unset') + call addmrg(fldListTo(compocn)%flds, 'Fioi_bcpho', & + mrg_from=compice, mrg_fld='Fioi_bcpho', mrg_type='copy_with_weights', mrg_fracname='ifrac') + end if + end if + ! --------------------------------------------------------------------- ! to ocn: dust flux from ice ! --------------------------------------------------------------------- - ! TODO (mvertens, 2019-01-07): is fioi_melth being handled here? - ! Is fd.yaml correctly aliasing Fioi_melth? - - allocate(flds(5)) - flds = (/'Fioi_melth ',& - 'Fioi_salt ',& - 'Fioi_bcphi ',& - 'Fioi_bcpho ',& - 'Fioi_flxdst'/) - - do n = 1,size(flds) - fldname = trim(flds(n)) - if (phase == 'advertise') then - call addfld(fldListFr(compice)%flds, trim(fldname)) - call addfld(fldListTo(compocn)%flds, trim(fldname)) - else - if ( fldchk(is_local%wrap%FBExp(compocn) , trim(fldname), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compice, compice), trim(fldname), rc=rc)) then - call addmap(fldListFr(compice)%flds, trim(fldname), compocn, mapfcopy, 'unset', 'unset') - call addmrg(fldListTo(compocn)%flds, trim(fldname), & - mrg_from=compice, mrg_fld=trim(fldname), mrg_type='copy_with_weights', mrg_fracname='ifrac') - end if + if (phase == 'advertise') then + call addfld(fldListFr(compice)%flds, 'Fioi_flxdst') + call addfld(fldListTo(compocn)%flds, 'Fioi_flxdst') + else + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Fioi_flxdst', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice, compice), 'Fioi_flxdst', rc=rc)) then + call addmap(fldListFr(compice)%flds, 'Fioi_flxdst', compocn, mapfcopy, 'unset', 'unset') + call addmrg(fldListTo(compocn)%flds, 'Fioi_flxdst', & + mrg_from=compice, mrg_fld='Fioi_flxdst', mrg_type='copy_with_weights', mrg_fracname='ifrac') end if - end do - deallocate(flds) + end if !----------------------------- ! to ocn: liquid runoff from rof and glc components @@ -1301,100 +2073,182 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) !----------------------------- if (phase == 'advertise') then - do n = 1,size(iso) - ! Note that Flrr_flood below needs to be added to - ! fldlistFr(comprof) in order to be mapped correctly but the ocean - ! does not receive it so it is advertised but it will! not be connected + ! Note that Flrr_flood below needs to be added to + ! fldlistFr(comprof) in order to be mapped correctly but the ocean + ! does not receive it so it is advertised but it will! not be connected + do ns = 1, num_icesheets + call addfld(fldListFr(compglc(ns))%flds, 'Fogg_rofl') + end do + call addfld(fldListFr(comprof)%flds, 'Forr_rofl') + call addfld(fldListTo(compocn)%flds, 'Foxx_rofl') + call addfld(fldListTo(compocn)%flds, 'Flrr_flood') + do ns = 1, num_icesheets + call addfld(fldListFr(compglc(ns))%flds, 'Fogg_rofi') + end do + call addfld(fldListFr(comprof)%flds, 'Forr_rofi') + call addfld(fldListTo(compocn)%flds, 'Foxx_rofi') + else + if ( fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofl' , rc=rc)) then + ! liquid from river and possibly flood from river to ocean + if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofl' , rc=rc)) then + if (trim(rof2ocn_liq_rmap) == 'unset') then + call addmap(fldListFr(comprof)%flds, 'Forr_rofl', compocn, mapconsd, 'none', 'unset') + else + call addmap(fldListFr(comprof)%flds, 'Forr_rofl', compocn, map_rof2ocn_liq, 'none', rof2ocn_liq_rmap) + end if + if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_flood', rc=rc)) then + call addmap(fldListFr(comprof)%flds, 'Flrr_flood', compocn, mapconsd, 'one', rof2ocn_fmap) + call addmrg(fldListTo(compocn)%flds, 'Foxx_rofl', mrg_from=comprof, mrg_fld='Forr_rofl:Flrr_flood', mrg_type='sum') + else + call addmrg(fldListTo(compocn)%flds, 'Foxx_rofl', mrg_from=comprof, mrg_fld='Forr_rofl', mrg_type='sum') + end if + end if + ! liquid from glc to ocean + do ns = 1, num_icesheets + if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Fogg_rofl' , rc=rc)) then + ! TODO: this custom map needs to be different for every ice sheet - how will this be handled? + call addmap(fldListFr(compglc(ns))%flds, 'Fogg_rofl', compocn, map_glc2ocn_liq, 'one' , glc2ocn_liq_rmap) + call addmrg(fldListTo(compocn)%flds, 'Foxx_rofl', mrg_from=compglc(ns), mrg_fld='Fogg_rofl', mrg_type='sum') + end if + end do + end if + if ( fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofi' , rc=rc)) then + ! ice from river to ocean + if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofi' , rc=rc)) then + if (trim(rof2ocn_ice_rmap) == 'unset') then + call addmap(fldListFr(comprof)%flds, 'Forr_rofi', compocn, mapconsd, 'none', 'unset') + else + call addmap(fldListFr(comprof)%flds, 'Forr_rofi', compocn, map_rof2ocn_ice, 'none', rof2ocn_ice_rmap) + end if + call addmrg(fldListTo(compocn)%flds, 'Foxx_rofi', mrg_from=comprof, mrg_fld='Forr_rofi', mrg_type='sum') + end if + ! ice from glc to ocean do ns = 1, num_icesheets - call addfld(fldListFr(compglc(ns))%flds, 'Fogg_rofl'//iso(n)) + if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Fogg_rofi' , rc=rc)) then + ! TODO: this custom map needs to be different for every ice sheet - how will this be handled? + call addmap(fldListFr(compglc(ns))%flds, 'Fogg_rofi', compocn, map_glc2ocn_ice, 'one', glc2ocn_ice_rmap) + call addmrg(fldListTo(compocn)%flds, 'Foxx_rofi', mrg_from=compglc(ns), mrg_fld='Fogg_rofi', mrg_type='sum') + end if end do - call addfld(fldListFr(comprof)%flds, 'Forr_rofl'//iso(n)) - call addfld(fldListTo(compocn)%flds, 'Foxx_rofl'//iso(n)) - call addfld(fldListTo(compocn)%flds, 'Flrr_flood'//iso(n)) + end if + end if + + if (flds_wiso) then + if (phase == 'advertise') then do ns = 1, num_icesheets - call addfld(fldListFr(compglc(ns))%flds, 'Fogg_rofi'//iso(n)) + call addfld(fldListFr(compglc(ns))%flds, 'Fogg_rofl_wiso') end do - call addfld(fldListFr(comprof)%flds, 'Forr_rofi'//iso(n)) - call addfld(fldListTo(compocn)%flds, 'Foxx_rofi'//iso(n)) - end do - else - do n = 1,size(iso) - if ( fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofl'//iso(n) , rc=rc)) then + call addfld(fldListFr(comprof)%flds, 'Forr_rofl_wiso') + call addfld(fldListTo(compocn)%flds, 'Foxx_rofl_wiso') + call addfld(fldListTo(compocn)%flds, 'Flrr_flood_wiso') + do ns = 1, num_icesheets + call addfld(fldListFr(compglc(ns))%flds, 'Fogg_rofi_wiso') + end do + call addfld(fldListFr(comprof)%flds, 'Forr_rofi_wiso') + call addfld(fldListTo(compocn)%flds, 'Foxx_rofi_wiso') + else + if ( fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofl_wiso' , rc=rc)) then ! liquid from river and possibly flood from river to ocean - if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofl'//iso(n) , rc=rc)) then - call addmap(fldListFr(comprof)%flds, 'Forr_rofl'//iso(n), & - compocn, map_rof2ocn_liq, 'none', rof2ocn_liq_rmap) - if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_flood'//iso(n), rc=rc)) then - call addmap(fldListFr(comprof)%flds, 'Flrr_flood'//iso(n), & - compocn, mapconsd, 'one', rof2ocn_fmap) - call addmrg(fldListTo(compocn)%flds, 'Foxx_rofl'//iso(n), & + if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofl_wiso' , rc=rc)) then + if (trim(rof2ocn_liq_rmap) == 'unset') then + call addmap(fldListFr(comprof)%flds, 'Forr_rofl_wiso', compocn, mapconsd, 'none', 'unset') + else + call addmap(fldListFr(comprof)%flds, 'Forr_rofl_wiso', compocn, map_rof2ocn_liq, 'none', rof2ocn_liq_rmap) + end if + if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_flood_wiso', rc=rc)) then + call addmap(fldListFr(comprof)%flds, 'Flrr_flood_wiso', compocn, mapconsd, 'one', rof2ocn_fmap) + call addmrg(fldListTo(compocn)%flds, 'Foxx_rofl_wiso', & mrg_from=comprof, mrg_fld='Forr_rofl:Flrr_flood', mrg_type='sum') else - call addmrg(fldListTo(compocn)%flds, 'Foxx_rofl'//iso(n), & + call addmrg(fldListTo(compocn)%flds, 'Foxx_rofl_wiso', & mrg_from=comprof, mrg_fld='Forr_rofl', mrg_type='sum') end if end if ! liquid from glc to ocean do ns = 1, num_icesheets - if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Fogg_rofl'//iso(n) , rc=rc)) then + if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Fogg_rofl_wiso' , rc=rc)) then ! TODO: this custom map needs to be different for every ice sheet - how will this be handled? - call addmap(fldListFr(compglc(ns))%flds, 'Fogg_rofl'//iso(n), & - compocn, map_glc2ocn_liq, 'one' , glc2ocn_liq_rmap) - call addmrg(fldListTo(compocn)%flds, 'Foxx_rofl'//iso(n), & - mrg_from=compglc(ns), mrg_fld='Fogg_rofl'//iso(n), mrg_type='sum') + call addmap(fldListFr(compglc(ns))%flds, 'Fogg_rofl_wiso', compocn, map_glc2ocn_liq, 'one' , glc2ocn_liq_rmap) + call addmrg(fldListTo(compocn)%flds, 'Foxx_rofl_wiso', & + mrg_from=compglc(ns), mrg_fld='Fogg_rofl_wiso', mrg_type='sum') end if end do end if - if ( fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofi'//iso(n) , rc=rc)) then + if ( fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofi_wiso' , rc=rc)) then ! ice from river to ocean - if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofi'//iso(n) , rc=rc)) then - call addmap(fldListFr(comprof)%flds, 'Forr_rofi'//iso(n), & - compocn, map_rof2ocn_ice, 'none', rof2ocn_ice_rmap) - call addmrg(fldListTo(compocn)%flds, 'Foxx_rofi'//iso(n), & - mrg_from=comprof, mrg_fld='Forr_rofi', mrg_type='sum') + if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofi_wiso' , rc=rc)) then + if (trim(rof2ocn_ice_rmap) == 'unset') then + call addmap(fldListFr(comprof)%flds, 'Forr_rofi_wiso', compocn, mapconsd, 'none', 'unset') + else + call addmap(fldListFr(comprof)%flds, 'Forr_rofi_wiso', compocn, map_rof2ocn_ice, 'none', rof2ocn_ice_rmap) + end if + call addmrg(fldListTo(compocn)%flds, 'Foxx_rofi_wiso', mrg_from=comprof, mrg_fld='Forr_rofi', mrg_type='sum') end if ! ice from glc to ocean do ns = 1, num_icesheets - if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Fogg_rofi'//iso(n) , rc=rc)) then + if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Fogg_rofi_wiso' , rc=rc)) then ! TODO: this custom map needs to be different for every ice sheet - how will this be handled? - call addmap(fldListFr(compglc(ns))%flds, 'Fogg_rofi'//iso(n), & - compocn, map_glc2ocn_ice, 'one', glc2ocn_ice_rmap) - call addmrg(fldListTo(compocn)%flds, 'Foxx_rofi'//iso(n), & - mrg_from=compglc(ns), mrg_fld='Fogg_rofi'//iso(n), mrg_type='sum') + call addmap(fldListFr(compglc(ns))%flds, 'Fogg_rofi_wiso', compocn, map_glc2ocn_ice, 'one', glc2ocn_ice_rmap) + call addmrg(fldListTo(compocn)%flds, 'Foxx_rofi_wiso', & + mrg_from=compglc(ns), mrg_fld='Fogg_rofi_wiso', mrg_type='sum') end if end do end if - end do + end if end if !----------------------------- ! to ocn: Langmuir multiplier from wave + !----------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compwav)%flds, 'Sw_lamult') + call addfld(fldListTo(compocn)%flds, 'Sw_lamult') + else + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_lamult', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_lamult', rc=rc)) then + call addmap(fldListFr(compwav)%flds, 'Sw_lamult', compocn, mapbilnr, 'one', wav2ocn_smap) + call addmrg(fldListTo(compocn)%flds, 'Sw_lamult', mrg_from=compwav, mrg_fld='Sw_lamult', mrg_type='copy') + end if + end if + !----------------------------- ! to ocn: Stokes drift u component from wave + !----------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compwav)%flds, 'Sw_ustokes') + call addfld(fldListTo(compocn)%flds, 'Sw_ustokes') + else + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_ustokes', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_ustokes', rc=rc)) then + call addmap(fldListFr(compwav)%flds, 'Sw_ustokes', compocn, mapbilnr, 'one', wav2ocn_smap) + call addmrg(fldListTo(compocn)%flds, 'Sw_ustokes', mrg_from=compwav, mrg_fld='Sw_ustokes', mrg_type='copy') + end if + end if + !----------------------------- ! to ocn: Stokes drift v component from wave + !----------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compwav)%flds, 'Sw_vstokes') + call addfld(fldListTo(compocn)%flds, 'Sw_vstokes') + else + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_vstokes', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_vstokes', rc=rc)) then + call addmap(fldListFr(compwav)%flds, 'Sw_vstokes', compocn, mapbilnr, 'one', wav2ocn_smap) + call addmrg(fldListTo(compocn)%flds, 'Sw_vstokes', mrg_from=compwav, mrg_fld='Sw_vstokes', mrg_type='copy') + end if + end if + !----------------------------- ! to ocn: Stokes drift depth from wave !----------------------------- - allocate(flds(4)) - flds = (/'Sw_lamult ',& - 'Sw_ustokes',& - 'Sw_vstokes',& - 'Sw_hstokes'/) - - do n = 1,size(flds) - fldname = trim(flds(n)) - if (phase == 'advertise') then - call addfld(fldListFr(compwav)%flds, trim(fldname)) - call addfld(fldListTo(compocn)%flds, trim(fldname)) - else - if ( fldchk(is_local%wrap%FBExp(compocn) , trim(fldname), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compwav, compwav), trim(fldname), rc=rc)) then - call addmap(fldListFr(compwav)%flds, trim(fldname), & - compocn, mapbilnr, 'one', wav2ocn_smap) - call addmrg(fldListTo(compocn)%flds, trim(fldname), & - mrg_from=compwav, mrg_fld=trim(fldname), mrg_type='copy') - end if + if (phase == 'advertise') then + call addfld(fldListFr(compwav)%flds, 'Sw_hstokes') + call addfld(fldListTo(compocn)%flds, 'Sw_hstokes') + else + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_hstokes', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_hstokes', rc=rc)) then + call addmap(fldListFr(compwav)%flds, 'Sw_hstokes', compocn, mapbilnr, 'one', wav2ocn_smap) + call addmrg(fldListTo(compocn)%flds, 'Sw_hstokes', mrg_from=compwav, mrg_fld='Sw_hstokes', mrg_type='copy') end if - end do - deallocate(flds) + end if !===================================================================== ! FIELDS TO ICE (compice) @@ -1402,45 +2256,125 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! --------------------------------------------------------------------- ! to ice: downward longwave heat flux from atm + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Faxa_lwdn') + call addfld(fldListTo(compice)%flds, 'Faxa_lwdn') + else + if ( fldchk(is_local%wrap%FBExp(compice) , 'Faxa_lwdn', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_lwdn', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_lwdn', compice, mapconsf, 'one', atm2ice_map) + call addmrg(fldListTo(compice)%flds, 'Faxa_lwdn', mrg_from=compatm, mrg_fld='Faxa_lwdn', mrg_type='copy') + end if + end if + ! --------------------------------------------------------------------- ! to ice: downward direct near-infrared incident solar radiation from atm ! to ice: downward direct visible incident solar radiation from atm ! to ice: downward diffuse near-infrared incident solar radiation from atm ! to ice: downward Diffuse visible incident solar radiation from atm + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Faxa_swndr') + call addfld(fldListTo(compice)%flds, 'Faxa_swndr') + else + if ( fldchk(is_local%wrap%FBExp(compice) , 'Faxa_swndr', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swndr', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_swndr', compice, mapconsf, 'one', atm2ice_map) + call addmrg(fldListTo(compice)%flds, 'Faxa_swndr', mrg_from=compatm, mrg_fld='Faxa_swndr', mrg_type='copy') + end if + end if + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Faxa_swvdr') + call addfld(fldListTo(compice)%flds, 'Faxa_swvdr') + else + if ( fldchk(is_local%wrap%FBExp(compice) , 'Faxa_swvdr', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swvdr', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_swvdr', compice, mapconsf, 'one', atm2ice_map) + call addmrg(fldListTo(compice)%flds, 'Faxa_swvdr', mrg_from=compatm, mrg_fld='Faxa_swvdr', mrg_type='copy') + end if + end if + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Faxa_swndf') + call addfld(fldListTo(compice)%flds, 'Faxa_swndf') + else + if ( fldchk(is_local%wrap%FBExp(compice) , 'Faxa_swndf', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swndf', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_swndf', compice, mapconsf, 'one', atm2ice_map) + call addmrg(fldListTo(compice)%flds, 'Faxa_swndf', mrg_from=compatm, mrg_fld='Faxa_swndf', mrg_type='copy') + end if + end if + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Faxa_swvdf') + call addfld(fldListTo(compice)%flds, 'Faxa_swvdf') + else + if ( fldchk(is_local%wrap%FBExp(compice) , 'Faxa_swvdf', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swvdf', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_swvdf', compice, mapconsf, 'one', atm2ice_map) + call addmrg(fldListTo(compice)%flds, 'Faxa_swvdf', mrg_from=compatm, mrg_fld='Faxa_swvdf', mrg_type='copy') + end if + end if + ! --------------------------------------------------------------------- ! to ice: hydrophylic black carbon dry deposition flux from atm ! to ice: hydrophobic black carbon dry deposition flux from atm ! to ice: hydrophylic black carbon wet deposition flux from atm + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Faxa_bcph') + call addfld(fldListTo(compice)%flds, 'Faxa_bcph') + else + if ( fldchk(is_local%wrap%FBExp(compice) , 'Faxa_bcph', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_bcph', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_bcph', compice, mapconsf, 'one', atm2ice_map) + call addmrg(fldListTo(compice)%flds, 'Faxa_bcph', mrg_from=compatm, mrg_fld='Faxa_bcph', mrg_type='copy') + end if + end if + ! --------------------------------------------------------------------- ! to ice: hydrophylic organic carbon dry deposition flux from atm ! to ice: hydrophobic organic carbon dry deposition flux from atm ! to ice: hydrophylic organic carbon wet deposition flux from atm + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Faxa_ocph') + call addfld(fldListTo(compice)%flds, 'Faxa_ocph') + else + if ( fldchk(is_local%wrap%FBExp(compice) , 'Faxa_ocph', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_ocph', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_ocph', compice, mapconsf, 'one', atm2ice_map) + call addmrg(fldListTo(compice)%flds, 'Faxa_ocph', mrg_from=compatm, mrg_fld='Faxa_ocph', mrg_type='copy') + end if + end if + ! --------------------------------------------------------------------- ! to ice: dust wet deposition flux (size 1) from atm ! to ice: dust wet deposition flux (size 2) from atm ! to ice: dust wet deposition flux (size 3) from atm ! to ice: dust wet deposition flux (size 4) from atm + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Faxa_dstwet') + call addfld(fldListTo(compice)%flds, 'Faxa_dstwet') + else + if ( fldchk(is_local%wrap%FBExp(compice) , 'Faxa_dstwet', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_dstwet', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_dstwet', compice, mapconsf, 'one', atm2ice_map) + call addmrg(fldListTo(compice)%flds, 'Faxa_dstwet', mrg_from=compatm, mrg_fld='Faxa_dstwet', mrg_type='copy') + end if + end if + ! --------------------------------------------------------------------- ! to ice: dust dry deposition flux (size 1) from atm ! to ice: dust dry deposition flux (size 2) from atm ! to ice: dust dry deposition flux (size 3) from atm ! to ice: dust dry deposition flux (size 4) from atm ! --------------------------------------------------------------------- - allocate(flds(9)) - flds = (/'Faxa_lwdn ' , 'Faxa_swndr ' , 'Faxa_swvdr ' , 'Faxa_swndf ' , 'Faxa_swvdf ', & - 'Faxa_bcph ' , 'Faxa_ocph ' , 'Faxa_dstwet' , 'Faxa_dstdry' /) - - do n = 1,size(flds) - fldname = trim(flds(n)) - if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, trim(fldname)) - call addfld(fldListTo(compice)%flds, trim(fldname)) - else - if ( fldchk(is_local%wrap%FBExp(compice) , trim(fldname), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), trim(fldname), rc=rc)) then - call addmap(fldListFr(compatm)%flds, trim(fldname), compice, mapconsf, 'one', atm2ice_fmap) - call addmrg(fldListTo(compice)%flds, trim(fldname), & - mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') - end if + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Faxa_dstdry') + call addfld(fldListTo(compice)%flds, 'Faxa_dstdry') + else + if ( fldchk(is_local%wrap%FBExp(compice) , 'Faxa_dstdry', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_dstdry', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_dstdry', compice, mapconsf, 'one', atm2ice_map) + call addmrg(fldListTo(compice)%flds, 'Faxa_dstdry', mrg_from=compatm, mrg_fld='Faxa_dstdry', mrg_type='copy') end if - end do - deallocate(flds) - + end if ! --------------------------------------------------------------------- ! to ice: convective and large scale precipitation rate water equivalent from atm ! to ice: rain and snow rate from atm @@ -1450,145 +2384,281 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addfld(fldListFr(compatm)%flds, 'Faxa_rainl') call addfld(fldListFr(compatm)%flds, 'Faxa_rain' ) call addfld(fldListTo(compice)%flds, 'Faxa_rain' ) - - call addfld(fldListFr(compatm)%flds, 'Faxa_rainc_wiso') - call addfld(fldListFr(compatm)%flds, 'Faxa_rainl_wiso') - call addfld(fldListFr(compatm)%flds, 'Faxa_rain_wiso' ) - call addfld(fldListTo(compice)%flds, 'Faxa_rain_wiso' ) else if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_rain' , rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainl', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainc', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_rainc', compice, mapconsf, 'one', atm2ice_fmap) - call addmap(fldListFr(compatm)%flds, 'Faxa_rainl', compice, mapconsf, 'one', atm2ice_fmap) - call addmrg(fldListTo(compice)%flds, 'Faxa_rain' , & - mrg_from=compatm, mrg_fld='Faxa_rainc:Faxa_rainl', mrg_type='sum') + call addmap(fldListFr(compatm)%flds, 'Faxa_rainc', compice, mapconsf, 'one', atm2ice_map) + call addmap(fldListFr(compatm)%flds, 'Faxa_rainl', compice, mapconsf, 'one', atm2ice_map) + call addmrg(fldListTo(compice)%flds, 'Faxa_rain' , mrg_from=compatm, mrg_fld='Faxa_rainc:Faxa_rainl', mrg_type='sum') else if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_rain', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rain', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_rain', compice, mapconsf, 'one', atm2ice_fmap) - call addmrg(fldListTo(compice)%flds, 'Faxa_rain', & - mrg_from=compatm, mrg_fld='Faxa_rain', mrg_type='copy') - end if - if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_rain_wiso' , rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainl_wiso', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainc_wiso', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_rainc_wiso', compice, mapconsf, 'one', atm2ice_fmap) - call addmap(fldListFr(compatm)%flds, 'Faxa_rainl_wiso', compice, mapconsf, 'one', atm2ice_fmap) - call addmrg(fldListTo(compice)%flds, 'Faxa_rain_wiso' , & - mrg_from=compatm, mrg_fld='Faxa_rainc_wiso:Faxa_rainl_wiso', mrg_type='sum') - else if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_rain_wiso', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rain_wiso', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_rain_wiso', compice, mapconsf, 'one', atm2ice_fmap) - call addmrg(fldListTo(compice)%flds, 'Faxa_rain_wiso', & - mrg_from=compatm, mrg_fld='Faxa_rain_wiso', mrg_type='copy') + call addmap(fldListFr(compatm)%flds, 'Faxa_rain', compice, mapconsf, 'one', atm2ice_map) + call addmrg(fldListTo(compice)%flds, 'Faxa_rain', mrg_from=compatm, mrg_fld='Faxa_rain', mrg_type='copy') end if end if - if (phase == 'advertise') then call addfld(fldListFr(compatm)%flds, 'Faxa_snowc') call addfld(fldListFr(compatm)%flds, 'Faxa_snowl') call addfld(fldListFr(compatm)%flds, 'Faxa_snow' ) call addfld(fldListTo(compice)%flds, 'Faxa_snow' ) - - call addfld(fldListFr(compatm)%flds, 'Faxa_snowc_wiso') - call addfld(fldListFr(compatm)%flds, 'Faxa_snowl_wiso') - call addfld(fldListFr(compatm)%flds, 'Faxa_snow_wiso' ) - call addfld(fldListTo(compice)%flds, 'Faxa_snow_wiso' ) else if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_snow' , rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowl', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowc', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_snowc', compice, mapconsf, 'one', atm2ice_fmap) - call addmap(fldListFr(compatm)%flds, 'Faxa_snowl', compice, mapconsf, 'one', atm2ice_fmap) + call addmap(fldListFr(compatm)%flds, 'Faxa_snowc', compice, mapconsf, 'one', atm2ice_map) + call addmap(fldListFr(compatm)%flds, 'Faxa_snowl', compice, mapconsf, 'one', atm2ice_map) call addmrg(fldListTo(compice)%flds, 'Faxa_snow' , & mrg_from=compatm, mrg_fld='Faxa_snowc:Faxa_snowl', mrg_type='sum') else if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_snow', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snow', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_snow', compice, mapconsf, 'one', atm2ice_fmap) + call addmap(fldListFr(compatm)%flds, 'Faxa_snow', compice, mapconsf, 'one', atm2ice_map) call addmrg(fldListTo(compice)%flds, 'Faxa_snow', & mrg_from=compatm, mrg_fld='Faxa_snow', mrg_type='copy') end if - if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_snow_wiso', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowl_wiso', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowc_wiso', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_snowc_wiso', compice, mapconsf, 'one', atm2ice_fmap) - call addmap(fldListFr(compatm)%flds, 'Faxa_snowl_wiso', compice, mapconsf, 'one', atm2ice_fmap) - call addmrg(fldListTo(compice)%flds, 'Faxa_snow_wiso' , & - mrg_from=compatm, mrg_fld='Faxa_snowc_wiso:Faxa_snowl_wiso', mrg_type='sum') - else if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_snow_wiso', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snow_wiso', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_snow_wiso', compice, mapconsf, 'one', atm2ice_fmap) - call addmrg(fldListTo(compice)%flds, 'Faxa_snow_wiso', & - mrg_from=compatm, mrg_fld='Faxa_snow_wiso', mrg_type='copy') + end if + + if (flds_wiso) then + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Faxa_rainc_wiso') + call addfld(fldListFr(compatm)%flds, 'Faxa_rainl_wiso') + call addfld(fldListFr(compatm)%flds, 'Faxa_rain_wiso' ) + call addfld(fldListTo(compice)%flds, 'Faxa_rain_wiso' ) + else + if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_rain_wiso' , rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainl_wiso', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainc_wiso', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_rainc_wiso', compice, mapconsf, 'one', atm2ice_map) + call addmap(fldListFr(compatm)%flds, 'Faxa_rainl_wiso', compice, mapconsf, 'one', atm2ice_map) + call addmrg(fldListTo(compice)%flds, 'Faxa_rain_wiso' , & + mrg_from=compatm, mrg_fld='Faxa_rainc_wiso:Faxa_rainl_wiso', mrg_type='sum') + else if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_rain_wiso', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rain_wiso', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_rain_wiso', compice, mapconsf, 'one', atm2ice_map) + call addmrg(fldListTo(compice)%flds, 'Faxa_rain_wiso', & + mrg_from=compatm, mrg_fld='Faxa_rain_wiso', mrg_type='copy') + end if + end if + + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Faxa_snowc_wiso') + call addfld(fldListFr(compatm)%flds, 'Faxa_snowl_wiso') + call addfld(fldListFr(compatm)%flds, 'Faxa_snow_wiso' ) + call addfld(fldListTo(compice)%flds, 'Faxa_snow_wiso' ) + else + if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_snow_wiso', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowl_wiso', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowc_wiso', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_snowc_wiso', compice, mapconsf, 'one', atm2ice_map) + call addmap(fldListFr(compatm)%flds, 'Faxa_snowl_wiso', compice, mapconsf, 'one', atm2ice_map) + call addmrg(fldListTo(compice)%flds, 'Faxa_snow_wiso' , & + mrg_from=compatm, mrg_fld='Faxa_snowc_wiso:Faxa_snowl_wiso', mrg_type='sum') + else if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_snow_wiso', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snow_wiso', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_snow_wiso', compice, mapconsf, 'one', atm2ice_map) + call addmrg(fldListTo(compice)%flds, 'Faxa_snow_wiso', mrg_from=compatm, mrg_fld='Faxa_snow_wiso', mrg_type='copy') + end if end if end if ! --------------------------------------------------------------------- ! to ice: height at the lowest model level from atm + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Sa_z') + call addfld(fldListTo(compice)%flds, 'Sa_z') + else + if ( fldchk(is_local%wrap%FBexp(compice) , 'Sa_z', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_z', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Sa_z', compice, mapbilnr, 'one', atm2ice_map) + call addmrg(fldListTo(compice)%flds, 'Sa_z', mrg_from=compatm, mrg_fld='Sa_z', mrg_type='copy') + end if + end if + ! --------------------------------------------------------------------- ! to ice: pressure at the lowest model level fromatm + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Sa_pbot') + call addfld(fldListTo(compice)%flds, 'Sa_pbot') + else + if ( fldchk(is_local%wrap%FBexp(compice) , 'Sa_pbot', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_pbot', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Sa_pbot', compice, mapbilnr, 'one', atm2ice_map) + call addmrg(fldListTo(compice)%flds, 'Sa_pbot', mrg_from=compatm, mrg_fld='Sa_pbot', mrg_type='copy') + end if + end if + ! --------------------------------------------------------------------- ! to ice: temperature at the lowest model level from atm + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Sa_tbot') + call addfld(fldListTo(compice)%flds, 'Sa_tbot') + else + if ( fldchk(is_local%wrap%FBexp(compice) , 'Sa_tbot', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_tbot', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Sa_tbot', compice, mapbilnr, 'one', atm2ice_map) + call addmrg(fldListTo(compice)%flds, 'Sa_tbot', mrg_from=compatm, mrg_fld='Sa_tbot', mrg_type='copy') + end if + end if + ! --------------------------------------------------------------------- ! to ice: potential temperature at the lowest model level from atm + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Sa_ptem') + call addfld(fldListTo(compice)%flds, 'Sa_ptem') + else + if ( fldchk(is_local%wrap%FBexp(compice) , 'Sa_ptem', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_ptem', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Sa_ptem', compice, mapbilnr, 'one', atm2ice_map) + call addmrg(fldListTo(compice)%flds, 'Sa_ptem', mrg_from=compatm, mrg_fld='Sa_ptem', mrg_type='copy') + end if + end if + ! --------------------------------------------------------------------- ! to ice: density at the lowest model level from atm + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Sa_dens') + call addfld(fldListTo(compice)%flds, 'Sa_dens') + else + if ( fldchk(is_local%wrap%FBexp(compice) , 'Sa_dens', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_dens', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Sa_dens', compice, mapbilnr, 'one', atm2ice_map) + call addmrg(fldListTo(compice)%flds, 'Sa_dens', mrg_from=compatm, mrg_fld='Sa_dens', mrg_type='copy') + end if + end if + ! --------------------------------------------------------------------- ! to ice: zonal wind at the lowest model level from atm ! to ice: meridional wind at the lowest model level from atm + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Sa_u') + call addfld(fldListTo(compice)%flds, 'Sa_u') + else + if ( fldchk(is_local%wrap%FBexp(compice) , 'Sa_u', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_u', rc=rc)) then + if (mapuv_with_cart3d) then + call addmap(fldListFr(compatm)%flds, 'Sa_u', compice, mappatch_uv3d, 'one', atm2ice_map) + else + call addmap(fldListFr(compatm)%flds, 'Sa_u', compice, mappatch, 'one', atm2ice_map) + end if + call addmrg(fldListTo(compice)%flds, 'Sa_u', mrg_from=compatm, mrg_fld='Sa_u', mrg_type='copy') + end if + end if + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Sa_v') + call addfld(fldListTo(compice)%flds, 'Sa_v') + else + if ( fldchk(is_local%wrap%FBexp(compice) , 'Sa_v', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_v', rc=rc)) then + if (mapuv_with_cart3d) then + call addmap(fldListFr(compatm)%flds, 'Sa_v', compice, mappatch_uv3d, 'one', atm2ice_map) + else + call addmap(fldListFr(compatm)%flds, 'Sa_v', compice, mappatch, 'one', atm2ice_map) + end if + call addmrg(fldListTo(compice)%flds, 'Sa_v', mrg_from=compatm, mrg_fld='Sa_v', mrg_type='copy') + end if + end if + ! --------------------------------------------------------------------- ! to ice: specific humidity at the lowest model level from atm ! to ice: specific humidity for water isotopes at the lowest model level from atm ! --------------------------------------------------------------------- - allocate(flds(9)) - flds = (/'Sa_z ', 'Sa_pbot ', 'Sa_tbot ', 'Sa_ptem ', & - 'Sa_dens ', 'Sa_u ', 'Sa_v ', 'Sa_shum ', 'Sa_shum_wiso'/) - - do n = 1,size(flds) - fldname = trim(flds(n)) + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Sa_shum') + call addfld(fldListTo(compice)%flds, 'Sa_shum') + else + if ( fldchk(is_local%wrap%FBexp(compice) , 'Sa_shum', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_shum', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Sa_shum', compice, mapbilnr, 'one', atm2ice_map) + call addmrg(fldListTo(compice)%flds, 'Sa_shum', mrg_from=compatm, mrg_fld='Sa_shum', mrg_type='copy') + end if + end if + if (flds_wiso) then if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, trim(fldname)) - call addfld(fldListTo(compice)%flds, trim(fldname)) + call addfld(fldListFr(compatm)%flds, 'Sa_shum_wiso') + call addfld(fldListTo(compice)%flds, 'Sa_shum_wiso') else - if ( fldchk(is_local%wrap%FBexp(compice) , trim(fldname), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm ), trim(fldname), rc=rc)) then - if (trim(fldname) == 'Sa_u' .or. trim(fldname) == 'Sa_v') then - if (mapuv_with_cart3d) then - call addmap(fldListFr(compatm)%flds, trim(fldname), compice, mappatch_uv3d, 'one', atm2ice_vmap) - else - call addmap(fldListFr(compatm)%flds, trim(fldname), compice, mappatch, 'one', atm2ice_vmap) - end if - else - call addmap(fldListFr(compatm)%flds, trim(fldname), compice, mapbilnr, 'one', atm2ice_smap) - end if - call addmrg(fldListTo(compice)%flds, trim(fldname), & - mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') + if ( fldchk(is_local%wrap%FBexp(compice) , 'Sa_shum_wiso', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_shum_wiso', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Sa_shum_wiso', compice, mapbilnr, 'one', atm2ice_map) + call addmrg(fldListTo(compice)%flds, 'Sa_shum_wiso', mrg_from=compatm, mrg_fld='Sa_shum_wiso', mrg_type='copy') end if end if - end do - deallocate(flds) + end if ! --------------------------------------------------------------------- ! to ice: sea surface temperature from ocn + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compocn)%flds, 'So_t') + call addfld(fldListTo(compice)%flds, 'So_t') + else + if ( fldchk(is_local%wrap%FBexp(compice) , 'So_t', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compocn,compocn), 'So_t', rc=rc)) then + call addmap(fldListFr(compocn)%flds, 'So_t', compice, mapfcopy , 'unset', 'unset') + call addmrg(fldListTo(compice)%flds, 'So_t', mrg_from=compocn, mrg_fld='So_t', mrg_type='copy') + end if + end if + ! --------------------------------------------------------------------- ! to ice: sea surface salinity from ocn + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compocn)%flds, 'So_s') + call addfld(fldListTo(compice)%flds, 'So_s') + else + if ( fldchk(is_local%wrap%FBexp(compice) , 'So_s', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compocn,compocn), 'So_s', rc=rc)) then + call addmap(fldListFr(compocn)%flds, 'So_s', compice, mapfcopy , 'unset', 'unset') + call addmrg(fldListTo(compice)%flds, 'So_s', mrg_from=compocn, mrg_fld='So_s', mrg_type='copy') + end if + end if + ! --------------------------------------------------------------------- ! to ice: zonal sea water velocity from ocn ! to ice: meridional sea water velocity from ocn - ! to ice: zonal sea surface slope from ocean + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compocn)%flds, 'So_u') + call addfld(fldListTo(compice)%flds, 'So_u') + else + if ( fldchk(is_local%wrap%FBexp(compice) , 'So_u', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compocn,compocn), 'So_u', rc=rc)) then + call addmap(fldListFr(compocn)%flds, 'So_u', compice, mapfcopy , 'unset', 'unset') + call addmrg(fldListTo(compice)%flds, 'So_u', mrg_from=compocn, mrg_fld='So_u', mrg_type='copy') + end if + end if + if (phase == 'advertise') then + call addfld(fldListFr(compocn)%flds, 'So_v') + call addfld(fldListTo(compice)%flds, 'So_v') + else + if ( fldchk(is_local%wrap%FBexp(compice) , 'So_v', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compocn,compocn), 'So_v', rc=rc)) then + call addmap(fldListFr(compocn)%flds, 'So_v', compice, mapfcopy , 'unset', 'unset') + call addmrg(fldListTo(compice)%flds, 'So_v', mrg_from=compocn, mrg_fld='So_v', mrg_type='copy') + end if + end if + ! --------------------------------------------------------------------- + ! to ice: zonal sea surface slope from ocn ! to ice: meridional sea surface slope from ocn ! --------------------------------------------------------------------- - allocate(flds(6)) - flds = (/'So_t ', 'So_s ', 'So_u ', 'So_v ', 'So_dhdx', 'So_dhdy'/) - - do n = 1,size(flds) - fldname = trim(flds(n)) - if (phase == 'advertise') then - call addfld(fldListFr(compocn)%flds, trim(fldname)) - call addfld(fldListTo(compice)%flds, trim(fldname)) - else - if ( fldchk(is_local%wrap%FBexp(compice) , trim(fldname), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compocn,compocn), trim(fldname), rc=rc)) then - call addmap(fldListFr(compocn)%flds, trim(fldname), compice, mapfcopy , 'unset', 'unset') - call addmrg(fldListTo(compice)%flds, trim(fldname), & - mrg_from=compocn, mrg_fld=trim(fldname), mrg_type='copy') - end if + if (phase == 'advertise') then + call addfld(fldListFr(compocn)%flds, 'So_dhdx') + call addfld(fldListTo(compice)%flds, 'So_dhdx') + else + if ( fldchk(is_local%wrap%FBexp(compice) , 'So_dhdx', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compocn,compocn), 'So_dhdx', rc=rc)) then + call addmap(fldListFr(compocn)%flds, 'So_dhdx', compice, mapfcopy , 'unset', 'unset') + call addmrg(fldListTo(compice)%flds, 'So_dhdx', mrg_from=compocn, mrg_fld='So_dhdx', mrg_type='copy') end if - end do - deallocate(flds) - + end if + if (phase == 'advertise') then + call addfld(fldListFr(compocn)%flds, 'So_dhdy') + call addfld(fldListTo(compice)%flds, 'So_dhdy') + else + if ( fldchk(is_local%wrap%FBexp(compice) , 'So_dhdy', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compocn,compocn), 'So_dhdy', rc=rc)) then + call addmap(fldListFr(compocn)%flds, 'So_dhdy', compice, mapfcopy , 'unset', 'unset') + call addmrg(fldListTo(compice)%flds, 'So_dhdy', mrg_from=compocn, mrg_fld='So_dhdy', mrg_type='copy') + end if + end if ! --------------------------------------------------------------------- ! to ice: ocean melt and freeze potential from ocn ! --------------------------------------------------------------------- @@ -1599,55 +2669,72 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if ( fldchk(is_local%wrap%FBImp(compocn, compocn), 'Fioo_q', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compice) , 'Fioo_q', rc=rc)) then call addmap(fldListFr(compocn)%flds, 'Fioo_q', compice, mapfcopy, 'unset', 'unset') - call addmrg(fldListTo(compice)%flds, 'Fioo_q', & - mrg_from=compocn, mrg_fld='Fioo_q', mrg_type='copy') + call addmrg(fldListTo(compice)%flds, 'Fioo_q', mrg_from=compocn, mrg_fld='Fioo_q', mrg_type='copy') end if end if - !----------------------------- ! to ice: Ratio of ocean surface level abund. H2_16O/H2O/Rstd from ocean !----------------------------- - if (phase == 'advertise') then - call addfld(fldListFr(compocn)%flds, 'So_roce_wiso') - call addfld(fldListTo(compice)%flds, 'So_roce_wiso') - else - if ( fldchk(is_local%wrap%FBImp(compocn, compocn), 'So_roce_wiso', rc=rc) .and. & - fldchk(is_local%wrap%FBExp(compice) , 'So_roce_wiso', rc=rc)) then - call addmap(fldListFr(compocn)%flds, 'So_roce_wiso', compice, mapfcopy, 'unset', 'unset') - call addmrg(fldListTo(compice)%flds, 'So_roce_wiso', & - mrg_from=compocn, mrg_fld='So_roce_wiso', mrg_type='copy') + if (flds_wiso) then + if (phase == 'advertise') then + call addfld(fldListFr(compocn)%flds, 'So_roce_wiso') + call addfld(fldListTo(compice)%flds, 'So_roce_wiso') + else + if ( fldchk(is_local%wrap%FBImp(compocn, compocn), 'So_roce_wiso', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compice) , 'So_roce_wiso', rc=rc)) then + call addmap(fldListFr(compocn)%flds, 'So_roce_wiso', compice, mapfcopy, 'unset', 'unset') + call addmrg(fldListTo(compice)%flds, 'So_roce_wiso', mrg_from=compocn, mrg_fld='So_roce_wiso', mrg_type='copy') + end if end if end if ! --------------------------------------------------------------------- ! to ice: frozen runoff from rof and glc ! --------------------------------------------------------------------- - do n = 1,size(iso) + if (phase == 'advertise') then + call addfld(fldListFr(comprof)%flds, 'Firr_rofi') ! water flux into sea ice due to runoff (frozen) + do ns = 1, num_icesheets + call addfld(fldListFr(compglc(ns))%flds, 'Figg_rofi') ! glc frozen runoff_iceberg flux to ice + end do + call addfld(fldListTo(compice)%flds, 'Fixx_rofi') ! total frozen water flux into sea ice + else + if ( fldchk(is_local%wrap%FBExp(compice), 'Fixx_rofi', rc=rc)) then + if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofi', rc=rc)) then + call addmap(fldListFr(comprof)%flds, 'Forr_rofi', compice, mapconsf, 'none', rof2ocn_ice_rmap) + call addmrg(fldListTo(compice)%flds, 'Fixx_rofi', mrg_from=comprof, mrg_fld='Firr_rofi', mrg_type='sum') + end if + do ns = 1, num_icesheets + if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Figg_rofi', rc=rc)) then + call addmap(fldListFr(compglc(ns))%flds, 'Figg_rofi', compice, mapconsf, 'one' , glc2ice_rmap) + call addmrg(fldListTo(compice)%flds, 'Fixx_rofi', mrg_from=compglc(ns), mrg_fld='Figg_rofi', mrg_type='sum') + end if + end do + end if + end if + if (flds_wiso) then if (phase == 'advertise') then - call addfld(fldListFr(comprof)%flds, 'Firr_rofi'//iso(n)) ! water flux into sea ice due to runoff (frozen) + call addfld(fldListFr(comprof)%flds, 'Firr_rofi_wiso') ! water flux into sea ice due to runoff (frozen) do ns = 1, num_icesheets - call addfld(fldListFr(compglc(ns))%flds, 'Figg_rofi'//iso(n)) ! glc frozen runoff_iceberg flux to ice + call addfld(fldListFr(compglc(ns))%flds, 'Figg_rofi_wiso') ! glc frozen runoff_iceberg flux to ice end do - call addfld(fldListTo(compice)%flds, 'Fixx_rofi'//iso(n)) ! total frozen water flux into sea ice + call addfld(fldListTo(compice)%flds, 'Fixx_rofi_wiso') ! total frozen water flux into sea ice else - if ( fldchk(is_local%wrap%FBExp(compice), 'Fixx_rofi'//iso(n), rc=rc)) then - if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofi'//iso(n), rc=rc)) then - call addmap(fldListFr(comprof)%flds, 'Forr_rofi'//iso(n), & - compice, mapconsf, 'none', rof2ocn_ice_rmap) - call addmrg(fldListTo(compice)%flds, 'Fixx_rofi'//iso(n), & - mrg_from=comprof, mrg_fld='Firr_rofi'//iso(n), mrg_type='sum') + if ( fldchk(is_local%wrap%FBExp(compice), 'Fixx_rofi_wiso', rc=rc)) then + if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofi_wiso', rc=rc)) then + call addmap(fldListFr(comprof)%flds, 'Forr_rofi_wiso', compice, mapconsf, 'none', rof2ocn_ice_rmap) + call addmrg(fldListTo(compice)%flds, 'Fixx_rofi_wiso', & + mrg_from=comprof, mrg_fld='Firr_rofi_wiso', mrg_type='sum') end if do ns = 1, num_icesheets - if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Figg_rofi'//iso(n), rc=rc)) then - call addmap(fldListFr(compglc(ns))%flds, 'Figg_rofi'//iso(n), & - compice, mapconsf, 'one' , glc2ice_rmap) - call addmrg(fldListTo(compice)%flds, 'Fixx_rofi'//iso(n), & - mrg_from=compglc(ns), mrg_fld='Figg_rofi'//iso(n), mrg_type='sum') + if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Figg_rofi_wiso', rc=rc)) then + call addmap(fldListFr(compglc(ns))%flds, 'Figg_rofi_wiso', compice, mapconsf, 'one' , glc2ice_rmap) + call addmrg(fldListTo(compice)%flds, 'Fixx_rofi_wiso', & + mrg_from=compglc(ns), mrg_fld='Figg_rofi_wiso', mrg_type='sum') end if end do end if end if - end do + end if !===================================================================== ! FIELDS TO WAVE (compwav) @@ -1664,58 +2751,103 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_ifrac', rc=rc)) then ! By default will be using a custom map - but if one is not available, use a generated bilinear instead call addmap(fldListFr(compice)%flds, 'Si_ifrac', compwav, mapbilnr, 'one', ice2wav_smap) - call addmrg(fldListTo(compwav)%flds, 'Si_ifrac', & - mrg_from=compice, mrg_fld='Si_ifrac', mrg_type='copy') + call addmrg(fldListTo(compwav)%flds, 'Si_ifrac', mrg_from=compice, mrg_fld='Si_ifrac', mrg_type='copy') end if end if ! --------------------------------------------------------------------- - ! to wav: ocean boundary layer depth from ocn - ! to wav: ocean currents from ocn ! to wav: ocean surface temperature from ocn ! --------------------------------------------------------------------- - allocate(flds(4)) - flds = (/'So_t ', 'So_u ', 'So_v ', 'So_bldepth'/) + if (phase == 'advertise') then + call addfld(fldListFr(compocn)%flds, 'So_t') + call addfld(fldListTo(compwav)%flds, 'So_t') + else + if ( fldchk(is_local%wrap%FBImp(compocn, compocn), 'So_t', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compwav) , 'So_t', rc=rc)) then + ! By default will be using a custom map - but if one is not available, use a generated bilinear instead + call addmap(fldListFr(compocn)%flds, 'So_t', compwav, mapbilnr, 'one', ocn2wav_smap) + call addmrg(fldListTo(compwav)%flds, 'So_t', mrg_from=compocn, mrg_fld='So_t', mrg_type='copy') + end if + end if - do n = 1,size(flds) - fldname = trim(flds(n)) - if (phase == 'advertise') then - call addfld(fldListFr(compocn)%flds, trim(fldname)) - call addfld(fldListTo(compwav)%flds, trim(fldname)) - else - if ( fldchk(is_local%wrap%FBImp(compocn, compocn), trim(fldname), rc=rc) .and. & - fldchk(is_local%wrap%FBExp(compwav) , trim(fldname), rc=rc)) then - ! By default will be using a custom map - but if one is not available, use a generated bilinear instead - call addmap(fldListFr(compocn)%flds, trim(fldname), compwav, mapbilnr, 'one', ocn2wav_smap) - call addmrg(fldListTo(compwav)%flds, trim(fldname), & - mrg_from=compocn, mrg_fld=trim(fldname), mrg_type='copy') - end if + ! --------------------------------------------------------------------- + ! to wav: ocean currents from ocn + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compocn)%flds, 'So_u') + call addfld(fldListTo(compwav)%flds, 'So_u') + else + if ( fldchk(is_local%wrap%FBImp(compocn, compocn), 'So_u', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compwav) , 'So_u', rc=rc)) then + ! By default will be using a custom map - but if one is not available, use a generated bilinear instead + call addmap(fldListFr(compocn)%flds, 'So_u', compwav, mapbilnr, 'one', ocn2wav_smap) + call addmrg(fldListTo(compwav)%flds, 'So_u', mrg_from=compocn, mrg_fld='So_u', mrg_type='copy') end if - end do - deallocate(flds) + end if + if (phase == 'advertise') then + call addfld(fldListFr(compocn)%flds, 'So_v') + call addfld(fldListTo(compwav)%flds, 'So_v') + else + if ( fldchk(is_local%wrap%FBImp(compocn, compocn), 'So_v', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compwav) , 'So_v', rc=rc)) then + ! By default will be using a custom map - but if one is not available, use a generated bilinear instead + call addmap(fldListFr(compocn)%flds, 'So_v', compwav, mapbilnr, 'one', ocn2wav_smap) + call addmrg(fldListTo(compwav)%flds, 'So_v', mrg_from=compocn, mrg_fld='So_v', mrg_type='copy') + end if + end if ! --------------------------------------------------------------------- - ! to wav: zonal wind at the lowest model level from atm - ! to wav: meridional wind at the lowest model level from atm + ! to wav: ocean boundary layer depth from ocn ! --------------------------------------------------------------------- - allocate(flds(3)) - flds = (/'Sa_u ', 'Sa_v ', 'Sa_tbot'/) + if (phase == 'advertise') then + call addfld(fldListFr(compocn)%flds, 'So_bldepth') + call addfld(fldListTo(compwav)%flds, 'So_bldepth') + else + if ( fldchk(is_local%wrap%FBImp(compocn, compocn), 'So_bldepth', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compwav) , 'So_bldepth', rc=rc)) then + ! By default will be using a custom map - but if one is not available, use a generated bilinear instead + call addmap(fldListFr(compocn)%flds, 'So_bldepth', compwav, mapbilnr, 'one', ocn2wav_smap) + call addmrg(fldListTo(compwav)%flds, 'So_bldepth', mrg_from=compocn, mrg_fld='So_bldepth', mrg_type='copy') + end if + end if - do n = 1,size(flds) - fldname = trim(flds(n)) - if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, trim(fldname)) - call addfld(fldListTo(compwav)%flds, trim(fldname)) - else - if ( fldchk(is_local%wrap%FBexp(compwav) , trim(fldname), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm ), trim(fldname), rc=rc)) then - call addmap(fldListFr(compatm)%flds, trim(fldname), compwav, mapbilnr, 'one', atm2wav_smap) - call addmrg(fldListTo(compwav)%flds, trim(fldname), & - mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') - end if + ! --------------------------------------------------------------------- + ! to wav: zonal and meridional winds at the lowest model level from atm + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Sa_u') + call addfld(fldListTo(compwav)%flds, 'Sa_u') + else + if ( fldchk(is_local%wrap%FBexp(compwav) , 'Sa_u', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_u', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Sa_u', compwav, mapbilnr, 'one', atm2wav_map) + call addmrg(fldListTo(compwav)%flds, 'Sa_u', mrg_from=compatm, mrg_fld='Sa_u', mrg_type='copy') + end if + end if + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Sa_v') + call addfld(fldListTo(compwav)%flds, 'Sa_v') + else + if ( fldchk(is_local%wrap%FBexp(compwav) , 'Sa_v', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_v', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Sa_v', compwav, mapbilnr, 'one', atm2wav_map) + call addmrg(fldListTo(compwav)%flds, 'Sa_v', mrg_from=compatm, mrg_fld='Sa_v', mrg_type='copy') end if - end do - deallocate(flds) + end if + + ! --------------------------------------------------------------------- + ! to wav: temperature at lowest model level from atm + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Sa_tbot') + call addfld(fldListTo(compwav)%flds, 'Sa_tbot') + else + if ( fldchk(is_local%wrap%FBexp(compwav) , 'Sa_tbot', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_tbot', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Sa_tbot', compwav, mapbilnr, 'one', atm2wav_map) + call addmrg(fldListTo(compwav)%flds, 'Sa_tbot', mrg_from=compatm, mrg_fld='Sa_tbot', mrg_type='copy') + end if + end if !===================================================================== ! FIELDS TO RIVER (comprof) @@ -1723,35 +2855,89 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! --------------------------------------------------------------------- ! to rof: water flux from land (liquid surface) + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(complnd)%flds, 'Flrl_rofsur') + call addfld(fldListTo(comprof)%flds, 'Flrl_rofsur') + else + if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_rofsur', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_rofsur', rc=rc)) then + call addmap(fldListFr(complnd)%flds, 'Flrl_rofsur', comprof, mapconsf, 'lfrac', lnd2rof_map) + call addmrg(fldListTo(comprof)%flds, 'Flrl_rofsur', & + mrg_from=complnd, mrg_fld='Flrl_rofsur', mrg_type='copy_with_weights', mrg_fracname='lfrac') + end if + end if + + ! --------------------------------------------------------------------- ! to rof: water flux from land (liquid glacier, wetland, and lake) + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(complnd)%flds, 'Flrl_rofgwl') + call addfld(fldListTo(comprof)%flds, 'Flrl_rofgwl') + else + if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_rofgwl', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_rofgwl', rc=rc)) then + call addmap(fldListFr(complnd)%flds, 'Flrl_rofgwl', comprof, mapconsf, 'lfrac', lnd2rof_map) + call addmrg(fldListTo(comprof)%flds, 'Flrl_rofgwl', & + mrg_from=complnd, mrg_fld='Flrl_rofgwl', mrg_type='copy_with_weights', mrg_fracname='lfrac') + end if + end if + + ! --------------------------------------------------------------------- ! to rof: water flux from land (liquid subsurface) - ! to rof: water flux from land direct to ocean - ! to rof: irrigation flux from land (withdrawal from rivers) ! --------------------------------------------------------------------- - ! TODO (mvertens, 2019-01-13): the following isotopes have not yet been defined in the NUOPC field dict - ! allocate(flds(12)) - ! flds = (/'Flrl_rofsur', 'Flrl_rofsur_wiso', 'Flrl_rofgwl', 'Flrl_rofgwl_wiso', & - ! 'Flrl_rofsub', 'Flrl_rofsub_wiso', 'Flrl_rofdto', 'Flrl_rofdto_wiso', & - ! 'Flrl_rofi' , 'Flrl_rofi_wiso' , 'Flrl_irrig' , 'Flrl_irrig_wiso' /) + if (phase == 'advertise') then + call addfld(fldListFr(complnd)%flds, 'Flrl_rofsub') + call addfld(fldListTo(comprof)%flds, 'Flrl_rofsub') + else + if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_rofsub', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_rofsub', rc=rc)) then + call addmap(fldListFr(complnd)%flds, 'Flrl_rofsub', comprof, mapconsf, 'lfrac', lnd2rof_map) + call addmrg(fldListTo(comprof)%flds, 'Flrl_rofsub', & + mrg_from=complnd, mrg_fld='Flrl_rofsub', mrg_type='copy_with_weights', mrg_fracname='lfrac') + end if + end if + if (phase == 'advertise') then + call addfld(fldListFr(complnd)%flds, 'Flrl_rofdto') + call addfld(fldListTo(comprof)%flds, 'Flrl_rofdto') + else + if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_rofdto', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_rofdto', rc=rc)) then + call addmap(fldListFr(complnd)%flds, 'Flrl_rofdto', comprof, mapconsf, 'lfrac', lnd2rof_map) + call addmrg(fldListTo(comprof)%flds, 'Flrl_rofdto', & + mrg_from=complnd, mrg_fld='Flrl_rofdto', mrg_type='copy_with_weights', mrg_fracname='lfrac') + end if + end if - allocate(flds(6)) - flds = (/'Flrl_rofsur', 'Flrl_rofgwl', 'Flrl_rofsub', 'Flrl_rofdto', 'Flrl_rofi ', 'Flrl_irrig '/) + ! --------------------------------------------------------------------- + ! to rof: water flux from land direct to ocean + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(complnd)%flds, 'Flrl_rofi') + call addfld(fldListTo(comprof)%flds, 'Flrl_rofi') + else + if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_rofi', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_rofi', rc=rc)) then + call addmap(fldListFr(complnd)%flds, 'Flrl_rofi', comprof, mapconsf, 'lfrac', lnd2rof_map) + call addmrg(fldListTo(comprof)%flds, 'Flrl_rofi', & + mrg_from=complnd, mrg_fld='Flrl_rofi', mrg_type='copy_with_weights', mrg_fracname='lfrac') + end if + end if - do n = 1,size(flds) - fldname = trim(flds(n)) - if (phase == 'advertise') then - call addfld(fldListFr(complnd)%flds, trim(fldname)) - call addfld(fldListTo(comprof)%flds, trim(fldname)) - else - if ( fldchk(is_local%wrap%FBImp(complnd, complnd), trim(fldname), rc=rc) .and. & - fldchk(is_local%wrap%FBExp(comprof) , trim(fldname), rc=rc)) then - call addmap(fldListFr(complnd)%flds, trim(fldname), comprof, mapconsf, 'lfrac', lnd2rof_fmap) - call addmrg(fldListTo(comprof)%flds, trim(fldname), & - mrg_from=complnd, mrg_fld=trim(fldname), mrg_type='copy_with_weights', mrg_fracname='lfrac') - end if + ! --------------------------------------------------------------------- + ! to rof: irrigation flux from land (withdrawal from rivers) + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(complnd)%flds, 'Flrl_irrig') + call addfld(fldListTo(comprof)%flds, 'Flrl_irrig') + else + if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_irrig', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_irrig', rc=rc)) then + call addmap(fldListFr(complnd)%flds, 'Flrl_irrig', comprof, mapconsf, 'lfrac', lnd2rof_map) + call addmrg(fldListTo(comprof)%flds, 'Flrl_irrig', & + mrg_from=complnd, mrg_fld='Flrl_irrig', mrg_type='copy_with_weights', mrg_fracname='lfrac') end if - end do - deallocate(flds) + end if !===================================================================== ! FIELDS TO LAND-ICE (compglc) @@ -1844,8 +3030,8 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addfld(fldListTo(complnd)%flds, 'Sa_co2prog') call addfld(fldListTo(compocn)%flds, 'Sa_co2prog') else - call addmap(fldListFr(compatm)%flds, 'Sa_co2prog', complnd, mapbilnr, 'one', atm2lnd_smap) - call addmap(fldListFr(compatm)%flds, 'Sa_co2prog', compocn, mapbilnr, 'one', atm2ocn_smap) + call addmap(fldListFr(compatm)%flds, 'Sa_co2prog', complnd, mapbilnr, 'one', atm2lnd_map) + call addmap(fldListFr(compatm)%flds, 'Sa_co2prog', compocn, mapbilnr, 'one', atm2ocn_map) call addmrg(fldListTo(complnd)%flds, 'Sa_co2prog', & mrg_from=compatm, mrg_fld='Sa_co2prog', mrg_type='copy') @@ -1861,8 +3047,8 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addfld(fldListTo(complnd)%flds, 'Sa_co2diag') call addfld(fldListTo(compocn)%flds, 'Sa_co2diag') else - call addmap(fldListFr(compatm)%flds, 'Sa_co2diag', complnd, mapbilnr, 'one', atm2lnd_smap) - call addmap(fldListFr(compatm)%flds, 'Sa_co2diag', compocn, mapbilnr, 'one', atm2ocn_smap) + call addmap(fldListFr(compatm)%flds, 'Sa_co2diag', complnd, mapbilnr, 'one', atm2lnd_map) + call addmap(fldListFr(compatm)%flds, 'Sa_co2diag', compocn, mapbilnr, 'one', atm2ocn_map) call addmrg(fldListTo(complnd)%flds, 'Sa_co2diag', & mrg_from=compatm, mrg_fld='Sa_co2diag', mrg_type='copy') @@ -1879,7 +3065,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addfld(fldListFr(compatm)%flds, 'Sa_co2prog') call addfld(fldListTo(complnd)%flds, 'Sa_co2prog') else - call addmap(fldListFr(compatm)%flds, 'Sa_co2prog', complnd, mapbilnr, 'one', atm2lnd_smap) + call addmap(fldListFr(compatm)%flds, 'Sa_co2prog', complnd, mapbilnr, 'one', atm2lnd_map) call addmrg(fldListTo(complnd)%flds, 'Sa_co2prog', & mrg_from=compatm, mrg_fld='Sa_co2prog', mrg_type='copy') end if @@ -1891,7 +3077,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addfld(fldListFr(compatm)%flds, 'Sa_co2diag') call addfld(fldListTo(complnd)%flds, 'Sa_co2diag') else - call addmap(fldListFr(compatm)%flds, 'Sa_co2diag', complnd, mapbilnr, 'one', atm2lnd_smap) + call addmap(fldListFr(compatm)%flds, 'Sa_co2diag', complnd, mapbilnr, 'one', atm2lnd_map) call addmrg(fldListTo(complnd)%flds, 'Sa_co2diag', & mrg_from=compatm, mrg_fld='Sa_co2diag', mrg_type='copy') end if @@ -1903,7 +3089,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addfld(fldListFr(complnd)%flds, 'Fall_fco2_lnd') call addfld(fldListTo(compatm)%flds, 'Fall_fco2_lnd') else - call addmap(fldListFr(complnd)%flds, 'Fall_fco2_lnd', compatm, mapconsf, 'one', lnd2atm_fmap) + call addmap(fldListFr(complnd)%flds, 'Fall_fco2_lnd', compatm, mapconsf, 'one', lnd2atm_map) call addmrg(fldListTo(compatm)%flds, 'Fall_fco2_lnd', & mrg_from=complnd, mrg_fld='Fall_fco2_lnd', mrg_type='copy_with_weights', mrg_fracname='lfrac') end if @@ -1918,8 +3104,8 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addfld(fldListTo(complnd)%flds, 'Sa_co2prog') call addfld(fldListTo(compocn)%flds, 'Sa_co2prog') else - call addmap(fldListFr(compatm)%flds, 'Sa_co2prog', complnd, mapbilnr, 'one', atm2lnd_smap) - call addmap(fldListFr(compatm)%flds, 'Sa_co2prog', compocn, mapbilnr, 'one', atm2ocn_smap) + call addmap(fldListFr(compatm)%flds, 'Sa_co2prog', complnd, mapbilnr, 'one', atm2lnd_map) + call addmap(fldListFr(compatm)%flds, 'Sa_co2prog', compocn, mapbilnr, 'one', atm2ocn_map) call addmrg(fldListTo(complnd)%flds, 'Sa_co2prog', & mrg_from=compatm, mrg_fld='Sa_co2prog', mrg_type='copy') @@ -1935,8 +3121,8 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addfld(fldListTo(complnd)%flds, 'Sa_co2diag') call addfld(fldListTo(compocn)%flds, 'Sa_co2diag') else - call addmap(fldListFr(compatm)%flds, 'Sa_co2diag', complnd, mapbilnr, 'one', atm2lnd_smap) - call addmap(fldListFr(compatm)%flds, 'Sa_co2diag', compocn, mapbilnr, 'one', atm2ocn_smap) + call addmap(fldListFr(compatm)%flds, 'Sa_co2diag', complnd, mapbilnr, 'one', atm2lnd_map) + call addmap(fldListFr(compatm)%flds, 'Sa_co2diag', compocn, mapbilnr, 'one', atm2ocn_map) call addmrg(fldListTo(complnd)%flds, 'Sa_co2diag', & mrg_from=compatm, mrg_fld='Sa_co2diag', mrg_type='copy') @@ -1951,7 +3137,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addfld(fldListFr(complnd)%flds, 'Fall_fco2_lnd') call addfld(fldListTo(compatm)%flds, 'Fall_fco2_lnd') else - call addmap(fldListFr(complnd)%flds, 'Fall_fco2_lnd', compatm, mapconsf, 'one', lnd2atm_fmap) + call addmap(fldListFr(complnd)%flds, 'Fall_fco2_lnd', compatm, mapconsf, 'one', lnd2atm_map) call addmrg(fldListTo(compatm)%flds, 'Fall_fco2_lnd', & mrg_from=complnd, mrg_fld='Fall_fco2_lnd', mrg_type='copy_with_weights', mrg_fracname='lfrac') end if @@ -1963,7 +3149,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addfld(fldListFr(compocn)%flds, 'Faoo_fco2_ocn') call addfld(fldListTo(compatm)%flds, 'Faoo_fco2_ocn') else - call addmap(fldListFr(compocn)%flds, 'Faoo_fco2_ocn', compatm, mapconsd, 'one', ocn2atm_fmap) + call addmap(fldListFr(compocn)%flds, 'Faoo_fco2_ocn', compatm, mapconsd, 'one', ocn2atm_map) ! custom merge in med_phases_prep_atm end if endif @@ -1971,14 +3157,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) !----------------------------------------------------------------------------- ! CARMA fields (volumetric soil water) !----------------------------------------------------------------------------- - ! TODO: add this - ! if (carma_flds /= ' ') then - ! do n = 1,)number_of_fields in carm_flds) - ! call addfld(fldListFr(complnd)%flds, trim(fldname)) - ! call addmap(fldListFr(complnd)%flds, trim(fldname), compatm, mapconsf, 'one',lnd2atm_smap) - ! call addfld(fldListTo(compatm)%flds, trim(fldname), mrg_from=complnd, mrg_fld=trim(fldname), mrg_type='copy') - ! enddo - ! endif + ! TODO (mvertens, 2021-07-25): add this end subroutine esmFldsExchange_cesm diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index 1a4889bc0..85e2101c6 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -318,6 +318,10 @@ canonical_units: 1e-6 mol/mol description: atmosphere export - prognostic CO2 at the lowest model level # + - standard_name: Sa_o3 + canonical_units: mol/mol + description: atmosphere export - O3 in the lowest model layer (prognosed or prescribed) + # - standard_name: Sa_topo alias: inst_surface_height canonical_units: m diff --git a/mediator/med.F90 b/mediator/med.F90 index 030848cb0..6abc48aaa 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -33,8 +33,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 ! compglc is an array - use esmFlds , only : fldListMed_ocnalb, fldListMed_aoflux + use esmFlds , only : num_icesheets, max_icesheets, compglc, ocn2glc_coupling, lnd2glc_coupling ! compglc is an array + 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 use esmFlds , only : coupling_mode @@ -859,6 +859,14 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end do + ! Determine aoflux grid + call NUOPC_CompAttributeGet(gcomp, name='aoflux_grid', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (.not. isPresent .and. .not. isSet) then + cvalue = 'ogrid' + end if + is_local%wrap%aoflux_grid = trim(cvalue) + !------------------ ! Initialize mediator flds !------------------ @@ -1812,8 +1820,7 @@ subroutine DataInitialize(gcomp, rc) ! -- Create mediator specific field bundles (not part of import/export states) ! -- Initialize FBExpAccums (to zero), and FBImp (from NStateImp) ! -- Read mediator restarts - ! -- Initialize route handles - ! -- Initialize field bundles for normalization + ! -- Initialize route handles field bundles for normalization ! -- return! ! For second loop: ! -- Copy import fields to local FBs @@ -1836,6 +1843,7 @@ subroutine DataInitialize(gcomp, rc) use NUOPC , only : NUOPC_CompAttributeGet use med_fraction_mod , only : med_fraction_init, med_fraction_set use med_phases_restart_mod , only : med_phases_restart_read + use med_phases_prep_glc_mod , only : med_phases_prep_glc_init 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 @@ -1845,11 +1853,12 @@ subroutine DataInitialize(gcomp, rc) 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 + use med_phases_aofluxes_mod , only : med_phases_aofluxes_run, 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_mapnorm_init, med_map_routehandles_init, med_map_packed_field_create + use med_map_mod , only : med_map_routehandles_init, med_map_packed_field_create use med_io_mod , only : med_io_init + use esmFlds , only : fldListMed_aoflux ! input/output variables type(ESMF_GridComp) :: gcomp @@ -2033,7 +2042,7 @@ subroutine DataInitialize(gcomp, rc) endif enddo - ! Reset ocn2glc coupling based in input attribute + ! Reset ocn2glc active coupling based in input attribute if (.not. ocn2glc_coupling) then do ns = 1,num_icesheets is_local%wrap%med_coupling_active(compocn,compglc(ns)) = .false. @@ -2116,10 +2125,10 @@ subroutine DataInitialize(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Create mesh info data - call ESMF_FieldBundleGet(is_local%wrap%FBImp(n1,n1), fieldCount=fieldCount, rc=rc) + call ESMF_FieldBundleGet(is_local%wrap%FBImp(n1,n1), fieldCount=fieldCount, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (fieldCount == 0) then + if (fieldCount == 0) then if (mastertask) then write(logunit,*) trim(subname)//' '//trim(compname(n1))//' import FB field count is = ', fieldCount write(logunit,*) trim(subname)//' '//trim(compname(n1))//' trying to use export FB' @@ -2138,7 +2147,6 @@ subroutine DataInitialize(gcomp, rc) ! The following are FBImp and FBImpAccum mapped to different grids. ! FBImp(n1,n1) and FBImpAccum(n1,n1) are handled above - do n2 = 1,ncomps if (n1 /= n2 .and. & is_local%wrap%med_coupling_active(n1,n2) .and. & @@ -2154,7 +2162,7 @@ subroutine DataInitialize(gcomp, rc) ! to provide mesh information call State_GetNumFields(is_local%wrap%NStateImp(n2), fieldCount, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (fieldCount == 0) then + if (fieldCount == 0) then call FB_init(is_local%wrap%FBImp(n1,n2), is_local%wrap%flds_scalar_name, & STgeom=is_local%wrap%NStateExp(n2), & STflds=is_local%wrap%NStateImp(n1), & @@ -2182,7 +2190,7 @@ subroutine DataInitialize(gcomp, rc) enddo ! loop over n1 !--------------------------------------- - ! Initialize field bundles needed for ocn albedo and ocn/atm flux calculations + ! Initialize field bundles needed for ocn albedo calculation !--------------------------------------- ! NOTE: the NStateImp(compocn) or NStateImp(compatm) used below @@ -2190,29 +2198,22 @@ subroutine DataInitialize(gcomp, rc) ! contain control data and no grid information if if the target ! component (n2) is not prognostic only receives control data back - ! NOTE: this section must be done BEFORE the call to esmFldsExchange + ! NOTE: this section must be done BEFORE the second call to esmFldsExchange ! Create field bundles for mediator ocean albedo computation if ( is_local%wrap%med_coupling_active(compocn,compatm) .or. is_local%wrap%med_coupling_active(compatm,compocn)) then - ! Create field bundles for mediator ocean albedo computation fieldCount = med_fldList_GetNumFlds(fldListMed_ocnalb) if (fieldCount > 0) then - if (.not. is_local%wrap%med_coupling_active(compatm,compocn)) then - is_local%wrap%med_coupling_active(compatm,compocn) = .true. - end if - allocate(fldnames(fieldCount)) call med_fldList_getfldnames(fldListMed_ocnalb%flds, fldnames, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_init(is_local%wrap%FBMed_ocnalb_a, is_local%wrap%flds_scalar_name, & STgeom=is_local%wrap%NStateImp(compatm), fieldnamelist=fldnames, name='FBMed_ocnalb_a', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (mastertask) then write(logunit,'(a)') trim(subname)//' initializing FB FBMed_ocnalb_a' end if - call FB_init(is_local%wrap%FBMed_ocnalb_o, is_local%wrap%flds_scalar_name, & STgeom=is_local%wrap%NStateImp(compocn), fieldnamelist=fldnames, name='FBMed_ocnalb_o', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -2220,49 +2221,35 @@ subroutine DataInitialize(gcomp, rc) write(logunit,'(a)') trim(subname)//' initializing FB FBMed_ocnalb_o' end if deallocate(fldnames) - - ! The following assumes that the mediator atm/ocn flux calculation will be done on the ocean grid - if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compatm,compocn), rc=rc)) then - if (mastertask) then - write(logunit,'(a)') trim(subname)//' creating field bundle FBImp(compatm,compocn)' - end if - call FB_init(is_local%wrap%FBImp(compatm,compocn), is_local%wrap%flds_scalar_name, & - STgeom=is_local%wrap%NStateImp(compocn), & - STflds=is_local%wrap%NStateImp(compatm), & - name='FBImp'//trim(compname(compatm))//'_'//trim(compname(compocn)), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - if (mastertask) then - write(logunit,'(a)') trim(subname)//' initializing FBs for '// & - trim(compname(compatm))//'_'//trim(compname(compocn)) - end if end if + end if - ! Create field bundles for mediator ocean/atmosphere flux computation - fieldCount = med_fldList_GetNumFlds(fldListMed_aoflux) - if (fieldCount > 0) then - allocate(fldnames(fieldCount)) - call med_fldList_getfldnames(fldListMed_aoflux%flds, fldnames, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + !--------------------------------------- + ! Initialize field bundles needed for atm/ocn flux computation: + ! is_local%wrap%FBMed_aoflux_a and is_local%wrap%FBMed_aoflux_o + !--------------------------------------- - call FB_init(is_local%wrap%FBMed_aoflux_a, is_local%wrap%flds_scalar_name, & - STgeom=is_local%wrap%NStateImp(compatm), fieldnamelist=fldnames, name='FBMed_aoflux_a', rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (mastertask) then - write(logunit,'(a)') trim(subname)//' initializing FB FBMed_aoflux_a' - end if + ! NOTE: this section must be done BEFORE the second call to esmFldsExchange + ! Create field bundles for mediator ocean albedo computation - call FB_init(is_local%wrap%FBMed_aoflux_o, is_local%wrap%flds_scalar_name, & - STgeom=is_local%wrap%NStateImp(compocn), fieldnamelist=fldnames, name='FBMed_aoflux_o', rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (mastertask) then - write(logunit,'(a)') trim(subname)//' initializing FB FBMed_aoflux_o' + fieldCount = med_fldList_GetNumFlds(fldListMed_aoflux) + if ( fieldCount > 0 ) then + if ( is_local%wrap%med_coupling_active(compocn,compatm) .or. & + is_local%wrap%med_coupling_active(compatm,compocn)) then + if ( is_local%wrap%aoflux_grid == 'ogrid' .and. .not. & + is_local%wrap%med_coupling_active(compatm,compocn)) then + is_local%wrap%med_coupling_active(compatm,compocn) = .true. end if - deallocate(fldnames) + if ( is_local%wrap%aoflux_grid == 'agrid' .and. .not. & + is_local%wrap%med_coupling_active(compocn,compatm)) then + is_local%wrap%med_coupling_active(compocn,compatm) = .true. + end if + call med_phases_aofluxes_init_fldbuns(gcomp, rc=rc) end if end if !--------------------------------------- + ! Second call to esmFldsExchange_xxx ! Determine mapping and merging info for field exchanges in mediator !--------------------------------------- @@ -2281,19 +2268,15 @@ subroutine DataInitialize(gcomp, rc) !--------------------------------------- ! Initialize route handles and required normalization field bunds - ! Initialized packed field data structures !--------------------------------------- - call ESMF_LogWrite("before med_map_RouteHandles_init", ESMF_LOGMSG_INFO) call med_map_RouteHandles_init(gcomp, is_local%wrap%flds_scalar_name, logunit, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite("after med_map_RouteHandles_init", ESMF_LOGMSG_INFO) - call ESMF_LogWrite("before med_map_mapnorm_init", ESMF_LOGMSG_INFO) - call med_map_mapnorm_init(gcomp, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite("after med_map_mapnorm_init", ESMF_LOGMSG_INFO) - + !--------------------------------------- + ! Initialized packed field data structures + !--------------------------------------- do ndst = 1,ncomps do nsrc = 1,ncomps if (is_local%wrap%med_coupling_active(nsrc,ndst)) then @@ -2307,16 +2290,6 @@ subroutine DataInitialize(gcomp, rc) end if end do end do - if ( ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_o) .and. & - ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a)) then - call med_map_packed_field_create(compatm, & - is_local%wrap%flds_scalar_name, & - fldsSrc=fldListMed_aoflux%flds, & - FBSrc=is_local%wrap%FBMed_aoflux_o, & - FBDst=is_local%wrap%FBMed_aoflux_a, & - packed_data=is_local%wrap%packed_data_aoflux_o2a(:), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if if ( ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o) .and. & ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_a)) then call med_map_packed_field_create(compatm, & @@ -2328,6 +2301,20 @@ subroutine DataInitialize(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if + !--------------------------------------- + ! Initialize glc module field bundles here if appropriate + !--------------------------------------- + do ns = 1,num_icesheets + if (is_local%wrap%med_coupling_active(complnd,compglc(ns))) then + lnd2glc_coupling = .true. + exit + end if + end do + if (lnd2glc_coupling .or. ocn2glc_coupling) then + call med_phases_prep_glc_init(gcomp, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + !--------------------------------------- ! Set the data initialize flag to false !--------------------------------------- @@ -2648,13 +2635,14 @@ end subroutine DataInitialize !----------------------------------------------------------------------------- subroutine SetRunClock(gcomp, rc) - use ESMF , only : ESMF_GridComp, ESMF_CLOCK, ESMF_Time, ESMF_TimeInterval - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_ClockGet, ESMF_ClockSet - use ESMF , only : ESMF_Success, ESMF_Failure - use ESMF , only : ESMF_Alarm, ESMF_ALARMLIST_ALL, ESMF_ClockGetAlarmList - use ESMF , only : ESMF_AlarmCreate, ESMF_AlarmSet, ESMF_ClockAdvance - use NUOPC , only : NUOPC_CompCheckSetClock, NUOPC_CompAttributeGet - use NUOPC_Mediator , only : NUOPC_MediatorGet + use ESMF , only : ESMF_GridComp, ESMF_CLOCK, ESMF_Time, ESMF_TimeInterval + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_ClockGet, ESMF_ClockSet + use ESMF , only : ESMF_Success, ESMF_Failure + use ESMF , only : ESMF_Alarm, ESMF_ALARMLIST_ALL, ESMF_ClockGetAlarmList + use ESMF , only : ESMF_AlarmCreate, ESMF_AlarmSet, ESMF_ClockAdvance + use ESMF , only : ESMF_ClockGetAlarmList + use NUOPC , only : NUOPC_CompCheckSetClock, NUOPC_CompAttributeGet + use NUOPC_Mediator , only : NUOPC_MediatorGet ! input/output variables type(ESMF_GridComp) :: gcomp @@ -2664,8 +2652,14 @@ subroutine SetRunClock(gcomp, rc) type(ESMF_Clock) :: mediatorClock, driverClock type(ESMF_Time) :: currTime type(ESMF_TimeInterval) :: timeStep + type(ESMF_Alarm) :: stop_alarm character(len=CL) :: cvalue + character(len=CL) :: name, stop_option + integer :: stop_n, stop_ymd logical :: first_time = .true. + logical, save :: stopalarmcreated=.false. + integer :: alarmcount + character(len=*),parameter :: subname=' (module_MED:SetRunClock) ' !----------------------------------------------------------- @@ -2696,9 +2690,24 @@ subroutine SetRunClock(gcomp, rc) endif ! check and set the component clock against the driver clock - call NUOPC_CompCheckSetClock(gcomp, driverClock, rc=rc) + call NUOPC_CompCheckSetClock(gcomp, driverClock, checkTimeStep=.false., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (.not. stopalarmcreated) then + call NUOPC_CompAttributeGet(gcomp, name="stop_option", value=stop_option, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(gcomp, name="stop_n", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) stop_n + 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, & + 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 !-------------------------------- diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index c996f4354..054a46a93 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -381,22 +381,6 @@ subroutine med_diag_init(gcomp, rc) allocate(budget_counter (f_size , c_size , p_size)) ! counter, valid only on root pe allocate(budget_global_1d(f_size * c_size * p_size)) ! needed for ESMF_VMReduce call - if (budget_print_inst + budget_print_daily + budget_print_month + budget_print_ann + budget_print_ltann + budget_print_ltend > 0) then - ! Set stop alarm (needed for budgets) - call NUOPC_CompAttributeGet(gcomp, name="stop_option", value=stop_option, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(gcomp, name="stop_n", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) stop_n - call NUOPC_CompAttributeGet(gcomp, name="stop_ymd", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) stop_ymd - call NUOPC_MediatorGet(gcomp, mediatorClock=mediatorClock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call alarmInit(mediatorclock, 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 - endif end subroutine med_diag_init integer function get_diag_attribute(gcomp, name, rc) @@ -1314,7 +1298,7 @@ subroutine med_phases_diag_ocn( gcomp, rc) ! Compute global ocn input from mediator ! ------------------------------------------------------------------ - use esmFlds, only : compocn + use esmFlds, only : compocn, compatm ! input/output variables type(ESMF_GridComp) :: gcomp @@ -1327,6 +1311,7 @@ subroutine med_phases_diag_ocn( gcomp, rc) real(r8), pointer :: ifrac(:) => null() ! ice fraction in ocean grid cell real(r8), pointer :: ofrac(:) => null() ! non-ice fraction nin ocean grid cell real(r8), pointer :: sfrac(:) => null() ! sum of ifrac and ofrac + real(r8), pointer :: sfrac_x_ofrac(:) => null() real(r8), pointer :: areas(:) => null() real(r8), pointer :: data(:) => null() type(ESMF_field) :: lfield @@ -1346,6 +1331,8 @@ subroutine med_phases_diag_ocn( gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return allocate(sfrac(size(ofrac))) sfrac(:) = ifrac(:) + ofrac(:) + allocate(sfrac_x_ofrac(size(ofrac))) + sfrac_x_ofrac(:) = sfrac(:) * ofrac(:) areas => is_local%wrap%mesh_info(compocn)%areas @@ -1390,8 +1377,20 @@ subroutine med_phases_diag_ocn( gcomp, rc) budget_local(f_area,ic,ip) = budget_local(f_area,ic,ip) + areas(n)*ofrac(n) end do - call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_lwup' , f_heat_lwup , ic, areas, sfrac, budget_local, rc=rc) - call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_lat' , f_heat_latvap , ic, areas, sfrac, budget_local, rc=rc) + if (fldbun_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_lwnet', rc=rc)) then + call diag_ocn(is_local%wrap%FBMed_aoflux_o , 'Faox_lwup', f_heat_lwup, ic, areas, sfrac_x_ofrac, budget_local, rc=rc) + call diag_ocn(is_local%wrap%FBImp(compatm,compocn), 'Faxa_lwdn', f_heat_lwdn, ic, areas, sfrac_x_ofrac, budget_local, rc=rc) + else + call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_lwup' , f_heat_lwup , ic, areas, sfrac, budget_local, rc=rc) + call diag_ocn(is_local%wrap%FBExp(compocn), 'Faxa_lwdn' , f_heat_lwdn , ic, areas, sfrac, budget_local, rc=rc) + end if + + if (fldbun_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_lat', rc=rc)) then + call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_lat' , f_heat_latvap , ic, areas, sfrac, budget_local, rc=rc) + else + call diag_ocn(is_local%wrap%FBMed_aoflux_o, 'Faox_lat' , f_heat_latvap , ic, areas, sfrac_x_ofrac, budget_local, rc=rc) + end if + call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_sen' , f_heat_sen , ic, areas, sfrac, budget_local, rc=rc) call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_evap' , f_watr_evap , ic, areas, sfrac, budget_local, rc=rc) call diag_ocn(is_local%wrap%FBExp(compocn), 'Fioi_meltw', f_watr_melt , ic, areas, sfrac, budget_local, rc=rc) @@ -1400,8 +1399,19 @@ subroutine med_phases_diag_ocn( gcomp, rc) call diag_ocn(is_local%wrap%FBExp(compocn), 'Fioi_bergh', f_heat_melt , ic, areas, sfrac, budget_local, rc=rc) call diag_ocn(is_local%wrap%FBExp(compocn), 'Fioi_salt' , f_watr_salt , ic, areas, sfrac, budget_local, & scale=SFLXtoWFLX, rc=rc) - call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_swnet', f_heat_swnet , ic, areas, sfrac, budget_local, rc=rc) - call diag_ocn(is_local%wrap%FBExp(compocn), 'Faxa_lwdn' , f_heat_lwdn , ic, areas, sfrac, budget_local, rc=rc) + + if (fldbun_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet', rc=rc)) then + call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_swnet', f_heat_swnet , ic, areas, sfrac, budget_local, rc=rc) + else if (fldbun_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdr', rc=rc) .and. & + fldbun_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdf', rc=rc) .and. & + fldbun_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idr', rc=rc) .and. & + fldbun_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idf', rc=rc)) then + call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdr', f_heat_swnet , ic, areas, sfrac, budget_local, rc=rc) + call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdf', f_heat_swnet , ic, areas, sfrac, budget_local, rc=rc) + call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idr', f_heat_swnet , ic, areas, sfrac, budget_local, rc=rc) + call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idf', f_heat_swnet , ic, areas, sfrac, budget_local, rc=rc) + end if + call diag_ocn(is_local%wrap%FBExp(compocn), 'Faxa_rain' , f_watr_rain , ic, areas, sfrac, budget_local, rc=rc) call diag_ocn(is_local%wrap%FBExp(compocn), 'Faxa_snow' , f_watr_snow , ic, areas, sfrac, budget_local, rc=rc) call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_rofl' , f_watr_roff , ic, areas, sfrac, budget_local, rc=rc) @@ -1544,10 +1554,26 @@ subroutine med_phases_diag_ice_ice2med( gcomp, rc) areas, lats, ifrac, budget_local, minus=.true., rc=rc) call diag_ice_recv(is_local%wrap%FBImp(compice,compice), 'Fioi_salt', f_watr_salt, & areas, lats, ifrac, budget_local, minus=.true., scale=SFLXtoWFLX, rc=rc) - call diag_ice_recv(is_local%wrap%FBImp(compice,compice), 'Fioi_swpen', f_heat_swnet, & - areas, lats, ifrac, budget_local, minus=.true., rc=rc) + + if ( fldbun_fldchk(is_local%wrap%FBImp(compice,compice), 'Fioi_swpen_vdr', rc=rc) .and. & + fldbun_fldchk(is_local%wrap%FBImp(compice,compice), 'Fioi_swpen_vdf', rc=rc) .and. & + fldbun_fldchk(is_local%wrap%FBImp(compice,compice), 'Fioi_swpen_idr', rc=rc) .and. & + fldbun_fldchk(is_local%wrap%FBImp(compice,compice), 'Fioi_swpen_idf', rc=rc)) then + call diag_ice_recv(is_local%wrap%FBImp(compice,compice), 'Fioi_swpen_vdr', f_heat_swnet, & + areas, lats, ifrac, budget_local, minus=.true., rc=rc) + call diag_ice_recv(is_local%wrap%FBImp(compice,compice), 'Fioi_swpen_vdf', f_heat_swnet, & + areas, lats, ifrac, budget_local, minus=.true., rc=rc) + call diag_ice_recv(is_local%wrap%FBImp(compice,compice), 'Fioi_swpen_idr', f_heat_swnet, & + areas, lats, ifrac, budget_local, minus=.true., rc=rc) + call diag_ice_recv(is_local%wrap%FBImp(compice,compice), 'Fioi_swpen_idf', f_heat_swnet, & + areas, lats, ifrac, budget_local, minus=.true., rc=rc) + else + call diag_ice_recv(is_local%wrap%FBImp(compice,compice), 'Fioi_swpen', f_heat_swnet, & + areas, lats, ifrac, budget_local, minus=.true., rc=rc) + end if call diag_ice_recv(is_local%wrap%FBImp(compice,compice), 'Faii_swnet', f_heat_swnet, & areas, lats, ifrac, budget_local, rc=rc) + call diag_ice_recv(is_local%wrap%FBImp(compice,compice), 'Faii_lwup', f_heat_lwup, & areas, lats, ifrac, budget_local, rc=rc) call diag_ice_recv(is_local%wrap%FBImp(compice,compice), 'Faii_lat', f_heat_latvap, & diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index da21c30f5..624637739 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -71,13 +71,16 @@ module med_internalstate_mod type(ESMF_FieldBundle) :: FBImp(ncomps,ncomps) ! Import data from various components interpolated to various grids type(ESMF_FieldBundle) :: FBExp(ncomps) ! Export data for various components, on their grid - ! Mediator field bundles + ! Mediator field bundles for ocean albedo type(ESMF_FieldBundle) :: FBMed_ocnalb_o ! Ocn albedo on ocn grid type(ESMF_FieldBundle) :: FBMed_ocnalb_a ! Ocn albedo on atm grid type(packed_data_type) :: packed_data_ocnalb_o2a(nmappers) ! packed data for mapping ocn->atm - type(ESMF_FieldBundle) :: FBMed_aoflux_o ! Ocn/Atm flux fields on ocn grid - type(ESMF_FieldBundle) :: FBMed_aoflux_a ! Ocn/Atm flux fields on atm grid + + ! Mediator field bundles and other info for atm/ocn flux computation + type(ESMF_FieldBundle) :: FBMed_aoflux_a ! Ocn/Atm flux output fields on atm grid + type(ESMF_FieldBundle) :: FBMed_aoflux_o ! Ocn/Atm flux output fields on ocn grid type(packed_data_type) :: packed_data_aoflux_o2a(nmappers) ! packed data for mapping ocn->atm + character(len=CS) :: aoflux_grid ! 'ogrid', 'agrid' or 'xgrid' ! Mapping type(ESMF_RouteHandle) :: RH(ncomps,ncomps,nmappers) ! Routehandles for pairs of components and different mappers diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index e95ecc11c..cc6a767d7 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -1234,7 +1234,7 @@ subroutine med_io_write_int1d(filename, iam, idata, dname, whead, wdata, file_in rcode = pio_put_att(io_file(lfile_ind),varid,"units",trim(cunit)) end if lnx = size(idata) - rcode = pio_def_dim(io_file(lfile_ind),trim(dname)//'_nx',lnx,dimid(1)) + 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) diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 897341956..4f8bda907 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -16,14 +16,13 @@ module med_map_mod ! public routines public :: med_map_routehandles_init public :: med_map_rh_is_created - public :: med_map_mapnorm_init public :: med_map_packed_field_create public :: med_map_field_packed public :: med_map_field_normalized public :: med_map_field interface med_map_routehandles_init - module procedure med_map_routehandles_initfrom_esmflds + module procedure med_map_routehandles_initfrom_esmflds ! called from med.F90 module procedure med_map_routehandles_initfrom_fieldbundle module procedure med_map_routehandles_initfrom_field end interface @@ -47,15 +46,17 @@ module med_map_mod subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogunit, rc) !--------------------------------------------- - ! Initialize route handles in the mediator + ! Initialize route handles in the mediator and also + ! nitialize unity normalization fields and do the mapping for + ! unity normalization up front + ! ! Assumptions: ! - Route handles are created per target field bundles NOT ! per individual fields in the bundle ! - ALL fields in the bundle are on identical grids ! - MULTIPLE route handles are going to be generated for ! given field bundle source and destination grids - ! - Route handles will ONLY be created if coupling is active - ! between n1 and n2 + ! - Route handles will ONLY be created if coupling_active is true between n1 and n2 ! Algorithm ! n1=source component index ! n2=destination component index @@ -74,11 +75,16 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun ! for the field !--------------------------------------------- - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_LogFlush - use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_Field - use ESMF , only : ESMF_FieldBundleGet - use esmFlds , only : fldListFr, ncomps, mapunset, compname - use med_methods_mod , only : med_methods_FB_getFieldN, med_methods_FB_getNameN + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_LogFlush + use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_Field + use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet, ESMF_FieldBundleCreate + use ESMF , only : ESMF_FieldBundleIsCreated + use ESMF , only : ESMF_Field, ESMF_FieldGet, ESMF_FieldCreate, ESMF_FieldDestroy + use ESMF , only : ESMF_Mesh, ESMF_TYPEKIND_R8, ESMF_MESHLOC_ELEMENT + use med_methods_mod , only : med_methods_FB_getFieldN, med_methods_FB_getNameN + use med_constants_mod , only : czero => med_constants_czero + use esmFlds , only : fldListFr, ncomps, mapunset, compname, compocn, compatm + use esmFlds , only : ncomps, nmappers, compname, mapnames, mapfcopy ! input/output variables type(ESMF_GridComp) :: gcomp @@ -87,15 +93,21 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun integer, intent(out) :: rc ! local variables - type(InternalState) :: is_local - type(ESMF_Field) :: fldsrc - type(ESMF_Field) :: flddst - integer :: n,n1,n2,m,nf,id,nflds - integer :: fieldCount - character(len=CX) :: mapfile - integer :: mapindex - logical :: mapexists = .false. - character(len=CX) :: fieldname + type(InternalState) :: is_local + type(ESMF_Field) :: fldsrc + type(ESMF_Field) :: flddst + integer :: n1,n2 + integer :: n,m,nf,id,nflds + integer :: fieldCount + character(len=CL) :: fieldname + type(ESMF_Field), pointer :: fieldlist(:) => null() + type(ESMF_Field) :: field_src + character(len=CX) :: mapfile + integer :: mapindex + logical :: mapexists = .false. + real(R8), pointer :: dataptr(:) => null() + type(ESMF_Mesh) :: mesh_src + type(ESMF_Mesh) :: mesh_dst character(len=*), parameter :: subname=' (module_med_map: RouteHandles_init) ' !----------------------------------------------------------- @@ -111,7 +123,10 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + ! -------------------------------------------------------------- ! Create the necessary route handles + ! -------------------------------------------------------------- + ! First loop over source and destination components components if (mastertask) write(logunit,*) ' ' do n1 = 1, ncomps @@ -122,15 +137,22 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun call med_methods_FB_getFieldN(is_local%wrap%FBImp(n1,n1), 1, fldsrc, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ! Check number of fields in FB and get destination field + ! Check number of fields in source FB on destination mesh and get destination field + if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(n1,n2))) then + call ESMF_LogWrite(trim(subname)//'FBImp('//trim(compname(n1))//','//trim(compname(n2))//')'// & + ' has not been created', ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE + return + end if call ESMF_FieldBundleGet(is_local%wrap%FBImp(n1,n2), fieldCount=fieldCount, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (fieldCount == 0) then call med_methods_FB_getFieldN(is_local%wrap%FBExp(n2), 1, flddst, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return else call med_methods_FB_getFieldN(is_local%wrap%FBImp(n1,n2), 1, flddst, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return end if - if (chkerr(rc,__LINE__,u_FILE_u)) return ! Loop over fields do nf = 1,size(fldListFr(n1)%flds) @@ -154,11 +176,96 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun end if ! end if mapindex is mapunset end do ! loop over fields - end if ! if coupling is active between n1 and n2 + end if ! if coupling active end if ! if n1 not equal to n2 end do ! loop over n2 end do ! loop over n1 + ! -------------------------------------------------------------- + ! Initialize unity normalization fields and do the mapping for + ! unity normalization up front + ! -------------------------------------------------------------- + + if (mastertask) then + write(logunit,*) + write(logunit,'(a)') trim(subname)//"Initializing unity map normalizations" + endif + + ! Create the destination normalization field + do n1 = 1,ncomps + + ! Since coupling could be uni-directional, the import FB could be + ! available but number of fields could be zero, so it is better to + ! check export FB if this is the case + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(n1,n1)) .or. & + ESMF_FieldBundleIsCreated(is_local%wrap%FBExp(n1))) then + + ! Get source mesh + call ESMF_FieldBundleGet(is_local%wrap%FBImp(n1,n1), fieldCount=fieldCount, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (fieldCount == 0) then + if (mastertask) then + write(logunit,*) trim(subname)//' '//trim(compname(n1))//' import FB field count is = ', fieldCount + write(logunit,*) trim(subname)//' '//trim(compname(n1))//' trying to use export FB' + end if + call ESMF_FieldBundleGet(is_local%wrap%FBExp(n1), fieldCount=fieldCount, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(fieldlist(fieldcount)) + call ESMF_FieldBundleGet(is_local%wrap%FBExp(n1), fieldlist=fieldlist, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + allocate(fieldlist(fieldcount)) + call ESMF_FieldBundleGet(is_local%wrap%FBImp(n1,n1), fieldlist=fieldlist, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + call ESMF_FieldGet(fieldlist(1), mesh=mesh_src, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + field_src = ESMF_FieldCreate(mesh_src, ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(field_src, farrayptr=dataPtr, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + dataptr(:) = 1.0_R8 + + ! Loop over destination components + do n2 = 1,ncomps + if ( n1 /= n2 .and. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(n1,n2)) .and. & + is_local%wrap%med_coupling_active(n1,n2)) then + + ! Get destination mesh + call ESMF_FieldBundleGet(is_local%wrap%FBImp(n1,n2), fieldlist=fieldlist, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(fieldlist(1), mesh=mesh_dst, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Create is_local%wrap%field_NormOne(n1,n2,mapindex) if appropriate (don't create if mapping is redist) + do mapindex = 1,nmappers + if (mapindex /= mapfcopy .and. med_map_RH_is_created(is_local%wrap%RH,n1,n2,mapindex,rc=rc)) then + is_local%wrap%field_NormOne(n1,n2,mapindex) = ESMF_FieldCreate(mesh_dst, & + ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(is_local%wrap%field_NormOne(n1,n2,mapindex), farrayptr=dataptr, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + dataptr(:) = czero + call med_map_field(field_src=field_src, field_dst=is_local%wrap%field_NormOne(n1,n2,mapindex), & + routehandles=is_local%wrap%RH(n1,n2,:), maptype=mapindex, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (mastertask) then + write(logunit,'(a)') trim(subname)//' created field_NormOne for '& + //compname(n1)//'->'//compname(n2)//' with mapping '//trim(mapnames(mapindex)) + end if + end if + end do ! end of loop over map_indiex mappers + end if ! end of if block for creating destination field + end do ! end of loop over n2 + + ! Deallocate memory + deallocate(fieldlist) + call ESMF_FieldDestroy(field_src, rc=rc, noGarbage=.true.) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + end if ! end of if-block for existence of field bundle + end do ! end of loop over n1 + if (dbug_flag > 1) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif @@ -517,14 +624,6 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, end if end if - ! Check that a valid route handle has been created - ! TODO: should this be implemented as an error check or ignored? - ! if (.not. med_map_RH_is_created(routehandle ,rc=rc)) then - ! string = trim(compname(n1))//"2"//trim(compname(n2))//'_weights' - ! call ESMF_LogWrite(trim(subname)//trim(string)//": failed RH "//trim(mapnames(mapindex)), & - ! ESMF_LOGMSG_INFO) - ! endif - ! Output route handle to file if requested if (rhprint) then if (mastertask) then @@ -610,140 +709,6 @@ logical function med_map_RH_is_created_RH1d(RHs,mapindex,rc) end function med_map_RH_is_created_RH1d - !================================================================================ - subroutine med_map_mapnorm_init(gcomp, rc) - - !--------------------------------------- - ! Initialize unity normalization fields and do the mapping for unity normalization up front - !--------------------------------------- - - use ESMF , only: ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_LogFlush - use ESMF , only: ESMF_GridComp - use ESMF , only: ESMF_Mesh, ESMF_TYPEKIND_R8, ESMF_MESHLOC_ELEMENT - use ESMF , only: ESMF_FieldBundle, ESMF_FieldBundleGet, ESMF_FieldBundleCreate - use ESMF , only: ESMF_FieldBundleIsCreated - use ESMF , only: ESMF_Field, ESMF_FieldGet, ESMF_FieldCreate, ESMF_FieldDestroy - use esmFlds , only: ncomps, nmappers, compname, mapnames - use med_constants_mod , only: czero => med_constants_czero - - ! input/output variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! local variables - type(InternalState) :: is_local - integer :: n1, n2, m - real(R8), pointer :: dataptr(:) => null() - integer :: fieldCount - type(ESMF_Field), pointer :: fieldlist(:) => null() - type(ESMF_Field) :: field_src - type(ESMF_Mesh) :: mesh_src - type(ESMF_Mesh) :: mesh_dst - character(len=*),parameter :: subname=' (module_MED_MAP:MapNorm_init)' - !----------------------------------------------------------- - - call t_startf('MED:'//subname) - rc = ESMF_SUCCESS - - if (dbug_flag > 1) then - call ESMF_LogWrite(trim(subname)//": start", ESMF_LOGMSG_INFO) - endif - if (mastertask) then - write(logunit,*) - write(logunit,'(a)') trim(subname)//"Initializing unity map normalizations" - endif - - ! Get the internal state from Component. - nullify(is_local%wrap) - call ESMF_GridCompGetInternalState(gcomp, is_local, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! Create the destination normalization field - do n1 = 1,ncomps - - ! Since coupling could be uni-directional, the import FB could be - ! available but number of fields could be zero, so it is better to - ! check export FB if this is the case - if (ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(n1,n1)) .or. & - ESMF_FieldBundleIsCreated(is_local%wrap%FBExp(n1))) then - ! Get source mesh - call ESMF_FieldBundleGet(is_local%wrap%FBImp(n1,n1), fieldCount=fieldCount, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - if (fieldCount == 0) then - if (mastertask) then - write(logunit,*) trim(subname)//' '//trim(compname(n1))//' import FB field count is = ', fieldCount - write(logunit,*) trim(subname)//' '//trim(compname(n1))//' trying to use export FB' - end if - call ESMF_FieldBundleGet(is_local%wrap%FBExp(n1), fieldCount=fieldCount, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - allocate(fieldlist(fieldcount)) - call ESMF_FieldBundleGet(is_local%wrap%FBExp(n1), fieldlist=fieldlist, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - allocate(fieldlist(fieldcount)) - call ESMF_FieldBundleGet(is_local%wrap%FBImp(n1,n1), fieldlist=fieldlist, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - - call ESMF_FieldGet(fieldlist(1), mesh=mesh_src, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - field_src = ESMF_FieldCreate(mesh_src, ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field_src, farrayptr=dataPtr, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - dataptr(:) = 1.0_R8 - - do n2 = 1,ncomps - if ( n1 /= n2 .and. & - ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(n1,n2)) .and. & - is_local%wrap%med_coupling_active(n1,n2) ) then - - ! Get destination mesh - call ESMF_FieldBundleGet(is_local%wrap%FBImp(n1,n2), fieldlist=fieldlist, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(fieldlist(1), mesh=mesh_dst, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! Create is_local%wrap%field_NormOne(n1,n2,m) - do m = 1,nmappers - if (med_map_RH_is_created(is_local%wrap%RH,n1,n2,m,rc=rc)) then - is_local%wrap%field_NormOne(n1,n2,m) = ESMF_FieldCreate(mesh_dst, & - ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(is_local%wrap%field_NormOne(n1,n2,m), farrayptr=dataptr, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - dataptr(:) = czero - call med_map_field( & - field_src=field_src, & - field_dst=is_local%wrap%field_NormOne(n1,n2,m), & - routehandles=is_local%wrap%RH(n1,n2,:), & - maptype=m, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) then - write(logunit,'(a)') trim(subname)//' created field_NormOne for '& - //compname(n1)//'->'//compname(n2)//' with mapping '//trim(mapnames(m)) - endif - end if - end do ! end of loop over m mappers - end if ! end of if block for creating destination field - end do ! end of loop over n2 - - ! Deallocate memory - deallocate(fieldlist) - call ESMF_FieldDestroy(field_src, rc=rc, noGarbage=.true.) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - end if ! end of if-block for existence of field bundle - end do ! end of loop over n1 - - if (dbug_flag > 1) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) - endif - call t_stopf('MED:'//subname) - - end subroutine med_map_mapnorm_init - !================================================================================ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & fldsSrc, FBSrc, FBDst, packed_data, rc) diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index e967cbf9b..ca2750793 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -1,15 +1,33 @@ module med_phases_aofluxes_mod + ! -------------------------------------------------------------------------- + ! Determine atm/ocn flux calculation in mediator - for one of 3 cases: + ! if aoflux grid is ocn + ! - map atm attributes of aoflux_in to ocn and map aoflux_out back to atm + ! if aoflux grid is atm + ! - map ocn attributes of oaflux_in to atm and map aoflux_out back to ocn + ! if aoflux grid is exchange + ! - map both atm and ocn attributes of aoflux_in to xgrid and then + ! map aoflux_out from xgrid to both atm and ocn grid + ! -------------------------------------------------------------------------- + + use ESMF , only : ESMF_GridComp, ESMF_GridCompGet + use ESMF , only : ESMF_Field, ESMF_FieldGet, ESMF_FieldCreate, ESMF_FieldIsCreated, ESMF_FieldDestroy + use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet + use ESMF , only : ESMF_FieldBundleCreate, ESMF_FieldBundleAdd + use ESMF , only : ESMF_RouteHandle, ESMF_FieldRegrid, ESMF_FieldRegridStore + use ESMF , only : ESMF_REGRIDMETHOD_CONSERVE_2ND + use ESMF , only : ESMF_TERMORDER_SRCSEQ, ESMF_REGION_TOTAL, ESMF_MESHLOC_ELEMENT, ESMF_MAXSTR + use ESMF , only : ESMF_XGRIDSIDE_B, ESMF_XGRIDSIDE_A, ESMF_END_ABORT, ESMF_LOGERR_PASSTHRU + use ESMF , only : ESMF_Mesh, ESMF_MeshGet, ESMF_XGrid, ESMF_XGridCreate, ESMF_TYPEKIND_R8 + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_LOGMSG_ERROR, ESMF_FAILURE + use ESMF , only : ESMF_Finalize, ESMF_LogFoundError 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 - use med_internalstate_mod , only : mastertask, logunit + use med_internalstate_mod , only : InternalState, mastertask, logunit use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_utils_mod , only : memcheck => med_memcheck use med_utils_mod , only : chkerr => med_utils_chkerr - use med_methods_mod , only : FB_fldchk => med_methods_FB_FldChk - use med_methods_mod , only : FB_GetFldPtr => med_methods_FB_GetFldPtr - use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose - use med_map_mod , only : med_map_field_packed + use esmFlds , only : compatm, compocn, coupling_mode, mapconsd, mapconsf, mapfcopy use perf_mod , only : t_startf, t_stopf implicit none @@ -19,43 +37,78 @@ module med_phases_aofluxes_mod ! Public routines !-------------------------------------------------------------------------- - public :: med_phases_aofluxes_run + public :: med_phases_aofluxes_init_fldbuns + public :: med_phases_aofluxes_run !-------------------------------------------------------------------------- ! Private routines !-------------------------------------------------------------------------- private :: med_aofluxes_init - private :: med_aofluxes_run + private :: med_aofluxes_init_ogrid + private :: med_aofluxes_init_agrid + private :: med_aofluxes_init_xgrid + private :: med_aofluxes_update + private :: set_aoflux_in_pointers + private :: set_aoflux_out_pointers + private :: fldbun_getfldptr !-------------------------------------------------------------------------- ! Private data !-------------------------------------------------------------------------- - type aoflux_type - ! input - integer , pointer :: mask (:) => null() ! ocn domain mask: 0 <=> inactive cell - real(R8) , pointer :: rmask (:) => null() ! ocn domain mask: 0 <=> inactive cell - real(R8) , pointer :: lats (:) => null() ! latitudes (degrees) - real(R8) , pointer :: lons (:) => null() ! longitudes (degrees) + logical :: flds_wiso ! use case + logical :: compute_atm_dens + logical :: compute_atm_thbot + integer :: ocn_surface_flux_scheme ! use case + + character(len=CS), pointer :: fldnames_ocn_in(:) + character(len=CS), pointer :: fldnames_atm_in(:) + character(len=CS), pointer :: fldnames_aof_out(:) + + ! following is needed for atm/ocn fluxes on atm grid + type(ESMF_FieldBundle) :: FBocn_a ! ocean fields need for aoflux calc on atm grid + + ! following is needed for atm/ocn fluxes on the exchange grid + type(ESMF_FieldBundle) :: FBocn_x ! input ocn fields + type(ESMF_FieldBundle) :: FBatm_x ! input atm fields + type(ESMF_FieldBundle) :: FBaof_x ! output aoflux fields + type(ESMF_RouteHandle) :: rh_ogrid2xgrid ! ocn->xgrid mapping + type(ESMF_RouteHandle) :: rh_agrid2xgrid ! atm->xgrid mapping + type(ESMF_RouteHandle) :: rh_xgrid2ogrid ! xgrid->ocn mapping + type(ESMF_RouteHandle) :: rh_xgrid2agrid ! xgrid->atm mapping + type(ESMF_RouteHandle) :: rh_ogrid2xgrid_2ndord ! ocn->xgrid mapping 2nd order conservative + type(ESMF_RouteHandle) :: rh_agrid2xgrid_2ndord ! atm->xgrid mapping 2nd order conservative + type(ESMF_Field) :: field_ogrid2xgrid_normone + type(ESMF_Field) :: field_xgrid2agrid_normone + + type aoflux_in_type + ! input: ocn real(R8) , pointer :: uocn (:) => null() ! ocn velocity, zonal real(R8) , pointer :: vocn (:) => null() ! ocn velocity, meridional real(R8) , pointer :: tocn (:) => null() ! ocean temperature + real(R8) , pointer :: roce_16O (:) => null() ! ocn H2O ratio + real(R8) , pointer :: roce_HDO (:) => null() ! ocn HDO ratio + real(R8) , pointer :: roce_18O (:) => null() ! ocn H218O ratio + ! input: atm real(R8) , pointer :: zbot (:) => null() ! atm level height real(R8) , pointer :: ubot (:) => null() ! atm velocity, zonal real(R8) , pointer :: vbot (:) => null() ! atm velocity, meridional real(R8) , pointer :: thbot (:) => null() ! atm potential T real(R8) , pointer :: shum (:) => null() ! atm specific humidity - real(R8) , pointer :: shum_16O (:) => null() ! atm H2O tracer - real(R8) , pointer :: shum_HDO (:) => null() ! atm HDO tracer - real(R8) , pointer :: shum_18O (:) => null() ! atm H218O tracer - real(R8) , pointer :: roce_16O (:) => null() ! ocn H2O ratio - real(R8) , pointer :: roce_HDO (:) => null() ! ocn HDO ratio - real(R8) , pointer :: roce_18O (:) => null() ! ocn H218O ratio real(R8) , pointer :: pbot (:) => null() ! atm bottom pressure real(R8) , pointer :: dens (:) => null() ! atm bottom density real(R8) , pointer :: tbot (:) => null() ! atm bottom surface T - ! output + real(R8) , pointer :: shum_16O (:) => null() ! atm H2O tracer + real(R8) , pointer :: shum_HDO (:) => null() ! atm HDO tracer + real(R8) , pointer :: shum_18O (:) => null() ! atm H218O tracer + ! local size and computational mask: on aoflux grid + integer :: lsize ! local size + integer , pointer :: mask (:) => null() ! integer ocn domain mask: 0 <=> inactive cell + real(R8) , pointer :: rmask (:) => null() ! real ocn domain mask: 0 <=> inactive cell + end type aoflux_in_type + + type aoflux_out_type real(R8) , pointer :: sen (:) => null() ! heat flux: sensible real(R8) , pointer :: lat (:) => null() ! heat flux: latent real(R8) , pointer :: lwup (:) => null() ! lwup over ocean @@ -65,21 +118,17 @@ module med_phases_aofluxes_mod real(R8) , pointer :: evap_18O (:) => null() ! H218O flux: evaporation real(R8) , pointer :: taux (:) => null() ! wind stress, zonal real(R8) , pointer :: tauy (:) => null() ! wind stress, meridional - real(R8) , pointer :: tref (:) => null() ! diagnostic: 2m ref T - real(R8) , pointer :: qref (:) => null() ! diagnostic: 2m ref Q + real(R8) , pointer :: tref (:) => null() ! diagnostic: 2m ref T + real(R8) , pointer :: qref (:) => null() ! diagnostic: 2m ref Q real(R8) , pointer :: u10 (:) => null() ! diagnostic: 10m wind speed real(R8) , pointer :: duu10n (:) => null() ! diagnostic: 10m wind speed squared real(R8) , pointer :: ustar (:) => null() ! saved ustar real(R8) , pointer :: re (:) => null() ! saved re real(R8) , pointer :: ssq (:) => null() ! saved sq - logical :: created ! has this data type been created - end type aoflux_type - - ! The following three variables are obtained as attributes from gcomp - logical :: flds_wiso ! use case - logical :: compute_atm_dens - logical :: compute_atm_thbot - integer :: ocn_surface_flux_scheme ! use case + end type aoflux_out_type + + character(len=CS) :: aoflux_grid + character(*), parameter :: u_FILE_u = & __FILE__ @@ -87,29 +136,118 @@ module med_phases_aofluxes_mod contains !================================================================================ - subroutine med_phases_aofluxes_run(gcomp, rc) + subroutine med_phases_aofluxes_init_fldbuns(gcomp, rc) + + use ESMF , only : ESMF_FieldBundleIsCreated + use esmFlds , only : med_fldList_GetNumFlds, med_fldList_GetFldNames, compname + use esmFlds , only : fldListMed_aoflux + use med_methods_mod , only : FB_init => med_methods_FB_init + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + integer :: n + integer :: fieldcount + type(InternalState) :: is_local + character(len=*),parameter :: subname=' (med_phases_aofluxes_init_fldbuns) ' + !--------------------------------------- + + ! Create field bundles for mediator ocean/atmosphere flux computation + ! This is needed regardless of the grid on which the atm/ocn flux computation is done on + + ! Get the internal state from the mediator Component. + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Set module variable fldnames_aof_out + fieldCount = med_fldList_GetNumFlds(fldListMed_aoflux) + allocate(fldnames_aof_out(fieldCount)) + call med_fldList_getfldnames(fldListMed_aoflux%flds, fldnames_aof_out, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Initialize FBMed_aoflux_a + call FB_init(is_local%wrap%FBMed_aoflux_a, is_local%wrap%flds_scalar_name, & + STgeom=is_local%wrap%NStateImp(compatm), fieldnamelist=fldnames_aof_out, name='FBMed_aoflux_a', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (mastertask) then + write(logunit,*) + write(logunit,'(a)') trim(subname)//' initialized FB FBMed_aoflux_a' + end if + + ! Initialize FBMed_aoflux_o + call FB_init(is_local%wrap%FBMed_aoflux_o, is_local%wrap%flds_scalar_name, & + STgeom=is_local%wrap%NStateImp(compocn), fieldnamelist=fldnames_aof_out, name='FBMed_aoflux_o', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (mastertask) then + write(logunit,'(a)') trim(subname)//' initialized FB FBMed_aoflux_o' + write(logunit,'(a)') trim(subname)//' following are the fields in FBMed_aoflux_o and FBMed_aoflux_a' + do n = 1,fieldcount + write(logunit,'(a)')' FBmed_aoflux fieldname = '//trim(fldnames_aof_out(n)) + end do + end if - use ESMF , only : ESMF_GridComp, ESMF_Clock, ESMF_GridCompGet - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS - use ESMF , only : ESMF_FieldBundleIsCreated - use NUOPC , only : NUOPC_IsConnected, NUOPC_CompAttributeGet - use esmFlds , only : med_fldList_GetNumFlds, med_fldList_GetFldNames - use esmFlds , only : fldListFr, fldListMed_aoflux, compatm, compocn, compname - use NUOPC , only : NUOPC_CompAttributeGet + ! Create required field bundles + if (is_local%wrap%aoflux_grid == 'ogrid' .or. is_local%wrap%aoflux_grid == 'agrid') then + + ! Create the field bundle is_local%wrap%FBImp(compatm,compocn) if needed + if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compatm,compocn), rc=rc)) then + if (mastertask) then + write(logunit,'(a)') trim(subname)//' creating field bundle FBImp(compatm,compocn)' + end if + call FB_init(is_local%wrap%FBImp(compatm,compocn), is_local%wrap%flds_scalar_name, & + STgeom=is_local%wrap%NStateImp(compocn), STflds=is_local%wrap%NStateImp(compatm), & + name='FBImp'//trim(compname(compatm))//'_'//trim(compname(compocn)), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + if (mastertask) then + write(logunit,'(a)') trim(subname)//' initializing FB for '// & + trim(compname(compatm))//'_'//trim(compname(compocn)) + end if + + ! Create the field bundle is_local%wrap%FBImp(compocn,compatm) if needed + if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compocn,compatm), rc=rc)) then + if (mastertask) then + write(logunit,'(a)') trim(subname)//' creating field bundle FBImp(compocn,compatm)' + end if + call FB_init(is_local%wrap%FBImp(compocn,compatm), is_local%wrap%flds_scalar_name, & + STgeom=is_local%wrap%NStateImp(compatm), STflds=is_local%wrap%NStateImp(compocn), & + name='FBImp'//trim(compname(compocn))//'_'//trim(compname(compatm)), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + if (mastertask) then + write(logunit,'(a)') trim(subname)//' initializing FB for '// & + trim(compname(compocn))//'_'//trim(compname(compatm)) + end if + + end if + + end subroutine med_phases_aofluxes_init_fldbuns + + !================================================================================ + subroutine med_phases_aofluxes_run(gcomp, rc) !----------------------------------------------------------------------- ! Compute atm/ocn fluxes !----------------------------------------------------------------------- + use NUOPC , only : NUOPC_CompAttributeGet + use ESMF , only : ESMF_FieldBundleIsCreated + use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose + ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc ! local variables - type(InternalState) :: is_local - type(aoflux_type), save :: aoflux - logical, save :: first_call = .true. - character(len=*),parameter :: subname='(med_phases_aofluxes_run)' + type(InternalState) :: is_local + type(aoflux_in_type) , save :: aoflux_in + type(aoflux_out_type) , save :: aoflux_out + logical , save :: aoflux_created + logical , save :: first_call = .true. + character(len=*),parameter :: subname=' (med_phases_aofluxes_run) ' !--------------------------------------- rc = ESMF_SUCCESS @@ -124,87 +262,72 @@ subroutine med_phases_aofluxes_run(gcomp, rc) if ( ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a, rc=rc) .and. & ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_o, rc=rc)) then - ! Allocate memoroy for the aoflux module data type (mediator atm/ocn field bundle on the ocean grid) - call med_aofluxes_init(gcomp, aoflux, & - FBAtm=is_local%wrap%FBImp(compatm,compocn), & - FBOcn=is_local%wrap%FBImp(compocn,compocn), & - FBFrac=is_local%wrap%FBfrac(compocn), & - FBMed_aoflux=is_local%wrap%FBMed_aoflux_o, rc=rc) + ! Allocate memroy for the aoflux module data type (mediator atm/ocn field bundle on the ocean grid) + call med_aofluxes_init(gcomp, aoflux_in, aoflux_out, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - aoflux%created = .true. + + aoflux_created = .true. else - aoflux%created = .false. + aoflux_created = .false. end if - ! Now set first_call to .false. first_call = .false. end if ! Return if there is no aoflux has not been created - if (.not. aoflux%created) then - RETURN - end if - - ! Start time timer - call t_startf('MED:'//subname) - - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) - endif - - call memcheck(subname, 5, mastertask) - - ! Calculate atm/ocn fluxes on the destination grid - call med_aofluxes_run(gcomp, aoflux, 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) + if ( aoflux_created) then + ! Start time timer + call t_startf('MED:'//subname) + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + call memcheck(subname, 5, mastertask) + + ! Calculate atm/ocn fluxes on the destination grid + call med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - end if - call t_stopf('MED:'//subname) + if (dbug_flag > 1) then + call FB_diagnose(is_local%wrap%FBMed_aoflux_o, & + string=trim(subname) //' FBAMed_aoflux_o' , rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + call t_stopf('MED:'//subname) + end if end subroutine med_phases_aofluxes_run -!================================================================================ + !================================================================================ + subroutine med_aofluxes_init(gcomp, aoflux_in, aoflux_out, rc) - subroutine med_aofluxes_init(gcomp, aoflux, FBAtm, FBOcn, FBFrac, FBMed_aoflux, rc) + use NUOPC , only : NUOPC_CompAttributeGet + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LogFoundError + use ESMF , only : ESMF_SUCCESS, ESMF_LOGERR_PASSTHRU + use ESMF , only : ESMF_GridComp, ESMF_GridCompGet + use ESMF , only : ESMF_Field, ESMF_FieldGet, ESMF_FieldBundle + use esmFlds , only : coupling_mode + use med_methods_mod , only : FB_fldchk => med_methods_FB_FldChk + use shr_flux_mod , only : shr_flux_adjust_constants - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LogFoundError - use ESMF , only : ESMF_SUCCESS, ESMF_LOGERR_PASSTHRU - use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_VM - use ESMF , only : ESMF_Field, ESMF_FieldGet, ESMF_FieldBundle, ESMF_VMGet - use NUOPC , only : NUOPC_CompAttributeGet - use shr_flux_mod , only : shr_flux_adjust_constants - use esmFlds , only : coupling_mode !----------------------------------------------------------------------- ! Initialize pointers to the module variables !----------------------------------------------------------------------- ! input/output variables - type(ESMF_GridComp) :: gcomp - type(aoflux_type) , intent(inout) :: aoflux - type(ESMF_FieldBundle) , intent(in) :: FBAtm ! Atm Import fields on aoflux grid - type(ESMF_FieldBundle) , intent(in) :: FBOcn ! Ocn Import fields on aoflux grid - type(ESMF_FieldBundle) , intent(in) :: FBfrac ! Fraction data for various components, on their grid - type(ESMF_FieldBundle) , intent(inout) :: FBMed_aoflux ! Ocn albedos computed in mediator - integer , intent(out) :: rc + type(ESMF_GridComp) , intent(inout) :: gcomp + type(aoflux_in_type) , intent(inout) :: aoflux_in + type(aoflux_out_type) , intent(inout) :: aoflux_out + integer , intent(out) :: rc ! local variables - integer :: iam - integer :: n - integer :: lsize - real(R8), pointer :: ofrac(:) => null() - real(R8), pointer :: ifrac(:) => null() - character(CL) :: cvalue - logical :: flds_wiso ! use case - character(len=CX) :: tmpstr - real(R8) :: flux_convergence ! convergence criteria for implicit flux computation - integer :: flux_max_iteration ! maximum number of iterations for convergence - logical :: coldair_outbreak_mod ! cold air outbreak adjustment (Mahrt & Sun 1995,MWR) - logical :: isPresent, isSet + type(InternalState) :: is_local + integer :: n + character(CL) :: cvalue + character(len=CX) :: tmpstr + real(R8) :: flux_convergence ! convergence criteria for implicit flux computation + integer :: flux_max_iteration ! maximum number of iterations for convergence + logical :: coldair_outbreak_mod ! cold air outbreak adjustment (Mahrt & Sun 1995,MWR) + logical :: isPresent, isSet character(*),parameter :: subName = '(med_aofluxes_init) ' !----------------------------------------------------------------------- @@ -216,8 +339,13 @@ subroutine med_aofluxes_init(gcomp, aoflux, FBAtm, FBOcn, FBFrac, FBMed_aoflux, call t_startf('MED:'//subname) + ! Get the internal state from the mediator Component. + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + !---------------------------------- - ! get attributes that are set as module variables + ! Initialize module variables !---------------------------------- call NUOPC_CompAttributeGet(gcomp, name='flds_wiso', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) @@ -227,6 +355,45 @@ subroutine med_aofluxes_init(gcomp, aoflux, FBAtm, FBOcn, FBFrac, FBMed_aoflux, else flds_wiso = .false. end if + call NUOPC_CompAttributeGet(gcomp, name='ocn_surface_flux_scheme', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) ocn_surface_flux_scheme + else + ocn_surface_flux_scheme = 0 + end if + + ! bottom level potential temperature and/or botom level density + ! will need to be computed if not received from the atm + if (FB_fldchk(is_local%Wrap%FBImp(Compatm,Compatm), 'Sa_ptem', rc=rc)) then + compute_atm_thbot = .false. + else + compute_atm_thbot = .true. + end if + if (FB_fldchk(is_local%Wrap%FBImp(Compatm,Compatm), 'Sa_dens', rc=rc)) then + compute_atm_dens = .false. + else + compute_atm_dens = .true. + end if + + !---------------------------------- + ! Initialize aoflux + !---------------------------------- + + if (is_local%wrap%aoflux_grid == 'ogrid') then ! aoflux_grid is ocn + call med_aofluxes_init_ogrid(gcomp, aoflux_in, aoflux_out, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else if (is_local%wrap%aoflux_grid == 'agrid') then ! aoflux_grid is atm + call med_aofluxes_init_agrid(gcomp, aoflux_in, aoflux_out, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else if (is_local%wrap%aoflux_grid == 'xgrid') then ! aoflux_grid is exchange grid + call med_aofluxes_init_xgrid(gcomp, aoflux_in, aoflux_out, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + + !---------------------------------- + ! Initialize shr_flux_adjust_constants + !---------------------------------- call NUOPC_CompAttributeGet(gcomp, name='coldair_outbreak_mod', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -235,7 +402,6 @@ subroutine med_aofluxes_init(gcomp, aoflux, FBAtm, FBOcn, FBFrac, FBMed_aoflux, else coldair_outbreak_mod = .false. end if - call NUOPC_CompAttributeGet(gcomp, name='flux_max_iteration', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (isPresent .and. isSet) then @@ -243,7 +409,6 @@ subroutine med_aofluxes_init(gcomp, aoflux, FBAtm, FBOcn, FBFrac, FBMed_aoflux, else flux_max_iteration = 1 end if - call NUOPC_CompAttributeGet(gcomp, name='flux_convergence', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (isPresent .and. isSet) then @@ -251,325 +416,877 @@ subroutine med_aofluxes_init(gcomp, aoflux, FBAtm, FBOcn, FBFrac, FBMed_aoflux, else flux_convergence = 0.0_r8 end if - - call NUOPC_CompAttributeGet(gcomp, name='ocn_surface_flux_scheme', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - read(cvalue,*) ocn_surface_flux_scheme - else - ocn_surface_flux_scheme = 0 - end if - call shr_flux_adjust_constants(& flux_convergence_tolerance=flux_convergence, & flux_convergence_max_iteration=flux_max_iteration, & coldair_outbreak_mod=coldair_outbreak_mod) - !---------------------------------- - ! atm/ocn fields - !---------------------------------- + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + call t_stopf('MED:'//subname) - call FB_GetFldPtr(FBMed_aoflux, fldname='So_tref', fldptr1=aoflux%tref, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(FBMed_aoflux, fldname='So_qref', fldptr1=aoflux%qref, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(FBMed_aoflux, fldname='So_ustar', fldptr1=aoflux%ustar, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(FBMed_aoflux, fldname='So_re', fldptr1=aoflux%re, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(FBMed_aoflux, fldname='So_ssq', fldptr1=aoflux%ssq, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(FBMed_aoflux, fldname='So_u10', fldptr1=aoflux%u10, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(FBMed_aoflux, fldname='So_duu10n', fldptr1=aoflux%duu10n, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + end subroutine med_aofluxes_init - call FB_GetFldPtr(FBMed_aoflux, fldname='Faox_taux', fldptr1=aoflux%taux, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(FBMed_aoflux, fldname='Faox_tauy', fldptr1=aoflux%tauy, rc=rc) + !=============================================================================== + subroutine med_aofluxes_init_ogrid(gcomp, aoflux_in, aoflux_out, rc) + + ! -------------------------------------------- + ! Initialize aoflux data type and compute mask + ! for computations on ocn grid + ! -------------------------------------------- + + use ESMF , only : ESMF_FieldBundleIsCreated + use esmFlds , only : fldListMed_aoflux + use med_map_mod , only : med_map_packed_field_create + + ! Arguments + type(ESMF_GridComp) , intent(inout) :: gcomp + type(aoflux_in_type) , intent(inout) :: aoflux_in + type(aoflux_out_type) , intent(inout) :: aoflux_out + integer , intent(out) :: rc + ! + ! Local variables + type(InternalState) :: is_local + character(len=CX) :: tmpstr + integer :: lsize + integer :: fieldcount + character(len=*),parameter :: subname=' (med_aofluxes_init_ocngrid) ' + !----------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + ! Get the internal state from the mediator Component. + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(FBMed_aoflux, fldname='Faox_lat', fldptr1=aoflux%lat, rc=rc) + + ! ------------------------ + ! input fields from atm and ocn on aofluxgrid + ! ------------------------ + call set_aoflux_in_pointers(is_local%wrap%FBImp(compatm,compocn), is_local%wrap%FBImp(compocn,compocn), & + aoflux_in, lsize, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(FBMed_aoflux, fldname='Faox_sen', fldptr1=aoflux%sen, rc=rc) + + ! ------------------------ + ! output fields from aoflux calculation + ! ------------------------ + call set_aoflux_out_pointers(is_local%wrap%FBMed_aoflux_o, lsize, aoflux_out, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(FBMed_aoflux, fldname='Faox_evap', fldptr1=aoflux%evap, rc=rc) + + ! ------------------------ + ! set aoflux computational mask on ocn grid + ! ------------------------ + ! default compute everywhere, then "turn off" gridcells + allocate(aoflux_in%mask(lsize)) + aoflux_in%mask(:) = 1 + write(tmpstr,'(i12,g22.12,i12)') lsize,sum(aoflux_in%rmask),sum(aoflux_in%mask) + call ESMF_LogWrite(trim(subname)//" : maskA= "//trim(tmpstr), ESMF_LOGMSG_INFO) + where (aoflux_in%rmask(:) == 0._R8) aoflux_in%mask(:) = 0 ! like nint + write(tmpstr,'(i12,g22.12,i12)') lsize,sum(aoflux_in%rmask),sum(aoflux_in%mask) + call ESMF_LogWrite(trim(subname)//" : maskB= "//trim(tmpstr), ESMF_LOGMSG_INFO) + + ! ------------------------ + ! create packed mapping from ocn->atm if aoflux_grid is ocn + ! ------------------------ + if (is_local%wrap%aoflux_grid == 'ogrid') then + if ( ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_o) .and. & + ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a)) then + + call med_map_packed_field_create(destcomp=compatm, & + flds_scalar_name=is_local%wrap%flds_scalar_name, & + fldsSrc=fldListMed_aoflux%flds, & + FBSrc=is_local%wrap%FBMed_aoflux_o, & + FBDst=is_local%wrap%FBMed_aoflux_a, & + packed_data=is_local%wrap%packed_data_aoflux_o2a(:), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + end if + end if + + end subroutine med_aofluxes_init_ogrid + + !=============================================================================== + subroutine med_aofluxes_init_agrid(gcomp, aoflux_in, aoflux_out, rc) + + ! -------------------------------------------- + ! Initialize aoflux data type and compute mask for computations on atm grid + ! - all aoflux fields are on the atm mesh + ! - input atm aoflux attributes are just pointers into is_local%wrap%FBImp(compatm,compatm) + ! - input ocn aoflux attributes are just pointers into is_local%wrap%FBImp(compocn,compatm) + ! - output aoflux attributes are on the atm mesh + ! -------------------------------------------- + + use med_methods_mod, only : FB_init => med_methods_FB_init + use med_map_mod , only : med_map_rh_is_created, med_map_field + + ! Arguments + type(ESMF_GridComp) , intent(inout) :: gcomp + type(aoflux_in_type) , intent(inout) :: aoflux_in + type(aoflux_out_type) , intent(inout) :: aoflux_out + integer , intent(out) :: rc + ! + ! Local variables + type(InternalState) :: is_local + integer :: lsize,n + integer :: fieldcount + type(ESMF_Field) :: field_src + type(ESMF_Field) :: field_dst + real(r8), pointer :: dataptr1d(:) + type(ESMF_Mesh) :: mesh_src + type(ESMF_Mesh) :: mesh_dst + integer :: maptype + character(len=*),parameter :: subname=' (med_aofluxes_init_atmgrid) ' + !----------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - lsize = size(aoflux%evap) + ! ------------------------ + ! input fields from atm and ocn on atm grid + ! ------------------------ + if (flds_wiso) then - call FB_GetFldPtr(FBMed_aoflux, fldname='Faox_evap_16O', fldptr1=aoflux%evap_16O, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(FBMed_aoflux, fldname='Faox_evap_18O', fldptr1=aoflux%evap_18O, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(FBMed_aoflux, fldname='Faox_evap_HDO', fldptr1=aoflux%evap_HDO, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(fldnames_ocn_in(5)) + fldnames_ocn_in = (/'So_omask ','So_t ','So_u ','So_v ','So_roce_wiso' /) else - allocate(aoflux%evap_16O(lsize)); aoflux%evap_16O(:) = 0._R8 - allocate(aoflux%evap_18O(lsize)); aoflux%evap_18O(:) = 0._R8 - allocate(aoflux%evap_HDO(lsize)); aoflux%evap_HDO(:) = 0._R8 + allocate(fldnames_ocn_in(4)) + fldnames_ocn_in = (/'So_omask','So_t ','So_u ','So_v '/) end if + call FB_init(FBocn_a, is_local%wrap%flds_scalar_name, & + FBgeom=is_local%wrap%FBImp(compatm,compatm), fieldnamelist=fldnames_ocn_in, name='FBocn_a', rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(FBMed_aoflux, fldname='Faox_lwup', fldptr1=aoflux%lwup, rc=rc) + call set_aoflux_in_pointers(is_local%wrap%FBImp(compatm,compatm), FBocn_a, aoflux_in, lsize, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - !---------------------------------- - ! Ocn import fields - !---------------------------------- + ! ------------------------ + ! output fields from aoflux calculation on atm grid + ! ------------------------ - call FB_GetFldPtr(FBOcn, fldname='So_omask', fldptr1=aoflux%rmask, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(FBOcn, fldname='So_t', fldptr1=aoflux%tocn, rc=rc) + call set_aoflux_out_pointers(is_local%wrap%FBMed_aoflux_a, lsize, aoflux_out, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(FBOcn, fldname='So_u', fldptr1=aoflux%uocn, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(FBOcn, fldname='So_v', fldptr1=aoflux%vocn, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (flds_wiso) then - call FB_GetFldPtr(FBOcn, fldname='So_roce_16O', fldptr1=aoflux%roce_16O, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(FBOcn, fldname='So_roce_18O', fldptr1=aoflux%roce_18O, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(FBOcn, fldname='So_roce_HDO', fldptr1=aoflux%roce_HDO, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! ------------------------ + ! Determine maptype for ocn->atm mapping + ! ------------------------ + + if (med_map_RH_is_created(is_local%wrap%RH(compocn,compatm,:), mapfcopy, rc=rc)) then + maptype = mapfcopy + else if (med_map_RH_is_created(is_local%wrap%RH(compocn,compatm,:), mapconsd, rc=rc)) then + maptype = mapconsd else - allocate(aoflux%roce_16O(lsize)); aoflux%roce_16O(:) = 0._R8 - allocate(aoflux%roce_18O(lsize)); aoflux%roce_18O(:) = 0._R8 - allocate(aoflux%roce_HDO(lsize)); aoflux%roce_HDO(:) = 0._R8 + call ESMF_LogWrite(trim(subname)//& + ": maptype for atm->ocn mapping of So_mask must be either mapfcopy or mapconsd", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE + return end if - !---------------------------------- - ! Atm import fields - !---------------------------------- + ! ------------------------ + ! set aoflux computational mask on atm grid + ! ------------------------ - call FB_GetFldPtr(FBAtm, fldname='Sa_z', fldptr1=aoflux%zbot, rc=rc) + ! Compute mask is the ocean mask mapped to atm grid (conservatively without fractions) + ! This computes So_omask in FBocn_a - but the assumption is that it already is there + ! Compute mask is the ocean mask mapped to atm grid (conservatively without fractions) + ! This computes So_omask in FBocn_a - but the assumption is that it already is there + call ESMF_FieldBundleGet(is_local%wrap%FBImp(compocn,compocn), 'So_omask', field=field_src, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleGet(FBocn_a, 'So_omask', field=field_dst, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + call med_map_field( field_src=field_src, field_dst=field_dst, & + routehandles=is_local%wrap%RH(compocn,compatm,:), maptype=maptype, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(field_dst, farrayptr=dataptr1d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(aoflux_in%mask(lsize)) + do n = 1,lsize + if (dataptr1d(n) == 0._r8) then + aoflux_in%mask(n) = 0 + else + aoflux_in%mask(n) = 1 + end if + enddo - ! bulk formula quantities for nems_orig_data - if (trim(coupling_mode) == 'nems_orig_data' .and. ocn_surface_flux_scheme == -1) then - call FB_GetFldPtr(FBAtm, fldname='Sa_u10m', fldptr1=aoflux%ubot, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(FBAtm, fldname='Sa_v10m', fldptr1=aoflux%vbot, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(FBAtm, fldname='Sa_t2m', fldptr1=aoflux%tbot, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(FBAtm, fldname='Sa_q2m', fldptr1=aoflux%shum, rc=rc) + ! ------------------------ + ! set one normalization for ocn-atm mapping if needed + ! ------------------------ + + if (.not. ESMF_FieldIsCreated(is_local%wrap%field_NormOne(compocn,compatm,maptype))) then + ! Get source mesh + call ESMF_FieldBundleGet(is_local%wrap%FBImp(compocn,compocn), 'So_omask', field=field_src, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(field_src, mesh=mesh_src, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - else - call FB_GetFldPtr(FBAtm, fldname='Sa_u', fldptr1=aoflux%ubot, rc=rc) + field_src = ESMF_FieldCreate(mesh_src, ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(FBAtm, fldname='Sa_v', fldptr1=aoflux%vbot, rc=rc) + call ESMF_FieldGet(field_src, farrayptr=dataPtr1d, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(FBAtm, fldname='Sa_tbot', fldptr1=aoflux%tbot, rc=rc) + dataptr1d(:) = 1.0_R8 + + ! Create field is_local%wrap%field_NormOne(compocn,compatm,maptype) and fill in its values + call ESMF_FieldBundleGet(is_local%wrap%FBImp(compocn,compatm), 'So_omask', field=field_dst, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(field_dst, mesh=mesh_dst, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(FBAtm, fldname='Sa_shum', fldptr1=aoflux%shum, rc=rc) + is_local%wrap%field_NormOne(compocn,compatm,maptype) = ESMF_FieldCreate(mesh_dst, & + ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + call med_map_field( field_src=field_src, field_dst=is_local%wrap%field_NormOne(compocn,compatm,maptype), & + routehandles=is_local%wrap%RH(compocn,compatm,:), maptype=maptype, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - end if - ! bottom level potential temperature will need to be computed if not received from the atm - if (FB_fldchk(FBAtm, 'Sa_ptem', rc=rc)) then - call FB_GetFldPtr(FBAtm, fldname='Sa_ptem', fldptr1=aoflux%thbot, rc=rc) + call ESMF_FieldDestroy(field_src, rc=rc, noGarbage=.true.) if (chkerr(rc,__LINE__,u_FILE_u)) return - compute_atm_thbot = .false. - else - allocate(aoflux%thbot(lsize)) - compute_atm_thbot = .true. end if - ! bottom level density will need to be computed if not received from the atm - if (FB_fldchk(FBAtm, 'Sa_dens', rc=rc)) then - call FB_GetFldPtr(FBAtm, fldname='Sa_dens', fldptr1=aoflux%dens, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - compute_atm_dens = .false. - else - compute_atm_dens = .true. - allocate(aoflux%dens(lsize)) - end if + end subroutine med_aofluxes_init_agrid - ! if either density or potential temperature are computed, will need bottom level pressure - if (compute_atm_dens .or. compute_atm_thbot) then - call FB_GetFldPtr(FBAtm, fldname='Sa_pbot', fldptr1=aoflux%pbot, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end if + !=============================================================================== + subroutine med_aofluxes_init_xgrid(gcomp, aoflux_in, aoflux_out, rc) - if (flds_wiso) then - call FB_GetFldPtr(FBAtm, fldname='Sa_shum_16O', fldptr1=aoflux%shum_16O, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(FBAtm, fldname='Sa_shum_18O', fldptr1=aoflux%shum_18O, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(FBAtm, fldname='Sa_shum_HDO', fldptr1=aoflux%shum_HDO, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - else - allocate(aoflux%shum_16O(lsize)); aoflux%shum_16O(:) = 0._R8 - allocate(aoflux%shum_18O(lsize)); aoflux%shum_18O(:) = 0._R8 - allocate(aoflux%shum_HDO(lsize)); aoflux%shum_HDO(:) = 0._R8 - end if + ! -------------------------------------------- + ! Initialize aoflux data type and compute mask + ! for computations on exchange grid + ! -------------------------------------------- - !---------------------------------- - ! setup the compute mask. - !---------------------------------- + ! Arguments + type(ESMF_GridComp) , intent(inout) :: gcomp + type(aoflux_in_type) , intent(inout) :: aoflux_in + type(aoflux_out_type) , intent(inout) :: aoflux_out + integer , intent(out) :: rc - ! allocate grid mask fields - ! default compute everywhere, then "turn off" gridcells - allocate(aoflux%mask(lsize)) - aoflux%mask(:) = 1 + ! Local variables + integer :: n + integer :: lsize + type(InternalState) :: is_local + type(ESMF_Field) :: lfield_a + type(ESMF_Field) :: lfield_o + type(ESMF_Field) :: lfield_x + type(ESMF_Field) :: lfield + integer :: elementCount + type(ESMF_Mesh) :: ocn_mesh + type(ESMF_Mesh) :: atm_mesh + integer, allocatable :: ocn_mask(:) + type(ESMF_XGrid) :: xgrid + type(ESMF_Field) :: field_src ! needed for normalization + type(ESMF_Field) :: field_dst ! needed for normalization + type(ESMF_Mesh) :: mesh_src ! needed for normalization + type(ESMF_Mesh) :: mesh_dst ! needed for normalization + real(r8), pointer :: dataptr1d(:) + integer :: fieldcount + character(ESMF_MAXSTR),allocatable :: fieldNameList(:) + character(len=*),parameter :: subname=' (med_aofluxes_init_xgrid) ' + !----------------------------------------------------------------------- - write(tmpstr,'(i12,g22.12,i12)') lsize,sum(aoflux%rmask),sum(aoflux%mask) - call ESMF_LogWrite(trim(subname)//" : maskA= "//trim(tmpstr), ESMF_LOGMSG_INFO) + rc = ESMF_SUCCESS - where (aoflux%rmask(:) == 0._R8) aoflux%mask(:) = 0 ! like nint + ! Get the internal state from the mediator Component. + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - write(tmpstr,'(i12,g22.12,i12)') lsize,sum(aoflux%rmask),sum(aoflux%mask) - call ESMF_LogWrite(trim(subname)//" : maskB= "//trim(tmpstr), ESMF_LOGMSG_INFO) + ! ------------------------ + ! create the aoflux exchange grid + ! ------------------------ - ! TODO: need to check if this logic is correct - ! then check ofrac + ifrac - ! call FB_getFldPtr(FBFrac , fldname='ofrac' , fldptr1=ofrac, rc=rc) - ! if (chkerr(rc,__LINE__,u_FILE_u)) return - ! call FB_getFldPtr(FBFrac , fldname='ifrac' , fldptr1=ifrac, rc=rc) - ! if (chkerr(rc,__LINE__,u_FILE_u)) return - ! where (ofrac(:) + ifrac(:) <= 0.0_R8) mask(:) = 0 - !---------------------------------- - ! Get config variables on first call - !---------------------------------- + ! determine atm mesh + call ESMF_FieldBundleGet(is_local%wrap%FBImp(compatm,compatm), fieldname='Sa_z', field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, mesh=atm_mesh, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(gcomp, name='coldair_outbreak_mod', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + ! determine ocn mesh + call ESMF_FieldBundleGet(is_local%wrap%FBImp(compocn,compocn), fieldname='So_t', field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, mesh=ocn_mesh, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - read(cvalue,*) coldair_outbreak_mod - else - coldair_outbreak_mod = .false. - end if - call NUOPC_CompAttributeGet(gcomp, name='flux_max_iteration', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + ! create exchange grid - assume that atm mask is always 1 + xgrid = ESMF_XGridCreate(sideBMesh=(/ocn_mesh/), sideAMesh=(/atm_mesh/), sideBMaskValues=(/0/), & + storeOverlay=.true., rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - read(cvalue,*) flux_max_iteration - else - flux_max_iteration = 1 - end if - call NUOPC_CompAttributeGet(gcomp, name='flux_convergence', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + ! ------------------------ + ! input fields from atm and ocn on xgrid + ! ------------------------ + + ! Create FBatm_x and FBocn_x (module variables) + FBatm_x = ESMF_FieldBundleCreate(rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + FBocn_x = ESMF_FieldBundleCreate(rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call set_aoflux_in_pointers(FBatm_x, FBocn_x, aoflux_in, lsize, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - read(cvalue,*) flux_convergence - else - flux_convergence = 0.0_r8 - end if - call shr_flux_adjust_constants(& - flux_convergence_tolerance=flux_convergence, & - flux_convergence_max_iteration=flux_max_iteration, & - coldair_outbreak_mod=coldair_outbreak_mod) + call ESMF_FieldBundleGet(FBatm_x, fieldCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(fldnames_atm_in(fieldcount)) + call ESMF_FieldBundleGet(FBatm_x, fieldnamelist=fldnames_atm_in, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleGet(FBocn_x, fieldCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(fldnames_ocn_in(fieldcount)) + call ESMF_FieldBundleGet(FBocn_x, fieldnamelist=fldnames_ocn_in, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! ------------------------ + ! output fields from aoflux calculation on exchange grid + ! ------------------------ - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) - endif - call t_stopf('MED:'//subname) + FBaof_x = ESMF_FieldBundleCreate(rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call set_aoflux_out_pointers(FBaof_x, lsize, aoflux_out, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - end subroutine med_aofluxes_init + ! ------------------------ + ! create the routehandles atm->xgrid and xgrid->atm + ! ------------------------ -!=============================================================================== + call ESMF_FieldBundleGet(is_local%wrap%FBImp(compatm,compatm), trim(fldnames_atm_in(1)), field=lfield_a, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleGet(FBatm_x, trim(fldnames_atm_in(1)), field=lfield_x, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldRegridStore(xgrid, lfield_a, lfield_x, routehandle=rh_agrid2xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldRegridStore(xgrid, lfield_x, lfield_a, routehandle=rh_xgrid2agrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldRegridStore(xgrid, lfield_a, lfield_x, routehandle=rh_agrid2xgrid_2ndord, & + regridmethod=ESMF_REGRIDMETHOD_CONSERVE_2ND, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - subroutine med_aofluxes_run(gcomp, aoflux, rc) + ! ------------------------ + ! create the routehandles ocn->xgrid and xgrid->ocn + ! ------------------------ - use ESMF , only : ESMF_GridComp, ESMF_Clock, ESMF_Time, ESMF_TimeInterval - use ESMF , only : ESMF_GridCompGet, ESMF_ClockGet, ESMF_TimeGet, ESMF_TimeIntervalGet - use ESMF , only : ESMF_LogWrite, ESMF_LogMsg_Info, ESMF_SUCCESS - use NUOPC , only : NUOPC_CompAttributeGet - use shr_flux_mod , only : shr_flux_atmocn + ! TODO: the second order conservative route handle below error out in its creation + + call ESMF_FieldBundleGet(is_local%wrap%FBImp(compocn,compocn), trim(fldnames_ocn_in(1)), field=lfield_o, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleGet(FBocn_x, trim(fldnames_ocn_in(1)), field=lfield_x, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldRegridStore(xgrid, lfield_o, lfield_x, routehandle=rh_ogrid2xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldRegridStore(xgrid, lfield_x, lfield_o, routehandle=rh_xgrid2ogrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + ! call ESMF_FieldRegridStore(xgrid, lfield_o, lfield_x, routehandle=rh_ogrid2xgrid_2ndord, & + ! regridmethod=ESMF_REGRIDMETHOD_CONSERVE_2ND, rc=rc) + ! if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! ------------------------ + ! setup the compute mask - default compute everywhere for exchange grid + ! ------------------------ + + allocate(aoflux_in%mask(lsize)) + aoflux_in%mask(:) = 1 + + ! ------------------------ + ! determine one normalization field for ocn->xgrid + ! ------------------------ + + ! Create temporary source field on ocn mesh and set its value to 1. + call ESMF_FieldBundleGet(is_local%wrap%FBImp(compocn,compocn), 'So_t', field=lfield_o, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield_o, mesh=ocn_mesh, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + lfield_o = ESMF_FieldCreate(ocn_mesh, ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield_o, farrayptr=dataPtr1d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + dataptr1d(:) = 1.0_R8 + + ! Create field_ogrid2xgrid_normone (module variable) + field_ogrid2xgrid_normone = ESMF_FieldCreate(xgrid, ESMF_TYPEKIND_R8, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldRegrid(lfield_o, field_ogrid2xgrid_normone, routehandle=rh_ogrid2xgrid, & + termorderflag=ESMF_TERMORDER_SRCSEQ, zeroregion=ESMF_REGION_TOTAL, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Destroy temporary field + call ESMF_FieldDestroy(lfield_o, rc=rc, noGarbage=.true.) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! ------------------------ + ! Determine one normalization field for xgrid->atm + ! ------------------------ + + ! Create temporary field on xgrid and set its value to 1. + lfield_x = ESMF_FieldCreate(xgrid, typekind=ESMF_TYPEKIND_R8, name='Sa_z', rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield_x, farrayptr=dataPtr1d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + dataptr1d(:) = 1.0_R8 + + ! Create field_xgrid2agrid_normone (module variable) - on the atm mesh + call ESMF_FieldBundleGet(is_local%wrap%FBImp(compatm,compatm), 'Sa_z', field=lfield_a, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield_a, mesh=atm_mesh, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + field_xgrid2agrid_normone = ESMF_FieldCreate(atm_mesh, ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldRegrid(lfield_x, field_xgrid2agrid_normone, routehandle=rh_xgrid2agrid, & + termorderflag=ESMF_TERMORDER_SRCSEQ, zeroregion=ESMF_REGION_TOTAL, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Destroy temporary field on xgrid + call ESMF_FieldDestroy(lfield_x, rc=rc, noGarbage=.true.) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + end subroutine med_aofluxes_init_xgrid + + !=============================================================================== + subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) !----------------------------------------------------------------------- - ! Determine atm/ocn fluxes eother on atm or on ocean grid - ! The module arrays are set via pointers the the mediator internal states + ! Determine atm/ocn fluxes eother on atm, ocn or exchange grid + ! The module arrays are set via pointers to the mediator internal states ! in med_ocnatm_init and are used below. + ! 1) Create input on aoflux grid + ! 2) Update atmosphere/ocean surface fluxes + ! 3) Map aoflux output to relevant atm/ocn grid(s) !----------------------------------------------------------------------- + use ESMF , only : ESMF_GridComp + use ESMF , only : ESMF_LogWrite, ESMF_LogMsg_Info, ESMF_SUCCESS + use med_map_mod , only : med_map_field_packed, med_map_rh_is_created + use shr_flux_mod , only : shr_flux_atmocn + ! Arguments - type(ESMF_GridComp) :: gcomp - type(aoflux_type) , intent(inout) :: aoflux - integer , intent(out) :: rc + type(ESMF_GridComp) :: gcomp + type(aoflux_in_type) , intent(inout) :: aoflux_in + type(aoflux_out_type) , intent(inout) :: aoflux_out + integer , intent(out) :: rc ! ! Local variables - character(CL) :: cvalue - integer :: n,i ! indices - integer :: lsize ! local size - character(len=CX) :: tmpstr - logical :: isPresent, isSet - character(*),parameter :: subName = '(med_aofluxes_run) ' + type(InternalState) :: is_local + type(ESMF_Field) :: field_src + type(ESMF_Field) :: field_dst + integer :: n,i,nf ! indices + real(r8), pointer :: data_normdst(:) + real(r8), pointer :: data_dst(:) + integer :: maptype + character(*),parameter :: subName = '(med_aofluxes_update) ' !----------------------------------------------------------------------- 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 + !---------------------------------- - ! Determine the compute mask + ! Create input on aoflux grid !---------------------------------- - ! Prefer to compute just where ocean exists, so setup a mask here. - ! this could be run with either the ocean or atm grid so need to be careful. - ! really want the ocean mask on ocean grid or ocean mask mapped to atm grid, - ! but do not have access to the ocean mask mapped to the atm grid. - ! the dom mask is a good place to start, on ocean grid, it should be what we want, - ! on the atm grid, it's just all 1's so not very useful. - ! next look at ofrac+ifrac in fractions. want to compute on all non-land points. - ! using ofrac alone will exclude points that are currently all sea ice but that later - ! could be less that 100% covered in ice. + if (is_local%wrap%aoflux_grid == 'ogrid') then - lsize = size(aoflux%mask) + ! Do nothing - mapping of input atm to ogrid is in med_phases_post_atm + ! via the call to med_map_field_packed - write(tmpstr,'(i12,g22.12,i12)') lsize,sum(aoflux%rmask),sum(aoflux%mask) - call ESMF_LogWrite(trim(subname)//" : maskA= "//trim(tmpstr), ESMF_LOGMSG_INFO) + else if (is_local%wrap%aoflux_grid == 'agrid') then - aoflux%mask(:) = 1 - where (aoflux%rmask(:) == 0._R8) aoflux%mask(:) = 0 ! like nint + ! Map input ocn to agrid + do nf = 1,size(fldnames_ocn_in) + ! Create source field + call ESMF_FieldBundleGet(is_local%wrap%FBImp(compocn,compocn), fldnames_ocn_in(nf), field=field_src, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - write(tmpstr,'(i12,g22.12,i12)') lsize,sum(aoflux%rmask),sum(aoflux%mask) - call ESMF_LogWrite(trim(subname)//" : maskB= "//trim(tmpstr), ESMF_LOGMSG_INFO) + ! Create destination field + call ESMF_FieldBundleGet(FBocn_a, fldnames_ocn_in(nf), field=field_dst, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - write(tmpstr,'(3i12)') lsize,size(aoflux%mask),sum(aoflux%mask) - call ESMF_LogWrite(trim(subname)//" : mask= "//trim(tmpstr), ESMF_LOGMSG_INFO) + ! Determine maptype from ocn->atm + if (med_map_RH_is_created(is_local%wrap%RH(compocn,compatm,:), mapfcopy, rc=rc)) then + maptype = mapfcopy + else if (med_map_RH_is_created(is_local%wrap%RH(compocn,compatm,:), mapconsd, rc=rc)) then + maptype = mapconsd + else + call ESMF_LogWrite(trim(subname)//& + ": maptype for atm->ocn mapping of aofluxes from atm->ocn either mapfcopy or mapconsd", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE + return + end if + + ! Map ocn->atm conservatively without fractions + call ESMF_FieldRegrid(field_src, field_dst, routehandle=is_local%wrap%RH(compocn,compatm, maptype), & + termorderflag=ESMF_TERMORDER_SRCSEQ, zeroregion=ESMF_REGION_TOTAL, rc=rc) + + ! Normalization of map by 'one' + if (maptype /= mapfcopy) then + call ESMF_FieldGet(is_local%wrap%field_normOne(compocn,compatm,maptype), farrayPtr=data_normdst, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(field_dst, farrayptr=data_dst, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + do n = 1,size(data_dst) + if (data_normdst(n) == 0.0_r8) then + data_dst(n) = 0.0_r8 + else + data_dst(n) = data_dst(n)/data_normdst(n) + end if + end do + end if + end do + + else if (is_local%wrap%aoflux_grid == 'xgrid') then + + ! Map input atm to xgrid + do nf = 1,size(fldnames_atm_in) + ! Get the source field + call ESMF_FieldBundleGet(is_local%wrap%FBImp(compatm,compatm), fldnames_atm_in(nf), field=field_src, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Get the destination field + call ESMF_FieldBundleGet(FBatm_x, fldnames_atm_in(nf), field=field_dst, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Map atm->xgrid conservatively + if (trim(fldnames_atm_in(nf)) == 'Sa_u' .or. (trim(fldnames_atm_in(nf)) == 'Sa_v')) then + call ESMF_FieldRegrid(field_src, field_dst, routehandle=rh_agrid2xgrid_2ndord, & + termorderflag=ESMF_TERMORDER_SRCSEQ, zeroregion=ESMF_REGION_TOTAL, rc=rc) + else + call ESMF_FieldRegrid(field_src, field_dst, routehandle=rh_agrid2xgrid, & + termorderflag=ESMF_TERMORDER_SRCSEQ, zeroregion=ESMF_REGION_TOTAL, rc=rc) + end if + end do + + ! map input ocn to xgrid + do nf = 1,size(fldnames_ocn_in) + ! Create source field + call ESMF_FieldBundleGet(is_local%wrap%FBImp(compocn,compocn), fldnames_ocn_in(nf), field=field_src, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Create destination field + call ESMF_FieldBundleGet(FBocn_x, fldnames_ocn_in(nf), field=field_dst, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Map ocn->xgrid conservatively without fractions + if (trim(fldnames_atm_in(nf)) == 'So_u' .or. (trim(fldnames_atm_in(nf)) == 'So_v')) then + call ESMF_FieldRegrid(field_src, field_dst, routehandle=rh_ogrid2xgrid, & + termorderflag=ESMF_TERMORDER_SRCSEQ, zeroregion=ESMF_REGION_TOTAL, rc=rc) + else + call ESMF_FieldRegrid(field_src, field_dst, routehandle=rh_ogrid2xgrid, & + termorderflag=ESMF_TERMORDER_SRCSEQ, zeroregion=ESMF_REGION_TOTAL, rc=rc) + end if + end do + end if !---------------------------------- - ! Update atmosphere/ocean surface fluxes + ! Calculate quantities if they are not defined !---------------------------------- + ! Note pbot, tbot and shum have already been mapped or are available on the aoflux grid if (compute_atm_thbot) then - do n = 1,lsize - if (aoflux%mask(n) /= 0._r8) then - aoflux%thbot(n) = aoflux%tbot(n)*((100000._R8/aoflux%pbot(n))**0.286_R8) + do n = 1,aoflux_in%lsize + if (aoflux_in%mask(n) /= 0._r8) then + aoflux_in%thbot(n) = aoflux_in%tbot(n)*((100000._R8/aoflux_in%pbot(n))**0.286_R8) end if end do end if if (compute_atm_dens) then - do n = 1,lsize - if (aoflux%mask(n) /= 0._r8) then - aoflux%dens(n) = aoflux%pbot(n)/(287.058_R8*(1._R8 + 0.608_R8*aoflux%shum(n))*aoflux%tbot(n)) + do n = 1,aoflux_in%lsize + if (aoflux_in%mask(n) /= 0._r8) then + aoflux_in%dens(n) = aoflux_in%pbot(n)/(287.058_R8*(1._R8 + 0.608_R8*aoflux_in%shum(n))*aoflux_in%tbot(n)) end if end do end if + !---------------------------------- + ! Update atmosphere/ocean surface fluxes + !---------------------------------- + call shr_flux_atmocn (& - nMax=lsize, zbot=aoflux%zbot, ubot=aoflux%ubot, vbot=aoflux%vbot, thbot=aoflux%thbot, & - qbot=aoflux%shum, s16O=aoflux%shum_16O, sHDO=aoflux%shum_HDO, s18O=aoflux%shum_18O, rbot=aoflux%dens, & - tbot=aoflux%tbot, us=aoflux%uocn, vs=aoflux%vocn, & - ts=aoflux%tocn, mask=aoflux%mask, seq_flux_atmocn_minwind=0.5_r8, & - sen=aoflux%sen, lat=aoflux%lat, lwup=aoflux%lwup, & - r16O=aoflux%roce_16O, rhdo=aoflux%roce_HDO, r18O=aoflux%roce_18O, & - evap=aoflux%evap, evap_16O=aoflux%evap_16O, evap_HDO=aoflux%evap_HDO, evap_18O=aoflux%evap_18O, & - taux=aoflux%taux, tauy=aoflux%tauy, tref=aoflux%tref, qref=aoflux%qref, & + nMax=aoflux_in%lsize, & + zbot=aoflux_in%zbot, ubot=aoflux_in%ubot, vbot=aoflux_in%vbot, thbot=aoflux_in%thbot, qbot=aoflux_in%shum, & + s16O=aoflux_in%shum_16O, sHDO=aoflux_in%shum_HDO, s18O=aoflux_in%shum_18O, rbot=aoflux_in%dens, & + tbot=aoflux_in%tbot, us=aoflux_in%uocn, vs=aoflux_in%vocn, ts=aoflux_in%tocn, & + mask=aoflux_in%mask, seq_flux_atmocn_minwind=0.5_r8, & + sen=aoflux_out%sen, lat=aoflux_out%lat, lwup=aoflux_out%lwup, & + r16O=aoflux_in%roce_16O, rhdo=aoflux_in%roce_HDO, r18O=aoflux_in%roce_18O, & + evap=aoflux_out%evap, evap_16O=aoflux_out%evap_16O, evap_HDO=aoflux_out%evap_HDO, evap_18O=aoflux_out%evap_18O, & + taux=aoflux_out%taux, tauy=aoflux_out%tauy, tref=aoflux_out%tref, qref=aoflux_out%qref, & ocn_surface_flux_scheme=ocn_surface_flux_scheme, & - duu10n=aoflux%duu10n, ustar_sv=aoflux%ustar, re_sv=aoflux%re, ssq_sv=aoflux%ssq, & + duu10n=aoflux_out%duu10n, ustar_sv=aoflux_out%ustar, re_sv=aoflux_out%re, ssq_sv=aoflux_out%ssq, & missval = 0.0_r8) - do n = 1,lsize - if (aoflux%mask(n) /= 0) then - aoflux%u10(n) = sqrt(aoflux%duu10n(n)) + do n = 1,aoflux_in%lsize + if (aoflux_in%mask(n) /= 0) then + aoflux_out%u10(n) = sqrt(aoflux_out%duu10n(n)) end if enddo + + !---------------------------------- + ! map aoflux output to relevant atm/ocn grid(s) + !---------------------------------- + + if (is_local%wrap%aoflux_grid == 'ogrid') then + + ! mapping aoflux from ogrid to agrid is done in med_phases_prep_atm using updated ocean fractions + ! on the atm grid + + else if (is_local%wrap%aoflux_grid == 'agrid') then + + if (is_local%wrap%med_coupling_active(compatm,compocn)) then + ! map aoflux from agrid to ogrid + do nf = 1,size(fldnames_aof_out) + ! Create source field + call ESMF_FieldBundleGet(is_local%wrap%FBMed_aoflux_a, fldnames_aof_out(nf), field=field_src, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Create destination field + call ESMF_FieldBundleGet(is_local%wrap%FBMed_aoflux_o, fldnames_aof_out(nf), field=field_dst, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Map atm->ocn conservatively WITHOUT fractions + if (med_map_RH_is_created(is_local%wrap%RH(compatm,compocn,:), mapfcopy, rc=rc)) then + maptype = mapfcopy + else if (med_map_RH_is_created(is_local%wrap%RH(compatm,compocn,:), mapconsf, rc=rc)) then + maptype = mapconsf + else + call ESMF_LogWrite(trim(subname)//& + ": maptype for atm->ocn mapping of aofluxes from atm->ocn either mapfcopy or mapconsf", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE + return + end if + call ESMF_FieldRegrid(field_src, field_dst, & + routehandle=is_local%wrap%RH(compatm, compocn, maptype), & + termorderflag=ESMF_TERMORDER_SRCSEQ, zeroregion=ESMF_REGION_TOTAL, rc=rc) + end do + end if + + else if (is_local%wrap%aoflux_grid == 'xgrid') then + + do nf = 1,size(fldnames_aof_out) + + ! Get the source field + call ESMF_FieldBundleGet(FBaof_x, fldnames_aof_out(nf), field=field_src, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! map aoflux from xgrid to agrid followed by normalization by 'one' + call ESMF_FieldBundleGet(is_local%wrap%FBMed_aoflux_a, fldnames_aof_out(nf), field=field_dst, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldRegrid(field_src, field_dst, routehandle=rh_xgrid2agrid, & + termorderflag=ESMF_TERMORDER_SRCSEQ, zeroregion=ESMF_REGION_TOTAL, rc=rc) + ! normalization by 'one' + call ESMF_FieldGet(field_xgrid2agrid_normone, farrayPtr=data_normdst, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(field_dst, farrayptr=data_dst, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + do n = 1,size(data_dst) + if (data_normdst(n) == 0.0_r8) then + data_dst(n) = 0.0_r8 + else + data_dst(n) = data_dst(n)/data_normdst(n) + end if + end do + + ! map aoflx from xgrid->ogrid conservatively + call ESMF_FieldBundleGet(is_local%wrap%FBMed_aoflux_o, fldnames_aof_out(nf), field=field_dst, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldRegrid(field_src, field_dst, routehandle=rh_xgrid2ogrid, & + termorderflag=ESMF_TERMORDER_SRCSEQ, zeroregion=ESMF_REGION_TOTAL, rc=rc) + end do + + end if + call t_stopf('MED:'//subname) - end subroutine med_aofluxes_run + end subroutine med_aofluxes_update + +!================================================================================ + subroutine set_aoflux_in_pointers(fldbun_a, fldbun_o, aoflux_in, lsize, xgrid, rc) + + ! Set pointers for aoflux_in attributes + ! Note that if computation is on the xgrid, fldbun_a and fldbun_o are both fldbun_x + + ! input/output variables + type(ESMF_FieldBundle) , intent(inout) :: fldbun_a + type(ESMF_FieldBundle) , intent(inout) :: fldbun_o + type(aoflux_in_type) , intent(inout) :: aoflux_in + integer , intent(out) :: lsize + type(ESMF_Xgrid), optional , intent(inout) :: xgrid + integer , intent(out) :: rc + !----------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + ! ------------------------ + ! input fields from atm on aoflux grid + ! ------------------------ + + ! Determine lsize from first field + call fldbun_getfldptr(fldbun_a, 'Sa_z', aoflux_in%zbot, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + lsize = size(aoflux_in%zbot) + aoflux_in%lsize = lsize + + ! bulk formula quantities for nems_orig_data + if (trim(coupling_mode) == 'nems_orig_data' .and. ocn_surface_flux_scheme == -1) then + call fldbun_getfldptr(fldbun_a, 'Sa_u10m', aoflux_in%ubot, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call fldbun_getfldptr(fldbun_a, 'Sa_v10m', aoflux_in%vbot, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call fldbun_getfldptr(fldbun_a, 'Sa_t2m', aoflux_in%tbot, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call fldbun_getfldptr(fldbun_a, 'Sa_q2m', aoflux_in%shum, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + call fldbun_getfldptr(fldbun_a, 'Sa_u', aoflux_in%ubot, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call fldbun_getfldptr(fldbun_a, 'Sa_v', aoflux_in%vbot, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call fldbun_getfldptr(fldbun_a, 'Sa_tbot', aoflux_in%tbot, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call fldbun_getfldptr(fldbun_a, 'Sa_shum', aoflux_in%shum, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + + ! bottom level potential temperature will need to be computed if not received from the atm + if (compute_atm_thbot) then + allocate(aoflux_in%thbot(lsize)) + else + call fldbun_getfldptr(fldbun_a, 'Sa_ptem', aoflux_in%thbot, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + + ! bottom level density will need to be computed if not received from the atm + if (compute_atm_dens) then + allocate(aoflux_in%dens(lsize)) + else + call fldbun_getfldptr(fldbun_a, 'Sa_dens', aoflux_in%dens, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + + ! if either density or potential temperature are computed, will need bottom level pressure + if (compute_atm_dens .or. compute_atm_thbot) then + call fldbun_getfldptr(fldbun_a, 'Sa_pbot', aoflux_in%pbot, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + + if (flds_wiso) then + call fldbun_getfldptr(fldbun_a, 'Sa_shum_16O', aoflux_in%shum_16O, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call fldbun_getfldptr(fldbun_a, 'Sa_shum_18O', aoflux_in%shum_18O, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call fldbun_getfldptr(fldbun_a, 'Sa_shum_HDO', aoflux_in%shum_HDO, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + allocate(aoflux_in%shum_16O(lsize)); aoflux_in%shum_16O(:) = 0._R8 + allocate(aoflux_in%shum_18O(lsize)); aoflux_in%shum_18O(:) = 0._R8 + allocate(aoflux_in%shum_HDO(lsize)); aoflux_in%shum_HDO(:) = 0._R8 + end if + + ! ------------------------ + ! input fields from ocn on aoflux_grid + ! ------------------------ + + ! point directly into input field bundle from ocean on the ocean grid + call fldbun_getfldptr(fldbun_o, 'So_omask', aoflux_in%rmask, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call fldbun_getfldptr(fldbun_o, 'So_t', aoflux_in%tocn, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call fldbun_getfldptr(fldbun_o, 'So_u', aoflux_in%uocn, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call fldbun_getfldptr(fldbun_o, 'So_v', aoflux_in%vocn, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (flds_wiso) then + call fldbun_getfldptr(fldbun_o, 'So_roce_16O', aoflux_in%roce_16O, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call fldbun_getfldptr(fldbun_o, 'So_roce_18O', aoflux_in%roce_18O, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call fldbun_getfldptr(fldbun_o, 'So_roce_HDO', aoflux_in%roce_HDO, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + allocate(aoflux_in%roce_16O(aoflux_in%lsize)); aoflux_in%roce_16O(:) = 0._R8 + allocate(aoflux_in%roce_18O(aoflux_in%lsize)); aoflux_in%roce_18O(:) = 0._R8 + allocate(aoflux_in%roce_HDO(aoflux_in%lsize)); aoflux_in%roce_HDO(:) = 0._R8 + end if + + end subroutine set_aoflux_in_pointers + + !================================================================================ + subroutine set_aoflux_out_pointers(fldbun, lsize, aoflux_out, xgrid, rc) + + ! input/output variables + type(ESMF_FieldBundle) , intent(inout) :: fldbun + integer , intent(in) :: lsize + type(aoflux_out_type) , intent(inout) :: aoflux_out + type(ESMF_Xgrid), optional , intent(inout) :: xgrid + integer , intent(out) :: rc + + rc = ESMF_SUCCESS + !----------------------------------------------------------------------- + + call fldbun_getfldptr(fldbun, 'So_tref', aoflux_out%tref, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call fldbun_getfldptr(fldbun, 'So_qref', aoflux_out%qref, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call fldbun_getfldptr(fldbun, 'So_ustar', aoflux_out%ustar, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call fldbun_getfldptr(fldbun, 'So_re', aoflux_out%re, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call fldbun_getfldptr(fldbun, 'So_ssq', aoflux_out%ssq, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call fldbun_getfldptr(fldbun, 'So_u10', aoflux_out%u10, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call fldbun_getfldptr(fldbun, 'So_duu10n', aoflux_out%duu10n, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call fldbun_getfldptr(fldbun, 'Faox_taux', aoflux_out%taux, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call fldbun_getfldptr(fldbun, 'Faox_tauy', aoflux_out%tauy, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call fldbun_getfldptr(fldbun, 'Faox_lat', aoflux_out%lat, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call fldbun_getfldptr(fldbun, 'Faox_sen', aoflux_out%sen, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call fldbun_getfldptr(fldbun, 'Faox_evap', aoflux_out%evap, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call fldbun_getfldptr(fldbun, 'Faox_lwup', aoflux_out%lwup, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (flds_wiso) then + call fldbun_getfldptr(fldbun, 'Faox_evap_16O', aoflux_out%evap_16O, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call fldbun_getfldptr(fldbun, 'Faox_evap_18O', aoflux_out%evap_18O, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call fldbun_getfldptr(fldbun, 'Faox_evap_HDO', aoflux_out%evap_HDO, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + allocate(aoflux_out%evap_16O(lsize)); aoflux_out%evap_16O(:) = 0._R8 + allocate(aoflux_out%evap_18O(lsize)); aoflux_out%evap_18O(:) = 0._R8 + allocate(aoflux_out%evap_HDO(lsize)); aoflux_out%evap_HDO(:) = 0._R8 + end if + + end subroutine set_aoflux_out_pointers + + !================================================================================ + subroutine fldbun_getfldptr(fldbun, fldname, fldptr, xgrid, rc) + + ! input/output variables + type(ESMF_FieldBundle) , intent(inout) :: fldbun + character(len=*) , intent(in) :: fldname + real(r8) , pointer :: fldptr(:) + type(ESMF_Xgrid), optional , intent(in) :: xgrid + integer , intent(out) :: rc + + ! local variables + type(ESMF_Field) :: lfield + !----------------------------------------------------------------------- + rc = ESMF_SUCCESS + + if (present(xgrid)) then + lfield = ESMF_FieldCreate(xgrid, typekind=ESMF_TYPEKIND_R8, name=trim(fldname), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleAdd(fldbun, (/lfield/), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + call ESMF_FieldBundleGet(fldbun, trim(fldname), field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + + end subroutine fldbun_getfldptr end module med_phases_aofluxes_mod diff --git a/mediator/med_phases_post_lnd_mod.F90 b/mediator/med_phases_post_lnd_mod.F90 index 21f4f243e..dc9be074d 100644 --- a/mediator/med_phases_post_lnd_mod.F90 +++ b/mediator/med_phases_post_lnd_mod.F90 @@ -6,8 +6,6 @@ module med_phases_post_lnd_mod public :: med_phases_post_lnd_init ! does not accumulate input to rof public :: med_phases_post_lnd - logical :: lnd2glc_coupling - character(*), parameter :: u_FILE_u = & __FILE__ @@ -27,7 +25,7 @@ subroutine med_phases_post_lnd(gcomp, rc) 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 + use esmFlds , only : complnd, compatm, comprof, compglc, num_icesheets, lnd2glc_coupling use perf_mod , only : t_startf, t_stopf ! input/output variables @@ -71,18 +69,7 @@ subroutine med_phases_post_lnd(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - ! first determine if there will be any lnd to glc coupling - if (first_call) then - do ns = 1,num_icesheets - if (is_local%wrap%med_coupling_active(complnd,compglc(ns))) then - lnd2glc_coupling = .true. - exit - end if - end do - first_call = .false. - end if - - ! accumulate lnd input for glc + ! 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 (ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index c27dd281a..fae8f4281 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -108,15 +108,20 @@ subroutine med_phases_prep_atm(gcomp, rc) !--- map atm/ocn fluxes from ocn to atm grid if appropriate !--------------------------------------- if (trim(coupling_mode) == 'cesm' .or. trim(coupling_mode) == 'hafs') then - ! Assumption here is that fluxes are computed on the ocean grid - call med_map_field_packed( & - FBSrc=is_local%wrap%FBMed_aoflux_o, & - FBDst=is_local%wrap%FBMed_aoflux_a, & - FBFracSrc=is_local%wrap%FBFrac(compocn), & - field_normOne=is_local%wrap%field_normOne(compocn,compatm,:), & - packed_data=is_local%wrap%packed_data_aoflux_o2a(:), & - routehandles=is_local%wrap%RH(compocn,compatm,:), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (is_local%wrap%aoflux_grid == 'ogrid') then + call med_map_field_packed( & + FBSrc=is_local%wrap%FBMed_aoflux_o, & + FBDst=is_local%wrap%FBMed_aoflux_a, & + FBFracSrc=is_local%wrap%FBFrac(compocn), & + field_normOne=is_local%wrap%field_normOne(compocn,compatm,:), & + packed_data=is_local%wrap%packed_data_aoflux_o2a(:), & + routehandles=is_local%wrap%RH(compocn,compatm,:), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else if (is_local%wrap%aoflux_grid == 'agrid') then + ! do nothing - is_local%wrap%FBMed_aoflux_a has been computed in med_aofluxes_init_agrid + else if (is_local%wrap%aoflux_grid == 'xgrid') then + ! do nothing - is_local%wrap%FBMed_aoflux_a has been computed in med_aofluxes_init_agrid + end if endif !--------------------------------------- diff --git a/mediator/med_phases_prep_glc_mod.F90 b/mediator/med_phases_prep_glc_mod.F90 index 93044dd01..ded19a045 100644 --- a/mediator/med_phases_prep_glc_mod.F90 +++ b/mediator/med_phases_prep_glc_mod.F90 @@ -11,7 +11,8 @@ module med_phases_prep_glc_mod use NUOPC_Model , only : NUOPC_ModelGet use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LOGMSG_ERROR, ESMF_SUCCESS, ESMF_FAILURE use ESMF , only : ESMF_VM, ESMF_VMGet, ESMF_VMAllReduce, ESMF_REDUCE_SUM, ESMF_REDUCE_MAX - use ESMF , only : ESMF_Clock, ESMF_ClockCreate, ESMF_ClockGetAlarm, ESMF_ClockAdvance, ESMF_ClockGet + use ESMF , only : ESMF_Clock, ESMF_ClockCreate, ESMF_ClockIsCreated + use ESMF , only : ESMF_ClockGetAlarm, ESMF_ClockAdvance, ESMF_ClockGet use ESMF , only : ESMF_Time, ESMF_TimeGet use ESMF , only : ESMF_Alarm, ESMF_AlarmCreate, ESMF_AlarmSet, ESMF_AlarmGet use ESMF , only : ESMF_AlarmIsRinging, ESMF_AlarmRingerOff @@ -23,7 +24,7 @@ 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 + use esmFlds , only : max_icesheets, num_icesheets, compglc, ocn2glc_coupling, lnd2glc_coupling 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 @@ -48,11 +49,11 @@ module med_phases_prep_glc_mod implicit none 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 - public :: med_phases_prep_glc_accum_ocn ! called from med_phases_post_ocn + 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 - private :: med_phases_prep_glc_init private :: med_phases_prep_glc_map_lnd2glc private :: med_phases_prep_glc_renormalize_smb @@ -70,49 +71,47 @@ module med_phases_prep_glc_mod ! Does not need to be true for 1-way coupling. logical :: smb_renormalize - type(ESMF_FieldBundle) :: FBlndAccum_l - integer :: FBlndAccumCnt - 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 '/) - + 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 '/) + type, public :: toglc_frlnd_type character(CS) :: name - type(ESMF_FieldBundle) :: FBlndAccum_g + type(ESMF_FieldBundle) :: FBlndAccum2glc_g type(ESMF_Field) :: field_icemask_g type(ESMF_Field) :: field_frac_g type(ESMF_Field) :: field_frac_g_ec type(ESMF_Field) :: field_lfrac_g type(ESMF_Mesh) :: mesh_g end type toglc_frlnd_type - type(toglc_frlnd_type) :: toglc_frlnd(max_icesheets) ! TODO: make this allocatable for number of actual ice sheets + type(toglc_frlnd_type) :: toglc_frlnd(max_icesheets) ! TODO: make this allocatable for number of actual ice sheets - type(ESMF_Field) :: field_normdst_l - type(ESMF_Field) :: field_icemask_l - type(ESMF_Field) :: field_frac_l - type(ESMF_Field) :: field_frac_l_ec - type(ESMF_Field) :: field_lnd_icemask_l - real(r8) , pointer :: aream_l(:) => null() ! cell areas on land grid, for mapping + type(ESMF_Field) :: field_normdst_l + type(ESMF_Field) :: field_icemask_l + type(ESMF_Field) :: field_frac_l + type(ESMF_Field) :: field_frac_l_ec + type(ESMF_Field) :: field_lnd_icemask_l + real(r8) , pointer :: aream_l(:) => null() ! cell areas on land grid, for mapping - character(len=*), parameter :: qice_fieldname = 'Flgl_qice' ! Name of flux field giving surface mass balance - character(len=*), parameter :: Sg_frac_fieldname = 'Sg_ice_covered' - character(len=*), parameter :: Sg_topo_fieldname = 'Sg_topo' - character(len=*), parameter :: Sg_icemask_fieldname = 'Sg_icemask' - integer :: ungriddedCount ! this equals the number of elevation classes + 1 (for bare land) + character(len=*), parameter :: qice_fieldname = 'Flgl_qice' ! Name of flux field giving surface mass balance + character(len=*), parameter :: Sg_frac_fieldname = 'Sg_ice_covered' + character(len=*), parameter :: Sg_topo_fieldname = 'Sg_topo' + character(len=*), parameter :: Sg_icemask_fieldname = 'Sg_icemask' + integer :: ungriddedCount ! this equals the number of elevation classes + 1 (for bare land) ! ----------------- ! ocn -> glc ! ----------------- - type(ESMF_FieldBundle) :: FBocnAccum_o - integer :: FBocnAccumCnt - character(len=14) :: fldnames_fr_ocn(2) = (/'So_t_depth','So_s_depth'/) ! TODO: what else needs to be added here - type(ESMF_DynamicMask) :: dynamicOcnMask - integer, parameter :: num_ocndepths = 7 - logical :: ocn_sends_depths = .false. + type(ESMF_FieldBundle), public :: FBocnAccum2glc_o + integer , public :: ocnAccum2glc_cnt + character(len=14) :: fldnames_fr_ocn(2) = (/'So_t_depth','So_s_depth'/) ! TODO: what else needs to be added here + type(ESMF_DynamicMask) :: dynamicOcnMask + integer, parameter :: num_ocndepths = 7 + logical :: ocn_sends_depths = .false. - logical :: lnd2glc_coupling = .false. - logical :: init_prep_glc = .false. - type(ESMF_Clock) :: prepglc_clock + type(ESMF_Clock) :: prepglc_clock character(*), parameter :: u_FILE_u = & __FILE__ @@ -142,12 +141,6 @@ subroutine med_phases_prep_glc_init(gcomp, rc) 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(ESMF_Clock) :: med_clock - type(ESMF_ALARM) :: glc_avg_alarm - logical :: glc_present - character(len=CS) :: glc_avg_period - integer :: glc_cpl_dt - character(len=CS) :: cvalue character(len=*),parameter :: subname=' (med_phases_prep_glc_init) ' !--------------------------------------- @@ -162,56 +155,11 @@ subroutine med_phases_prep_glc_init(gcomp, rc) nullify(is_local%wrap) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (chkErr(rc,__LINE__,u_FILE_u)) return - - ! ------------------------------- - ! Initialize prepglc_clock - ! ------------------------------- - - ! Initialize mediator 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, 'nyears', opt_n=1, 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 ! ------------------------------- ! If lnd->glc couplng is active ! ------------------------------- - do ns = 1,num_icesheets - if (is_local%wrap%med_coupling_active(complnd,compglc(ns))) then - lnd2glc_coupling = .true. - exit - end if - end do if (lnd2glc_coupling) then ! Determine if renormalize smb @@ -259,41 +207,41 @@ subroutine med_phases_prep_glc_init(gcomp, rc) call fldbun_getmesh(is_local%wrap%FBImp(complnd,complnd), mesh_l, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - FBlndAccum_l = ESMF_FieldBundleCreate(name='FBlndAccum_l', rc=rc) + FBlndAccum2glc_l = ESMF_FieldBundleCreate(name='FBlndAccum2glc_l', rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return do n = 1,size(fldnames_fr_lnd) lfield = ESMF_FieldCreate(mesh_l, ESMF_TYPEKIND_R8, name=fldnames_fr_lnd(n), & meshloc=ESMF_MESHLOC_ELEMENT, & ungriddedLbound=(/1/), ungriddedUbound=(/ungriddedCount/), gridToFieldMap=(/2/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldBundleAdd(FBlndAccum_l, (/lfield/), rc=rc) + call ESMF_FieldBundleAdd(FBlndAccum2glc_l, (/lfield/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(trim(subname)//' adding field '//trim(fldnames_fr_lnd(n))//' to FBLndAccum_l', & ESMF_LOGMSG_INFO) end do - call fldbun_reset(FBlndAccum_l, value=0.0_r8, rc=rc) + call fldbun_reset(FBlndAccum2glc_l, value=0.0_r8, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! 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 FBlndAccum_g has the fields fldnames_fr_lnd BUT ON the glc grid + ! However FBlndAccum2glc_g has the fields fldnames_fr_lnd BUT ON the glc grid do ns = 1,num_icesheets ! get mesh on glc grid call fldbun_getmesh(is_local%wrap%FBExp(compglc(ns)), toglc_frlnd(ns)%mesh_g, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! create accumulation field bundle on glc grid - toglc_frlnd(ns)%FBlndAccum_g = ESMF_FieldBundleCreate(rc=rc) + toglc_frlnd(ns)%FBlndAccum2glc_g = ESMF_FieldBundleCreate(rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return do nf = 1,size(fldnames_fr_lnd) lfield = ESMF_FieldCreate(toglc_frlnd(ns)%mesh_g, ESMF_TYPEKIND_R8, name=fldnames_fr_lnd(nf), & meshloc=ESMF_MESHLOC_ELEMENT, & ungriddedLbound=(/1/), ungriddedUbound=(/ungriddedCount/), gridToFieldMap=(/2/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldBundleAdd(toglc_frlnd(ns)%FBlndAccum_g, (/lfield/), rc=rc) + call ESMF_FieldBundleAdd(toglc_frlnd(ns)%FBlndAccum2glc_g, (/lfield/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end do - call fldbun_reset(toglc_frlnd(ns)%FBlndAccum_g, value=0.0_r8, rc=rc) + call fldbun_reset(toglc_frlnd(ns)%FBlndAccum2glc_g, value=0.0_r8, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! create land fraction field on glc mesh (this is just needed for normalization mapping) @@ -404,19 +352,19 @@ subroutine med_phases_prep_glc_init(gcomp, rc) call fldbun_getmesh(is_local%wrap%FBImp(compocn,compocn), mesh_o, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - FBocnAccum_o = ESMF_FieldBundleCreate(name='FBocnAccum_o', rc=rc) + FBocnAccum2glc_o = ESMF_FieldBundleCreate(name='FBocnAccum2glc_o', rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return do n = 1,size(fldnames_fr_ocn) lfield = ESMF_FieldCreate(mesh_o, ESMF_TYPEKIND_R8, name=fldnames_fr_ocn(n), & meshloc=ESMF_MESHLOC_ELEMENT, & ungriddedLbound=(/1/), ungriddedUbound=(/num_ocndepths/), gridToFieldMap=(/2/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldBundleAdd(FBocnAccum_o, (/lfield/), rc=rc) + call ESMF_FieldBundleAdd(FBocnAccum2glc_o, (/lfield/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(trim(subname)//' adding field '//trim(fldnames_fr_ocn(n))//' to FBOcnAccum_o', & + call ESMF_LogWrite(trim(subname)//' adding field '//trim(fldnames_fr_ocn(n))//' to FBOcnAccum2glc_o', & ESMF_LOGMSG_INFO) end do - call fldbun_reset(FBocnAccum_o, value=czero, rc=rc) + call fldbun_reset(FBocnAccum2glc_o, value=czero, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! create route handle if it has not been created @@ -467,7 +415,12 @@ subroutine med_phases_prep_glc_accum_lnd(gcomp, rc) integer :: i,n real(r8), pointer :: data2d_in(:,:) => null() real(r8), pointer :: data2d_out(:,:) => null() - character(len=*),parameter :: subname=' (med_phases_prep_glc_accum) ' + 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) ' !--------------------------------------- call t_startf('MED:'//subname) @@ -477,10 +430,42 @@ subroutine med_phases_prep_glc_accum_lnd(gcomp, rc) rc = ESMF_SUCCESS - if (.not. init_prep_glc) then - call med_phases_prep_glc_init(gcomp, 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 - init_prep_glc = .true. end if ! Advance prepglc_clock - this will make the prepglc_clock in sync with the mediator clock @@ -497,15 +482,15 @@ subroutine med_phases_prep_glc_accum_lnd(gcomp, rc) do n = 1, size(fldnames_fr_lnd) call fldbun_getdata2d(is_local%wrap%FBImp(complnd,complnd), fldnames_fr_lnd(n), data2d_in, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call fldbun_getdata2d(FBlndAccum_l, fldnames_fr_lnd(n), data2d_out, rc) + call fldbun_getdata2d(FBlndAccum2glc_l, fldnames_fr_lnd(n), data2d_out, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return do i = 1,size(data2d_out, dim=2) data2d_out(:,i) = data2d_out(:,i) + data2d_in(:,i) end do end do - FBlndAccumCnt = FBlndAccumCnt + 1 + lndAccum2glc_cnt = lndAccum2glc_cnt + 1 if (dbug_flag > 1) then - call fldbun_diagnose(FBlndAccum_l, string=trim(subname)// ' FBlndAccum_l ', rc=rc) + call fldbun_diagnose(FBlndAccum2glc_l, string=trim(subname)// ' FBlndAccum2glc_l ', rc=rc) if (chkErr(rc,__LINE__,u_FILE_u)) return end if if (dbug_flag > 5) then @@ -547,12 +532,6 @@ subroutine med_phases_prep_glc_accum_ocn(gcomp, rc) rc = ESMF_SUCCESS - if (.not. init_prep_glc) then - call med_phases_prep_glc_init(gcomp, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - init_prep_glc = .true. - end if - ! Get the internal state nullify(is_local%wrap) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) @@ -567,15 +546,15 @@ subroutine med_phases_prep_glc_accum_ocn(gcomp, rc) do n = 1, size(fldnames_fr_ocn) call fldbun_getdata2d(is_local%wrap%FBImp(compocn,compocn), fldnames_fr_ocn(n), data2d_in, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call fldbun_getdata2d(FBocnAccum_o, fldnames_fr_ocn(n), data2d_out, rc) + call fldbun_getdata2d(FBocnAccum2glc_o, fldnames_fr_ocn(n), data2d_out, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return do i = 1,size(data2d_out, dim=2) data2d_out(:,i) = data2d_out(:,i) + data2d_in(:,i) end do end do - FBocnAccumCnt = FBocnAccumCnt + 1 + ocnAccum2glc_cnt = ocnAccum2glc_cnt + 1 if (dbug_flag > 1) then - call fldbun_diagnose(FBocnAccum_o, string=trim(subname)// ' FBocnAccum_o ', rc=rc) + call fldbun_diagnose(FBocnAccum2glc_o, string=trim(subname)// ' FBocnAccum2glc_o ', rc=rc) if (chkErr(rc,__LINE__,u_FILE_u)) return end if @@ -621,12 +600,6 @@ subroutine med_phases_prep_glc(gcomp, rc) end if rc = ESMF_SUCCESS - if (.not. init_prep_glc) then - call med_phases_prep_glc_init(gcomp, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - init_prep_glc = .true. - end if - ! Get the internal state nullify(is_local%wrap) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) @@ -668,11 +641,11 @@ subroutine med_phases_prep_glc(gcomp, rc) ! Average import from accumulated land import data do n = 1, size(fldnames_fr_lnd) - call fldbun_getdata2d(FBlndAccum_l, fldnames_fr_lnd(n), data2d, rc) + call fldbun_getdata2d(FBlndAccum2glc_l, fldnames_fr_lnd(n), data2d, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (FBlndAccumCnt > 0) then + if (lndAccum2glc_cnt > 0) then ! If accumulation count is greater than 0, do the averaging - data2d(:,:) = data2d(:,:) / real(FBlndAccumCnt) + data2d(:,:) = data2d(:,:) / real(lndAccum2glc_cnt) else ! If accumulation count is 0, then simply set the averaged field bundle values from the land ! to the import field bundle values @@ -685,11 +658,11 @@ subroutine med_phases_prep_glc(gcomp, rc) if (ocn2glc_coupling) then ! Average import from accumulated ocn import data do n = 1, size(fldnames_fr_ocn) - call fldbun_getdata2d(FBocnAccum_o, fldnames_fr_ocn(n), data2d, rc) + call fldbun_getdata2d(FBocnAccum2glc_o, fldnames_fr_ocn(n), data2d, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (FBocnAccumCnt > 0) then + if (ocnAccum2glc_cnt > 0) then ! If accumulation count is greater than 0, do the averaging - data2d(:,:) = data2d(:,:) / real(FBocnAccumCnt) + data2d(:,:) = data2d(:,:) / real(ocnAccum2glc_cnt) else ! If accumulation count is 0, then simply set the averaged field bundle values from the ocn ! to the import field bundle values @@ -699,14 +672,14 @@ subroutine med_phases_prep_glc(gcomp, rc) end if end do if (dbug_flag > 1) then - call fldbun_diagnose(FBocnAccum_o, string=trim(subname)//' FBocnAccum for after avg for field bundle ', rc=rc) + call fldbun_diagnose(FBocnAccum2glc_o, string=trim(subname)//' FBocnAccum for after avg for field bundle ', rc=rc) if (chkErr(rc,__LINE__,u_FILE_u)) return end if ! Map accumulated ocean field from ocean mesh to land mesh and set FBExp(compglc(ns)) data ! Zero land accumulator and accumulated field bundles on ocean grid do n = 1,size(fldnames_fr_ocn) - call ESMF_FieldBundleGet(FBocnAccum_o, fldnames_fr_ocn(n), field=lfield_src, rc=rc) + call ESMF_FieldBundleGet(FBocnAccum2glc_o, fldnames_fr_ocn(n), field=lfield_src, rc=rc) if (chkErr(rc,__LINE__,u_FILE_u)) return do ns = 1,num_icesheets call ESMF_FieldBundleGet(is_local%wrap%FBExp(compglc(ns)), fldnames_fr_ocn(n), field=lfield_dst, rc=rc) @@ -717,8 +690,8 @@ subroutine med_phases_prep_glc(gcomp, rc) if (chkErr(rc,__LINE__,u_FILE_u)) return end do end do - FBocnAccumCnt = 0 - call fldbun_reset(FBocnAccum_o, value=czero, rc=rc) + ocnAccum2glc_cnt = 0 + call fldbun_reset(FBocnAccum2glc_o, value=czero, rc=rc) if (chkErr(rc,__LINE__,u_FILE_u)) return end if @@ -728,8 +701,8 @@ subroutine med_phases_prep_glc(gcomp, rc) ! Zero land accumulator and accumulated field bundles on land grid call med_phases_prep_glc_map_lnd2glc(gcomp, rc) if (chkErr(rc,__LINE__,u_FILE_u)) return - FBlndAccumCnt = 0 - call fldbun_reset(FBlndAccum_l, value=czero, rc=rc) + lndAccum2glc_cnt = 0 + call fldbun_reset(FBlndAccum2glc_l, value=czero, rc=rc) if (chkErr(rc,__LINE__,u_FILE_u)) return end if @@ -796,7 +769,7 @@ subroutine med_phases_prep_glc_map_lnd2glc(gcomp, rc) ! Initialize accumulated field bundle on the glc grid to zero before doing the mapping do ns = 1,num_icesheets - call fldbun_reset(toglc_frlnd(ns)%FBlndAccum_g, value=0.0_r8, rc=rc) + call fldbun_reset(toglc_frlnd(ns)%FBlndAccum2glc_g, value=0.0_r8, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end do @@ -806,12 +779,12 @@ subroutine med_phases_prep_glc_map_lnd2glc(gcomp, rc) ! notes that this could lead to a loss of conservation). Figure out how to handle ! this case. - ! get fieldlist from FBlndAccum_l - call ESMF_FieldBundleGet(FBlndAccum_l, fieldCount=fieldCount, rc=rc) + ! get fieldlist from FBlndAccum2glc_l + call ESMF_FieldBundleGet(FBlndAccum2glc_l, fieldCount=fieldCount, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return allocate(fieldlist_lnd(fieldcount)) allocate(fieldlist_glc(fieldcount)) - call ESMF_FieldBundleGet(FBlndAccum_l, fieldlist=fieldlist_lnd, rc=rc) + call ESMF_FieldBundleGet(FBlndAccum2glc_l, fieldlist=fieldlist_lnd, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! get land fraction field on land mesh @@ -820,13 +793,13 @@ subroutine med_phases_prep_glc_map_lnd2glc(gcomp, rc) ! TODO: is this needed? do ns = 1,num_icesheets - call fldbun_reset(toglc_frlnd(ns)%FBlndAccum_g, value=0.0_r8, rc=rc) + 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)%FBlndAccum_g, fieldlist=fieldlist_glc, rc=rc) + call ESMF_FieldBundleGet(toglc_frlnd(ns)%FBlndAccum2glc_g, fieldlist=fieldlist_glc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return do nfld = 1,fieldcount call med_map_field_normalized( & @@ -844,13 +817,13 @@ subroutine med_phases_prep_glc_map_lnd2glc(gcomp, rc) deallocate(fieldlist_glc) if (dbug_flag > 1) then - call fldbun_diagnose(FBlndAccum_l, string=trim(subname)//' FBlndAccum_l ', rc=rc) + call fldbun_diagnose(FBlndAccum2glc_l, string=trim(subname)//' FBlndAccum2glc_l ', rc=rc) if (chkErr(rc,__LINE__,u_FILE_u)) return call fldbun_diagnose(is_local%wrap%FBfrac(complnd), string=trim(subname)//' FBFrac ', rc=rc) if (chkErr(rc,__LINE__,u_FILE_u)) return do ns = 1,num_icesheets - call fldbun_diagnose(toglc_frlnd(ns)%FBlndAccum_g, string=trim(subname)//& - ' FBlndAccum_glc '//compname(compglc(ns)), rc=rc) + call fldbun_diagnose(toglc_frlnd(ns)%FBlndAccum2glc_g, string=trim(subname)//& + ' FBlndAccum2glc_glc '//compname(compglc(ns)), rc=rc) if (chkErr(rc,__LINE__,u_FILE_u)) return end do endif @@ -880,7 +853,7 @@ subroutine med_phases_prep_glc_map_lnd2glc(gcomp, rc) call glc_get_elevation_classes(ice_covered_g, topoglc_g, elevclass_g, logunit) ! Determine topo field in multiple elevation classes on the glc grid - call fldbun_getdata2d(toglc_frlnd(ns)%FBlndAccum_g, 'Sl_topo_elev', topolnd_g_ec, rc=rc) + call fldbun_getdata2d(toglc_frlnd(ns)%FBlndAccum2glc_g, 'Sl_topo_elev', topolnd_g_ec, rc=rc) if (chkErr(rc,__LINE__,u_FILE_u)) return ! ------------------------------------------------------------------------ @@ -898,7 +871,7 @@ subroutine med_phases_prep_glc_map_lnd2glc(gcomp, rc) do nfld = 1, size(fldnames_to_glc) ! Get a pointer to the land data in multiple elevation classes on the glc grid - call fldbun_getdata2d(toglc_frlnd(ns)%FBlndAccum_g, fldnames_fr_lnd(nfld), dataptr2d, rc) + call fldbun_getdata2d(toglc_frlnd(ns)%FBlndAccum2glc_g, fldnames_fr_lnd(nfld), dataptr2d, rc) if (chkErr(rc,__LINE__,u_FILE_u)) return ! Get a pointer to the data for the field that will be sent to glc (without elevation classes) @@ -965,12 +938,12 @@ subroutine med_phases_prep_glc_map_lnd2glc(gcomp, rc) ! Renormalize surface mass balance (smb, here named dataexp_g) so that the global ! integral on the glc grid is equal to the global integral on the land grid. ! ------------------------------------------------------------------------ - + ! No longer need to make a preemptive adjustment to qice_g to account for area differences ! between CISM and the coupler. In NUOPC, the area correction is done in! the cap not in the ! mediator, so to preserve the bilinear mapping values, do not need to do any area correction ! scaling in the CISM NUOPC cap - + if (smb_renormalize) then call med_phases_prep_glc_renormalize_smb(gcomp, rc) if (chkErr(rc,__LINE__,u_FILE_u)) return @@ -1097,7 +1070,7 @@ subroutine med_phases_prep_glc_renormalize_smb(gcomp, rc) !--------------------------------------- ! Map icemask_g from the glc grid to the land grid. !--------------------------------------- - + ! determine icemask_g and set as contents of field_icemask_g call fldbun_getdata1d(is_local%wrap%FBImp(compglc(ns),compglc(ns)), Sg_icemask_fieldname, dataptr1d, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -1161,7 +1134,7 @@ subroutine med_phases_prep_glc_renormalize_smb(gcomp, rc) if (chkErr(rc,__LINE__,u_FILE_u)) return ! get qice_l_ec - call fldbun_getdata2d(FBlndAccum_l, trim(qice_fieldname)//'_elev', qice_l_ec, rc) + call fldbun_getdata2d(FBlndAccum2glc_l, trim(qice_fieldname)//'_elev', qice_l_ec, rc) if (chkErr(rc,__LINE__,u_FILE_u)) return local_accum_lnd(1) = 0.0_r8 @@ -1299,4 +1272,3 @@ subroutine dynOcnMaskProc(dynamicMaskList, dynamicSrcMaskValue, dynamicDstMaskVa end subroutine DynOcnMaskProc end module med_phases_prep_glc_mod - diff --git a/mediator/med_phases_restart_mod.F90 b/mediator/med_phases_restart_mod.F90 index 353d8551c..4da865b67 100644 --- a/mediator/med_phases_restart_mod.F90 +++ b/mediator/med_phases_restart_mod.F90 @@ -11,8 +11,10 @@ module med_phases_restart_mod use med_internalstate_mod , only : mastertask, logunit, InternalState use med_phases_history_mod, only : num_auxfiles, auxfiles use med_time_mod , only : med_time_AlarmInit - use esmFlds , only : ncomps, compname, compocn + 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 + use med_phases_prep_glc_mod, only : FBocnAccum2glc_o, ocnAccum2glc_cnt implicit none private @@ -21,7 +23,8 @@ module med_phases_restart_mod public :: med_phases_restart_write private :: med_phases_restart_alarm_init - + logical :: write_restart_at_endofrun = .false. + character(*), parameter :: u_FILE_u = & __FILE__ @@ -61,6 +64,8 @@ subroutine med_phases_restart_alarm_init(gcomp, rc) character(CL) :: cvalue ! attribute string character(CL) :: restart_option ! freq_option setting (ndays, nsteps, etc) integer :: restart_n ! freq_n setting relative to freq_option + logical :: isPresent + logical :: isSet character(len=*), parameter :: subname='(med_phases_restart_alarm_init)' !--------------------------------------- @@ -106,6 +111,15 @@ 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 ! ----------------------------- @@ -115,6 +129,7 @@ subroutine med_phases_restart_alarm_init(gcomp, rc) write(logunit,100) trim(subname)//" restart clock timestep = ",timestep_length write(logunit,100) 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,*) end if @@ -150,6 +165,7 @@ subroutine med_phases_restart_write(gcomp, rc) type(ESMF_Time) :: starttime type(ESMF_Time) :: currtime type(ESMF_Time) :: nexttime + type(ESMF_Time), save :: lasttimewritten type(ESMF_TimeInterval) :: timediff ! Used to calculate curr_time type(ESMF_Alarm) :: alarm type(ESMF_Calendar) :: calendar @@ -252,9 +268,18 @@ subroutine med_phases_restart_write(gcomp, rc) call ESMF_AlarmRingerOff( alarm, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - AlarmIsOn = .false. + !--------------------------------------- + ! --- 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 + 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 @@ -364,10 +389,10 @@ subroutine med_phases_restart_write(gcomp, rc) call med_io_write(restart_file, iam, next_tod , 'curr_tod' , whead=whead, wdata=wdata, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_write(restart_file, iam, is_local%wrap%FBExpAccumCnt, dname='ExpAccumCnt', & + call med_io_write(restart_file, iam, is_local%wrap%FBExpAccumCnt, 'ExpAccumCnt', & whead=whead, wdata=wdata, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_write(restart_file, iam, is_local%wrap%FBImpAccumCnt, dname='ImpAccumCnt', & + call med_io_write(restart_file, iam, is_local%wrap%FBImpAccumCnt, 'ImpAccumCnt', & whead=whead, wdata=wdata, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -389,10 +414,6 @@ subroutine med_phases_restart_write(gcomp, rc) ! Write export field bundles if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(n),rc=rc)) then - if (dbug_flag > 5) then - write(tmpstr,*) subname,' nx,ny = ',trim(compname(n)),nx,ny - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) - end if 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) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -406,24 +427,47 @@ subroutine med_phases_restart_write(gcomp, rc) endif ! Write export field bundle accumulators + ! TODO: only write this out if actually have done accumulation if (ESMF_FieldBundleIsCreated(is_local%wrap%FBExpAccum(n),rc=rc)) then - ! TODO: only write this out if actually have done accumulation call med_io_write(restart_file, iam, is_local%wrap%FBExpAccum(n), & nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre=trim(compname(n))//'ExpAccum', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif ! Write import field bundle accumulators + ! TODO: only write this out if actually have done accumulation if (ESMF_FieldBundleIsCreated(is_local%wrap%FBImpAccum(n,n),rc=rc)) then - ! TODO: only write this out if actually have done accumulation call med_io_write(restart_file, iam, is_local%wrap%FBImpAccum(n,n), & nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre=trim(compname(n))//'ImpAccum', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif - endif enddo + ! Write write accumulation from lnd to glc if lnd->glc coupling is on + 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) + 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) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + ! Write write accumulation from ocn to glc if ocn->glc coupling is on + 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) + 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) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + ! Write ocn albedo field bundle (CESM only) if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o,rc=rc)) then call med_io_write(restart_file, iam, is_local%wrap%FBMed_ocnalb_o, & @@ -450,7 +494,7 @@ subroutine med_phases_restart_write(gcomp, rc) end do end do - enddo + enddo ! end of whead/wdata loop ! Close file call med_io_close(restart_file, iam, rc=rc) @@ -460,7 +504,7 @@ subroutine med_phases_restart_write(gcomp, rc) !--------------------------------------- !--- clean up !--------------------------------------- - + lasttimewritten = currtime if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif @@ -468,8 +512,7 @@ subroutine med_phases_restart_write(gcomp, rc) end subroutine med_phases_restart_write - !=============================================================================== - + !=============================================================================== subroutine med_phases_restart_read(gcomp, rc) ! Read mediator restart @@ -584,9 +627,9 @@ subroutine med_phases_restart_read(gcomp, rc) ! Now read in the restart file - call med_io_read(restart_file, vm, iam, is_local%wrap%FBExpAccumCnt, dname='ExpAccumCnt', rc=rc) + call med_io_read(restart_file, vm, iam, is_local%wrap%FBExpAccumCnt, 'ExpAccumCnt', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_read(restart_file, vm, iam, is_local%wrap%FBImpAccumCnt, dname='ImpAccumCnt', rc=rc) + call med_io_read(restart_file, vm, iam, is_local%wrap%FBImpAccumCnt, 'ImpAccumCnt', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return do n = 1,ncomps @@ -623,6 +666,22 @@ subroutine med_phases_restart_read(gcomp, rc) endif enddo + ! 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) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_io_read(restart_file, vm, iam, 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) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_io_read(restart_file, vm, iam, 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) diff --git a/mediator/med_time_mod.F90 b/mediator/med_time_mod.F90 index fbdf51541..4866d511c 100644 --- a/mediator/med_time_mod.F90 +++ b/mediator/med_time_mod.F90 @@ -38,6 +38,7 @@ module med_time_mod optMonthly = "monthly" , & optYearly = "yearly" , & optDate = "date" , & + optEnd = "end" , & optGLCCouplingPeriod = "glc_coupling_period" ! Module data @@ -154,6 +155,20 @@ subroutine med_time_alarmInit( clock, alarm, option, & if (ChkErr(rc,__LINE__,u_FILE_u)) return update_nextalarm = .false. + case (optNever) + call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeSet( NextAlarm, yy=9999, mm=12, dd=1, s=0, calendar=cal, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + update_nextalarm = .false. + + case (optEnd) + call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeSet( NextAlarm, yy=9999, mm=12, dd=1, s=0, calendar=cal, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + update_nextalarm = .false. + case (optDate) call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -163,13 +178,6 @@ subroutine med_time_alarmInit( clock, alarm, option, & if (ChkErr(rc,__LINE__,u_FILE_u)) return update_nextalarm = .false. - case (optNever) - call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeSet( NextAlarm, yy=9999, mm=12, dd=1, s=0, calendar=cal, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .false. - case (optNSteps) call ESMF_ClockGet(clock, TimeStep=AlarmInterval, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -224,7 +232,6 @@ subroutine med_time_alarmInit( clock, alarm, option, & call ESMF_TimeSet( NextAlarm, yy=cyy, mm=1, dd=1, s=0, calendar=cal, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return update_nextalarm = .true. - case default call ESMF_LogWrite(subname//'unknown option '//trim(option), ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE diff --git a/nuopc_cap_share/nuopc_shr_methods.F90 b/nuopc_cap_share/nuopc_shr_methods.F90 index 8cbf91056..421606fd1 100644 --- a/nuopc_cap_share/nuopc_shr_methods.F90 +++ b/nuopc_cap_share/nuopc_shr_methods.F90 @@ -60,8 +60,10 @@ module nuopc_shr_methods optNYear = "nyear" , & optMonthly = "monthly" , & optYearly = "yearly" , & + optEnd = "end" , & optDate = "date" + ! Module data integer, parameter :: SecPerDay = 86400 ! Seconds per day integer, parameter :: memdebug_level=1 @@ -558,6 +560,13 @@ subroutine alarmInit( clock, alarm, option, & if (chkerr(rc,__LINE__,u_FILE_u)) return update_nextalarm = .false. + case (optEnd) + call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeSet( NextAlarm, yy=9999, mm=12, dd=1, s=0, calendar=cal, rc=rc ) + if (chkerr(rc,__LINE__,u_FILE_u)) return + update_nextalarm = .false. + case (optDate) if (.not. present(opt_ymd)) then call shr_sys_abort(subname//trim(option)//' requires opt_ymd') @@ -747,7 +756,7 @@ subroutine alarmInit( clock, alarm, option, & call ESMF_TimeSet( NextAlarm, yy=cyy, mm=1, dd=1, s=0, calendar=cal, rc=rc ) if (chkerr(rc,__LINE__,u_FILE_u)) return update_nextalarm = .true. - + case default call shr_sys_abort(subname//'unknown option '//trim(option)) @@ -766,7 +775,6 @@ subroutine alarmInit( clock, alarm, option, & NextAlarm = NextAlarm + AlarmInterval enddo endif - alarm = ESMF_AlarmCreate( name=lalarmname, clock=clock, ringTime=NextAlarm, & ringInterval=AlarmInterval, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return From 657ee4bed3e9362ff3084c5bde609593e08a5dae Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 27 Aug 2021 20:29:19 -0600 Subject: [PATCH 34/61] remote conflict in merge --- cime_config/runseq/gen_runseq.py | 7 ------- 1 file changed, 7 deletions(-) diff --git a/cime_config/runseq/gen_runseq.py b/cime_config/runseq/gen_runseq.py index 5a4d35d91..c03fb930a 100644 --- a/cime_config/runseq/gen_runseq.py +++ b/cime_config/runseq/gen_runseq.py @@ -49,12 +49,6 @@ def leave_time_loop(self, leave_time, if_write_hist_rest=False, addextra_atsign= if leave_time and self.__time_loop: _, active_depth = self.__time_loop.pop() if if_write_hist_rest or active_depth == 0: -<<<<<<< HEAD - self.__outfile.write (" MED med_phases_history_write \n" ) - self.__outfile.write (" MED med_phases_restart_write \n" ) - self.__outfile.write (" MED med_phases_profile \n" ) - self.__outfile.write ("@ \n" ) -======= self.__outfile.write (" MED med_phases_history_write \n" ) self.__outfile.write (" MED med_phases_restart_write \n" ) self.__outfile.write (" MED med_phases_profile \n" ) @@ -62,7 +56,6 @@ def leave_time_loop(self, leave_time, if_write_hist_rest=False, addextra_atsign= self.__outfile.write ("@@ \n" ) else: self.__outfile.write ("@ \n" ) ->>>>>>> master def __exit_sequence(self): while self.__time_loop: From 5cd0bb296d39d8e9232ac4c968d7445629b03697 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 27 Aug 2021 20:31:34 -0600 Subject: [PATCH 35/61] reverted changes to master versions --- cime_config/runseq/driver_config.py | 3 --- cime_config/runseq/runseq_TG.py | 2 +- cime_config/runseq/runseq_general.py | 7 +------ 3 files changed, 2 insertions(+), 10 deletions(-) diff --git a/cime_config/runseq/driver_config.py b/cime_config/runseq/driver_config.py index 8ee1573b2..c2b5556ba 100644 --- a/cime_config/runseq/driver_config.py +++ b/cime_config/runseq/driver_config.py @@ -152,9 +152,6 @@ def __compute_rof(self, case, coupling_times): # If the prognostic flag is on, then should set med_to_rof to True if_prognostic = False med_to_rof = if_prognostic - elif case.get_value("PTS_MODE"): - run_rof = False - med_to_rof = False else: # this is active runoff - determine if the mode or the grid is null - and in that case # remove all interactions with rof from the run sequence diff --git a/cime_config/runseq/runseq_TG.py b/cime_config/runseq/runseq_TG.py index a826d92df..c0bb4ab92 100644 --- a/cime_config/runseq/runseq_TG.py +++ b/cime_config/runseq/runseq_TG.py @@ -36,7 +36,7 @@ def gen_runseq(case, coupling_times): runseq.add_action ("MED -> GLC :remapMethod=redist" , med_to_glc) runseq.add_action ("GLC" , run_glc) runseq.add_action ("GLC -> MED :remapMethod=redist" , run_glc) - runseq.add_action ("MED med_phases_history_write_all_inst", True) + runseq.add_action ("MED med_phases_history_write" , True) runseq.leave_time_loop(True) diff --git a/cime_config/runseq/runseq_general.py b/cime_config/runseq/runseq_general.py index 67a41c412..7bfa3aaa6 100644 --- a/cime_config/runseq/runseq_general.py +++ b/cime_config/runseq/runseq_general.py @@ -49,18 +49,13 @@ def gen_runseq(case, coupling_times): post_glc = True # Note: assume that atm_cpl_dt, lnd_cpl_dt, ice_cpl_dt and wav_cpl_dt are the same + if lnd_cpl_time != atm_cpl_time: expect(False, "assume that lnd_cpl_time is equal to atm_cpl_time") if ice_cpl_time != atm_cpl_time: expect(False, "assume that ice_cpl_time is equal to atm_cpl_time") if wav_cpl_time != atm_cpl_time: expect(False, "assume that wav_cpl_time is equal to atm_cpl_time") - - # assume that atm coupling time is always less than or equal to ocean coupling time - if atm_cpl_time > ocn_cpl_time: - expect(False, "assume that atm_cpl_time is always less or equal to ocn_cpl_time") - - # assume that rof coupling time is always greater than or equal to ocean coupling time if rof_cpl_time < ocn_cpl_time: expect(False, "assume that rof_cpl_time is always greater than or equal to ocn_cpl_time") From f4b9f2d2f7b7aed4c42516261b9a00960e83ec4b Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 27 Aug 2021 20:37:51 -0600 Subject: [PATCH 36/61] revert to master version --- mediator/med_map_mod.F90 | 8 ++++---- mediator/med_phases_prep_atm_mod.F90 | 2 +- mediator/med_phases_prep_glc_mod.F90 | 3 +++ mediator/med_phases_prep_ice_mod.F90 | 12 ++++++------ mediator/med_phases_prep_ocn_mod.F90 | 10 +++++----- 5 files changed, 19 insertions(+), 16 deletions(-) diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 4f8bda907..a572d1ee6 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -46,10 +46,10 @@ module med_map_mod subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogunit, rc) !--------------------------------------------- - ! Initialize route handles in the mediator and also + ! Initialize route handles in the mediator and also ! nitialize unity normalization fields and do the mapping for ! unity normalization up front - ! + ! ! Assumptions: ! - Route handles are created per target field bundles NOT ! per individual fields in the bundle @@ -138,7 +138,7 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun if (chkerr(rc,__LINE__,u_FILE_u)) return ! Check number of fields in source FB on destination mesh and get destination field - if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(n1,n2))) then + if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(n1,n2))) then call ESMF_LogWrite(trim(subname)//'FBImp('//trim(compname(n1))//','//trim(compname(n2))//')'// & ' has not been created', ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) rc = ESMF_FAILURE @@ -213,7 +213,7 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun allocate(fieldlist(fieldcount)) call ESMF_FieldBundleGet(is_local%wrap%FBExp(n1), fieldlist=fieldlist, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - else + else allocate(fieldlist(fieldcount)) call ESMF_FieldBundleGet(is_local%wrap%FBImp(n1,n1), fieldlist=fieldlist, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index fae8f4281..d89907f2c 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -198,7 +198,7 @@ subroutine med_phases_prep_atm(gcomp, rc) end if ! Note - the following needs a custom merge since Faoo_fco2_ocn is scaled by (ifrac+ofrac) - ! in the merge to the atm + ! in the merge to the atm if ( FB_FldChk(is_local%wrap%FBExp(compatm) , 'Faoo_fco2_ocn', rc=rc) .and. & FB_FldChk(is_local%wrap%FBImp(compocn,compocn), 'Faoo_fco2_ocn', rc=rc)) then call ESMF_FieldGet(lfield, farrayPtr=dataptr1, rc=rc) diff --git a/mediator/med_phases_prep_glc_mod.F90 b/mediator/med_phases_prep_glc_mod.F90 index ded19a045..2009f27fe 100644 --- a/mediator/med_phases_prep_glc_mod.F90 +++ b/mediator/med_phases_prep_glc_mod.F90 @@ -584,6 +584,9 @@ subroutine med_phases_prep_glc(gcomp, rc) type(ESMF_Clock) :: med_clock type(ESMF_Time) :: med_currtime type(ESMF_Time) :: prepglc_currtime + type(ESMF_ALARM) :: glc_avg_alarm + character(len=CS) :: glc_avg_period + integer :: glc_cpl_dt integer :: yr_med, mon_med, day_med, sec_med integer :: yr_prepglc, mon_prepglc, day_prepglc, sec_prepglc type(ESMF_Alarm) :: alarm diff --git a/mediator/med_phases_prep_ice_mod.F90 b/mediator/med_phases_prep_ice_mod.F90 index 5046ed3bf..4f12f97ad 100644 --- a/mediator/med_phases_prep_ice_mod.F90 +++ b/mediator/med_phases_prep_ice_mod.F90 @@ -29,7 +29,7 @@ subroutine med_phases_prep_ice(gcomp, rc) use ESMF , only : ESMF_FieldBundleGet, ESMF_FieldGet, ESMF_Field use ESMF , only : ESMF_LOGMSG_ERROR, ESMF_FAILURE use ESMF , only : ESMF_StateItem_Flag, ESMF_STATEITEM_NOTFOUND - use ESMF , only : ESMF_VMBroadCast + use ESMF , only : ESMF_VMBroadCast use med_utils_mod , only : chkerr => med_utils_ChkErr use med_methods_mod , only : FB_fldchk => med_methods_FB_FldChk use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose @@ -91,12 +91,12 @@ subroutine med_phases_prep_ice(gcomp, rc) ! Apply precipitation factor from ocean (that scales atm rain and snow to ice) if appropriate if (trim(coupling_mode) == 'cesm' .and. is_local%wrap%flds_scalar_index_precip_factor /= 0) then - ! Note that in med_internal_mod.F90 all is_local%wrap%flds_scalar_index_precip_factor + ! Note that in med_internal_mod.F90 all is_local%wrap%flds_scalar_index_precip_factor ! is initialized to 0. - ! In addition, in med.F90, if this attribute is not present as a mediator component attribute, - ! it is set to 0. + ! In addition, in med.F90, if this attribute is not present as a mediator component attribute, + ! it is set to 0. if (mastertask) then - call ESMF_StateGet(is_local%wrap%NstateImp(compocn), & + call ESMF_StateGet(is_local%wrap%NstateImp(compocn), & itemName=trim(is_local%wrap%flds_scalar_name), field=lfield, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldGet(lfield, farrayPtr=dataptr_scalar_ocn, rc=rc) @@ -111,7 +111,7 @@ subroutine med_phases_prep_ice(gcomp, rc) end if call ESMF_VMBroadCast(is_local%wrap%vm, precip_fact, 1, 0, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - is_local%wrap%flds_scalar_precip_factor = precip_fact(1) + is_local%wrap%flds_scalar_precip_factor = precip_fact(1) if (dbug_flag > 5) then write(cvalue,*) precip_fact(1) call ESMF_LogWrite(trim(subname)//" precip_fact is "//trim(cvalue), ESMF_LOGMSG_INFO) diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index 51724336d..705d8a595 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -438,12 +438,12 @@ subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc) ! Apply precipitation factor from ocean (that scales atm rain and snow back to ocn ) if appropriate if (trim(coupling_mode) == 'cesm' .and. is_local%wrap%flds_scalar_index_precip_factor /= 0) then - ! Note that in med_internal_mod.F90 all is_local%wrap%flds_scalar_index_precip_factor + ! Note that in med_internal_mod.F90 all is_local%wrap%flds_scalar_index_precip_factor ! is initialized to 0. - ! In addition, in med.F90, if this attribute is not present as a mediator component attribute, - ! it is set to 0. + ! In addition, in med.F90, if this attribute is not present as a mediator component attribute, + ! it is set to 0. if (mastertask) then - call ESMF_StateGet(is_local%wrap%NstateImp(compocn), & + call ESMF_StateGet(is_local%wrap%NstateImp(compocn), & itemName=trim(is_local%wrap%flds_scalar_name), field=lfield, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldGet(lfield, farrayPtr=dataptr_scalar_ocn, rc=rc) @@ -458,7 +458,7 @@ subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc) end if call ESMF_VMBroadCast(is_local%wrap%vm, precip_fact, 1, 0, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - is_local%wrap%flds_scalar_precip_factor = precip_fact(1) + is_local%wrap%flds_scalar_precip_factor = precip_fact(1) if (dbug_flag > 5) then write(cvalue,*) precip_fact(1) call ESMF_LogWrite(trim(subname)//" precip_fact is "//trim(cvalue), ESMF_LOGMSG_INFO) From 6974330999ac71b79fc9a3d61de9d681a57c6663 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 29 Aug 2021 17:23:04 -0600 Subject: [PATCH 37/61] removed component history phases as run sequence options and moved the calls to post phases --- cime_config/config_component.xml | 72 -- cime_config/config_component_cesm.xml | 226 ------- cime_config/namelist_definition_drv.xml | 840 ++++++++++-------------- drivers/cime/esm.F90 | 17 +- mediator/med.F90 | 134 +--- mediator/med_io_mod.F90 | 6 +- mediator/med_phases_history_mod.F90 | 6 + mediator/med_phases_post_atm_mod.F90 | 5 + mediator/med_phases_post_glc_mod.F90 | 6 + mediator/med_phases_post_ice_mod.F90 | 5 + mediator/med_phases_post_ocn_mod.F90 | 5 + mediator/med_phases_post_rof_mod.F90 | 5 + mediator/med_phases_post_wav_mod.F90 | 5 + 13 files changed, 394 insertions(+), 938 deletions(-) diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index 95b0c801c..cf9d450eb 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 @@ -2294,10 +2273,6 @@ standard full pathname of the cprnc executable - - - - logical TRUE,FALSE @@ -2307,38 +2282,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,21 +2291,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. - - diff --git a/cime_config/config_component_cesm.xml b/cime_config/config_component_cesm.xml index d434a5854..ac1af770d 100644 --- a/cime_config/config_component_cesm.xml +++ b/cime_config/config_component_cesm.xml @@ -463,119 +463,6 @@ 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 - never - med_history - env_run.xml - Sets mediator average history file frequency (like REST_OPTION) - - - char - - -999 - med_history - env_run.xml - Sets mediator average history file frequency (like REST_N) - - - 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 mediator average history file frequency (like REST_OPTION) - - - char - - -999 - med_history - env_run.xml - Sets mediator average history file frequency (like REST_N) - - - 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 mediator average history file frequency (like REST_OPTION) - - - char - - -999 - med_history - env_run.xml - Sets mediator average history file frequency (like REST_N) - - - 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 mediator average history file frequency (like REST_OPTION) - - - char - - -999 - med_history - env_run.xml - Sets mediator average history file frequency (like REST_N) - - - 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 mediator average history file frequency (like REST_OPTION) - - - char - - -999 - med_history - env_run.xml - Sets mediator average history file frequency (like REST_N) - - - 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 mediator average history file frequency (like REST_OPTION) - - - char - - -999 - med_history - env_run.xml - Sets mediator average history file frequency (like REST_N) - - - 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 mediator average history file frequency (like REST_OPTION) - - - char - - -999 - med_history - env_run.xml - Sets mediator average history file frequency (like REST_N) - - @@ -611,119 +498,6 @@ yyyymmdd format, sets mediator average 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 - never - med_history - env_run.xml - Sets mediator average history file frequency (like REST_OPTION) - - - char - - -999 - med_history - env_run.xml - Sets mediator average history file frequency (like REST_N) - - - 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 mediator average history file frequency (like REST_OPTION) - - - char - - -999 - med_history - env_run.xml - Sets mediator average history file frequency (like REST_N) - - - 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 mediator average history file frequency (like REST_OPTION) - - - char - - -999 - med_history - env_run.xml - Sets mediator average history file frequency (like REST_N) - - - 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 mediator average history file frequency (like REST_OPTION) - - - char - - -999 - med_history - env_run.xml - Sets mediator average history file frequency (like REST_N) - - - 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 mediator average history file frequency (like REST_OPTION) - - - char - - -999 - med_history - env_run.xml - Sets mediator average history file frequency (like REST_N) - - - 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 mediator average history file frequency (like REST_OPTION) - - - char - - -999 - med_history - env_run.xml - Sets mediator average history file frequency (like REST_N) - - - 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 mediator average history file frequency (like REST_OPTION) - - - char - - -999 - med_history - env_run.xml - Sets mediator average history file frequency (like REST_N) - - logical TRUE,FALSE diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index c31ac0a11..8448a59cb 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,157 +869,53 @@ - - char - mapping - 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 - 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 - LND_attributes + + real + control + MED_attributes - MESH description of lnd grid + wind gustiness factor - $LND_DOMAIN_MESH - null + 0.0D0 - - char - mapping - OCN_attributes + + logical + budget + MED_attributes - MESH description of ocn grid + logical that turns on diagnostic budgets, false means budgets will never be written - $OCN_DOMAIN_MESH - null - - - - - char - mapping - ICE_attributes - - MESH description of ice grid - - - $ICE_DOMAIN_MESH - null - - - - - char - mapping - ROF_attributes - - MESH description of rof grid - - - $ROF_DOMAIN_MESH - null - - - - - char - mapping - GLC_attributes - - MESH description of glc grid - - - $GLC_DOMAIN_MESH - null - - - - - char - mapping - 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 - - - $BUDGETS + $BUDGETS @@ -1361,7 +1100,7 @@ - + char time MED_attributes @@ -1370,10 +1109,10 @@ mediator history for atm import/export/fields snapshot option (used with history_n and history_ymd) - $HIST_OPTION_ATM + never - + integer time MED_attributes @@ -1381,10 +1120,10 @@ sets mediator snapshot history file frequency for atm import/export fields (like restart_n) - $HIST_N_ATM + -999 - + char time MED_attributes @@ -1393,10 +1132,10 @@ mediator time average history option (used with histavg_n and histavg_ymd) - $AVGHIST_OPTION_ATM + never - + integer time MED_attributes @@ -1404,7 +1143,7 @@ Sets mediator time-average history file frequency (like restart_option) - $AVGHIST_N_ATM + -999 @@ -1743,7 +1482,7 @@ - + char time MED_attributes @@ -1752,10 +1491,10 @@ mediator history for ice import/export/fields snapshot option (used with history_n and history_ymd) - $HIST_OPTION_ICE + never - + integer time MED_attributes @@ -1763,10 +1502,10 @@ sets mediator snapshot history file frequency for ice import/export fields (like restart_n) - $HIST_N_ICE + -999 - + char time MED_attributes @@ -1775,10 +1514,10 @@ mediator time average history option (used with histavg_n and histavg_ymd) - $AVGHIST_OPTION_ICE + never - + integer time MED_attributes @@ -1786,7 +1525,7 @@ Sets mediator time-average history file frequency (like restart_option) - $AVGHIST_N_ICE + -999 @@ -1794,7 +1533,7 @@ - + char time MED_attributes @@ -1803,10 +1542,10 @@ mediator history for glc import/export/fields snapshot option (used with history_n and history_ymd) - $HIST_OPTION_GLC + never - + integer time MED_attributes @@ -1814,10 +1553,10 @@ sets mediator snapshot history file frequency for glc import/export fields (like restart_n) - $HIST_N_GLC + -999 - + char time MED_attributes @@ -1826,10 +1565,10 @@ mediator time average history option (used with histavg_n and histavg_ymd) - $AVGHIST_OPTION_GLC + never - + integer time MED_attributes @@ -1837,7 +1576,7 @@ Sets mediator time-average history file frequency (like restart_option) - $AVGHIST_N_GLC + -999 @@ -1845,7 +1584,7 @@ - + char time MED_attributes @@ -1854,10 +1593,10 @@ mediator history for lnd import/export/fields snapshot option (used with history_n and history_ymd) - $HIST_OPTION_LND + never - + integer time MED_attributes @@ -1865,10 +1604,10 @@ sets mediator snapshot history file frequency for lnd import/export fields (like restart_n) - $HIST_N_LND + -999 - + char time MED_attributes @@ -1877,10 +1616,10 @@ mediator time average history option (used with histavg_n and histavg_ymd) - $AVGHIST_OPTION_LND + never - + integer time MED_attributes @@ -1888,7 +1627,7 @@ Sets mediator time-average history file frequency (like restart_option) - $AVGHIST_N_LND + -999 @@ -2026,7 +1765,7 @@ - + char time MED_attributes @@ -2035,10 +1774,10 @@ mediator history for ocn import/export/fields snapshot option (used with history_n and history_ymd) - $HIST_OPTION_OCN + never - + integer time MED_attributes @@ -2046,10 +1785,10 @@ sets mediator snapshot history file frequency for ocn import/export fields (like restart_n) - $HIST_N_OCN + -999 - + char time MED_attributes @@ -2058,10 +1797,10 @@ mediator time average history option (used with histavg_n and histavg_ymd) - $AVGHIST_OPTION_OCN + never - + integer time MED_attributes @@ -2069,7 +1808,7 @@ Sets mediator time-average history file frequency (like restart_option) - $AVGHIST_N_OCN + -999 @@ -2077,7 +1816,7 @@ - + char time MED_attributes @@ -2086,10 +1825,10 @@ mediator history for rof import/export/fields snapshot option (used with history_n and history_ymd) - $HIST_OPTION_ROF + never - + integer time MED_attributes @@ -2097,10 +1836,10 @@ sets mediator snapshot history file frequency for rof import/export fields (like restart_n) - $HIST_N_ROF + -999 - + char time MED_attributes @@ -2109,10 +1848,10 @@ mediator time average history option (used with histavg_n and histavg_ymd) - $AVGHIST_OPTION_ROF + never - + integer time MED_attributes @@ -2120,7 +1859,7 @@ Sets mediator time-average history file frequency (like restart_option) - $AVGHIST_N_ROF + -999 @@ -2193,7 +1932,7 @@ - + char time MED_attributes @@ -2202,10 +1941,10 @@ mediator history for wav import/export/fields snapshot option (used with history_n and history_ymd) - $HIST_OPTION_WAV + never - + integer time MED_attributes @@ -2213,10 +1952,10 @@ sets mediator snapshot history file frequency for wav import/export fields (like restart_n) - $HIST_N_WAV + -999 - + char time MED_attributes @@ -2225,10 +1964,10 @@ mediator time average history option (used with histavg_n and histavg_ymd) - $AVGHIST_OPTION_WAV + never - + integer time MED_attributes @@ -2236,7 +1975,7 @@ Sets mediator time-average history file frequency (like restart_option) - $AVGHIST_N_WAV + -999 @@ -2982,46 +2721,6 @@ - - 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 @@ -3204,7 +2903,7 @@ - + @@ -3218,7 +2917,6 @@ $NINST - integer cime_pes @@ -3231,7 +2929,6 @@ $NTASKS_ATM - integer cime_pes @@ -3244,7 +2941,6 @@ $NTHRDS_ATM - integer cime_pes @@ -3257,7 +2953,6 @@ $ROOTPE_ATM - integer cime_pes @@ -3270,7 +2965,6 @@ $PSTRID_ATM - integer cime_pes @@ -3283,7 +2977,6 @@ $NTASKS_LND - integer cime_pes @@ -3296,7 +2989,6 @@ $NTHRDS_LND - integer cime_pes @@ -3309,7 +3001,6 @@ $ROOTPE_LND - integer cime_pes @@ -3322,7 +3013,6 @@ $PSTRID_LND - integer cime_pes @@ -3335,7 +3025,6 @@ $NTASKS_ICE - integer cime_pes @@ -3348,7 +3037,6 @@ $NTHRDS_ICE - integer cime_pes @@ -3361,7 +3049,6 @@ $ROOTPE_ICE - integer cime_pes @@ -3374,7 +3061,6 @@ $PSTRID_ICE - integer cime_pes @@ -3387,7 +3073,6 @@ $NTASKS_OCN - integer cime_pes @@ -3400,7 +3085,6 @@ $NTHRDS_OCN - integer cime_pes @@ -3413,7 +3097,6 @@ $ROOTPE_OCN - integer cime_pes @@ -3426,7 +3109,6 @@ $PSTRID_OCN - integer cime_pes @@ -3439,7 +3121,6 @@ $NTASKS_GLC - integer cime_pes @@ -3452,7 +3133,6 @@ $NTHRDS_GLC - integer cime_pes @@ -3465,7 +3145,6 @@ $ROOTPE_GLC - integer cime_pes @@ -3478,7 +3157,6 @@ $PSTRID_GLC - integer cime_pes @@ -3491,7 +3169,6 @@ $NTASKS_WAV - integer cime_pes @@ -3504,7 +3181,6 @@ $NTHRDS_WAV - integer cime_pes @@ -3517,7 +3193,6 @@ $ROOTPE_WAV - integer cime_pes @@ -3530,7 +3205,6 @@ $PSTRID_WAV - integer cime_pes @@ -3543,7 +3217,6 @@ $NTASKS_ROF - integer cime_pes @@ -3556,7 +3229,6 @@ $NTHRDS_ROF - integer cime_pes @@ -3569,7 +3241,6 @@ $ROOTPE_ROF - integer cime_pes @@ -3582,7 +3253,6 @@ $PSTRID_ROF - integer cime_pes @@ -3595,7 +3265,6 @@ $NTASKS_ESP - integer cime_pes @@ -3608,7 +3277,6 @@ $NTHRDS_ESP - integer cime_pes @@ -3621,7 +3289,6 @@ $ROOTPE_ESP - integer cime_pes @@ -3634,7 +3301,6 @@ $PSTRID_ESP - integer cime_pes @@ -3647,7 +3313,6 @@ $NTASKS_CPL - integer cime_pes @@ -3660,7 +3325,6 @@ $NTHRDS_CPL - integer cime_pes @@ -3673,7 +3337,6 @@ $ROOTPE_CPL - integer cime_pes @@ -3687,28 +3350,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 @@ -3736,7 +3381,6 @@ .true. - logical performance @@ -3747,7 +3391,6 @@ .false. - logical performance @@ -3759,7 +3402,6 @@ .true. - logical performance @@ -3770,7 +3412,6 @@ .false. - integer performance @@ -3781,7 +3422,6 @@ $TIMER_LEVEL - integer performance @@ -3792,7 +3432,6 @@ 0 - integer performance @@ -3803,7 +3442,6 @@ $TIMER_DETAIL - integer performance @@ -3817,7 +3455,6 @@ 3 - logical performance @@ -3829,7 +3466,6 @@ .false. - logical performance @@ -3841,7 +3477,6 @@ .false. - integer performance @@ -3853,7 +3488,6 @@ 1 - logical performance @@ -3866,10 +3500,10 @@ - - - - + + + + char @@ -3882,7 +3516,6 @@ PAPI_FP_OPS - char performance @@ -3894,7 +3527,6 @@ PAPI_NO_CTR - char performance @@ -3906,7 +3538,6 @@ PAPI_NO_CTR - char performance @@ -3919,9 +3550,9 @@ - - - + + + logical @@ -4187,4 +3818,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/drivers/cime/esm.F90 b/drivers/cime/esm.F90 index e1a18f135..d28ddacb0 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/med.F90 b/mediator/med.F90 index 6abc48aaa..fb5cc9272 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -89,13 +89,6 @@ subroutine SetServices(gcomp, rc) use NUOPC_Mediator , only: mediator_label_SetRunClock => label_SetRunClock use NUOPC_Mediator , only: mediator_label_Finalize => label_Finalize use med_phases_history_mod , only: med_phases_history_write - use med_phases_history_mod , only: med_phases_history_write_atm - use med_phases_history_mod , only: med_phases_history_write_ice - use med_phases_history_mod , only: med_phases_history_write_glc - use med_phases_history_mod , only: med_phases_history_write_lnd - use med_phases_history_mod , only: med_phases_history_write_ocn - use med_phases_history_mod , only: med_phases_history_write_rof - use med_phases_history_mod , only: med_phases_history_write_wav use med_phases_history_mod , only: med_phases_history_write_med use med_phases_restart_mod , only: med_phases_restart_write use med_phases_prep_atm_mod , only: med_phases_prep_atm @@ -208,83 +201,6 @@ subroutine SetServices(gcomp, rc) specPhaseLabel="med_phases_history_write", specRoutine=med_phases_history_write, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - !------------------ - ! setup mediator history phases for atm output - !------------------ - - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_atm"/), userRoutine=mediator_routine_Run, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_atm", specRoutine=med_phases_history_write_atm, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - !------------------ - ! setup mediator history phases for ice output - !------------------ - - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_ice"/), userRoutine=mediator_routine_Run, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_ice", specRoutine=med_phases_history_write_ice, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - !------------------ - ! setup mediator history phases for glc output - !------------------ - - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_glc"/), userRoutine=mediator_routine_Run, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_glc", specRoutine=med_phases_history_write_glc, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - !------------------ - ! setup mediator history phases for lnd output - !------------------ - - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_lnd"/), userRoutine=mediator_routine_Run, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_lnd", specRoutine=med_phases_history_write_lnd, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - !------------------ - ! setup mediator history phases for ocn output - !------------------ - - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_ocn"/), userRoutine=mediator_routine_Run, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_ocn", specRoutine=med_phases_history_write_ocn, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - !------------------ - ! setup mediator history phases for rof output - !------------------ - - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_rof"/), userRoutine=mediator_routine_Run, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_rof", specRoutine=med_phases_history_write_rof, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - !------------------ - ! setup mediator history phases for wav output - !------------------ - - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_wav"/), userRoutine=mediator_routine_Run, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_wav", specRoutine=med_phases_history_write_wav, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - !------------------ ! setup mediator history phases for med output !------------------ @@ -905,7 +821,7 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) 'rof_present','wav_present','glc_present','med_present'/), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - med_present = "true" + med_present = "false" atm_present = "false" lnd_present = "false" ocn_present = "false" @@ -990,9 +906,7 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeSet(gcomp, name="glc_present", value=trim(glc_present), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! Mediator is always present inside the mediator - call NUOPC_CompAttributeSet(gcomp, name="med_present", value="true", rc=rc) + call NUOPC_CompAttributeSet(gcomp, name="med_present", value=med_present, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (mastertask) then @@ -1873,7 +1787,6 @@ subroutine DataInitialize(gcomp, rc) type(ESMF_Field) :: field type(ESMF_StateItem_Flag) :: itemType logical :: atCorrectTime, connected - logical :: isPresent, isSet integer :: n1,n2,n,ns integer :: nsrc,ndst integer :: cntn1, cntn2 @@ -2515,8 +2428,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, & @@ -2551,17 +2464,10 @@ subroutine DataInitialize(gcomp, rc) !--------------------------------------- ! Initialize mediator water/heat budget diags !--------------------------------------- - call NUOPC_CompAttributeGet(gcomp, name="do_budgets", 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.') then - 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 - endif - endif + 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 !--------------------------------------- ! read mediator restarts @@ -2842,43 +2748,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 @@ -2887,15 +2783,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 @@ -2910,20 +2803,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 @@ -2932,15 +2820,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 @@ -2949,15 +2834,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_io_mod.F90 b/mediator/med_io_mod.F90 index cc6a767d7..fa5f696df 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -123,6 +123,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 @@ -133,13 +134,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(inout) :: gcomp + integer , intent(out) :: rc #ifndef CESMCOUPLED ! local variables diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index ed55c9d31..a473f929f 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -81,7 +81,9 @@ module med_phases_history_mod character(CL) :: case_name = 'unset' ! case name character(CS) :: inst_tag = 'unset' ! instance tag + ! ---------------------------- ! Time averaging history files + ! ---------------------------- type, public :: avgfile_type type(ESMF_FieldBundle) :: FBaccum ! field bundle for time averaging integer :: accumcnt ! field bundle accumulation counter @@ -94,7 +96,9 @@ module med_phases_history_mod type(avgfile_type) :: avgfiles_ocnalb_atm type(ESMF_Clock) :: hclock_avg_comp(ncomps) + ! ---------------------------- ! Auxiliary history files + ! ---------------------------- integer, parameter :: max_auxfiles = 10 type, public :: auxfile_type character(CS), allocatable :: flds(:) ! array of aux field names @@ -111,7 +115,9 @@ module med_phases_history_mod integer , public :: num_auxfiles(ncomps) = 0 type(auxfile_type) , public :: auxfiles(max_auxfiles,ncomps) + ! ---------------------------- ! Instantaneous history files + ! ---------------------------- type(ESMF_Clock) :: hclock_inst_all type(ESMF_Clock) :: hclock_inst_comp(ncomps) diff --git a/mediator/med_phases_post_atm_mod.F90 b/mediator/med_phases_post_atm_mod.F90 index bd6b93230..3b668a575 100644 --- a/mediator/med_phases_post_atm_mod.F90 +++ b/mediator/med_phases_post_atm_mod.F90 @@ -26,6 +26,7 @@ subroutine med_phases_post_atm(gcomp, rc) 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_atm 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 @@ -93,6 +94,10 @@ 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 med_phases_history_write_atm(gcomp, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + 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 e04fc64b4..17509970e 100644 --- a/mediator/med_phases_post_glc_mod.F90 +++ b/mediator/med_phases_post_glc_mod.F90 @@ -85,6 +85,8 @@ module med_phases_post_glc_mod subroutine med_phases_post_glc(gcomp, rc) + use med_phases_history_mod, only : med_phases_history_write_glc + ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc @@ -213,6 +215,10 @@ 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 med_phases_history_write_glc(gcomp, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + 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 f605006e5..0961f9243 100644 --- a/mediator/med_phases_post_ice_mod.F90 +++ b/mediator/med_phases_post_ice_mod.F90 @@ -27,6 +27,7 @@ subroutine med_phases_post_ice(gcomp, rc) 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_ice use esmFlds , only : compice, compatm, compocn, compwav use perf_mod , only : t_startf, t_stopf @@ -94,6 +95,10 @@ 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 med_phases_history_write_ice(gcomp, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + 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_ocn_mod.F90 b/mediator/med_phases_post_ocn_mod.F90 index d0d00b970..a29d9e9f4 100644 --- a/mediator/med_phases_post_ocn_mod.F90 +++ b/mediator/med_phases_post_ocn_mod.F90 @@ -27,6 +27,7 @@ subroutine med_phases_post_ocn(gcomp, rc) 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_ocn 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 @@ -83,6 +84,10 @@ 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 med_phases_history_write_ocn(gcomp, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + 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 93e73ac3e..16990ce8d 100644 --- a/mediator/med_phases_post_rof_mod.F90 +++ b/mediator/med_phases_post_rof_mod.F90 @@ -23,6 +23,7 @@ subroutine med_phases_post_rof(gcomp, rc) 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_rof use med_map_mod , only : med_map_field_packed use perf_mod , only : t_startf, t_stopf @@ -86,6 +87,10 @@ 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 med_phases_history_write_rof(gcomp, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + 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 feb1c8515..ee9e9d129 100644 --- a/mediator/med_phases_post_wav_mod.F90 +++ b/mediator/med_phases_post_wav_mod.F90 @@ -22,6 +22,7 @@ subroutine med_phases_post_wav(gcomp, rc) 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_wav use esmFlds , only : compwav, compatm, compocn, compice use perf_mod , only : t_startf, t_stopf @@ -80,6 +81,10 @@ 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 med_phases_history_write_wav(gcomp, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call t_stopf('MED:'//subname) if (dbug_flag > 20) then call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) From 4dc835f11d6de2bd32546ba2f8a37b1644f1ca5b Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 30 Aug 2021 11:44:35 -0600 Subject: [PATCH 38/61] more cleanup of new history capability for averaging --- mediator/med_phases_history_mod.F90 | 306 +++++++++++++++++---------- mediator/med_phases_prep_rof_mod.F90 | 4 - 2 files changed, 200 insertions(+), 110 deletions(-) diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index a473f929f..b49a73a9e 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -39,13 +39,9 @@ module med_phases_history_mod use esmFlds , only : ncomps, compname, num_icesheets use esmFlds , only : fldListFr, fldListTo use med_constants_mod , only : SecPerDay => med_constants_SecPerDay - use med_constants_mod , only : czero => med_constants_czero use med_utils_mod , only : chkerr => med_utils_ChkErr use med_methods_mod , only : med_methods_FB_reset - use med_methods_mod , only : med_methods_FB_accum - use med_methods_mod , only : med_methods_FB_average use med_methods_mod , only : med_methods_FB_fldchk - use med_methods_mod , only : med_methods_FB_init 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 @@ -486,6 +482,8 @@ subroutine med_phases_history_write_avg_comp(gcomp, compid, first_time, subname, ! Write mediator average history file variables for component compid + use med_constants_mod, only : czero => med_constants_czero + ! input/output variables type(ESMF_GridComp) , intent(inout) :: gcomp integer , intent(in) :: compid @@ -514,8 +512,13 @@ subroutine med_phases_history_write_avg_comp(gcomp, compid, first_time, subname, rc = ESMF_SUCCESS call t_startf('MED:'//subname) + ! Set alarm name alarmname = 'alarm_history_avg_'//trim(compname(compid)) + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (first_time) then ! Determine attribute prefix @@ -535,7 +538,6 @@ subroutine med_phases_history_write_avg_comp(gcomp, compid, first_time, subname, hist_option = 'none' hist_n = -999 end if - ! Create time average field bundles (module variables) if (hist_option /= 'never' .and. hist_option /= 'none') then @@ -558,78 +560,22 @@ subroutine med_phases_history_write_avg_comp(gcomp, compid, first_time, subname, call ESMF_ClockSet(hclock_avg_comp(compid), currTime=currtime) if (ChkErr(rc,__LINE__,u_FILE_u)) return - nullify(is_local%wrap) - call ESMF_GridCompGetInternalState(gcomp, is_local, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (compid /= compmed) then ! component is not mediator - ! create accumulated import fields - if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(compid,compid),rc=rc)) then - if (.not. ESMF_FieldBundleIsCreated(avgfiles_import(compid)%FBaccum)) then - call med_methods_fb_init(avgfiles_import(compid)%FBaccum, is_local%wrap%flds_scalar_name, & - FBgeom=is_local%wrap%FBImp(compid,compid), STflds=is_local%wrap%NStateImp(compid), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call med_methods_FB_reset(avgfiles_import(compid)%FBaccum, czero, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - avgfiles_import(compid)%accumcnt = 0 - end if - end if - ! accumulated export fields - if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(compid), rc=rc)) then - if (.not. ESMF_FieldBundleIsCreated(avgfiles_export(compid)%FBaccum)) then - call med_methods_fb_init(avgfiles_export(compid)%FBaccum, is_local%wrap%flds_scalar_name, & - FBgeom=is_local%wrap%FBExp(compid), STflds=is_local%wrap%NstateExp(compid), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call med_methods_FB_reset(avgfiles_export(compid)%FBaccum, czero, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - avgfiles_export(compid)%accumcnt = 0 - end if - end if + ! create accumulated import and export field bundles + call med_phases_history_init_fldbun_accum(is_local%wrap%FBimp(compid,compid), & + is_local%wrap%flds_scalar_name, avgfiles_import(compid)%FBaccum, avgfiles_import(compid)%accumcnt, rc=rc) + call med_phases_history_init_fldbun_accum(is_local%wrap%FBExp(compid), & + is_local%wrap%flds_scalar_name, avgfiles_export(compid)%FBaccum, avgfiles_export(compid)%accumcnt, rc=rc) else ! component is mediator - ! accumulated atm/ocn flux on ocn mesh - if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_o, rc=rc)) then - if (.not. ESMF_FieldBundleIsCreated(avgfiles_aoflux_ocn%FBaccum)) then - call med_methods_fb_init(avgfiles_aoflux_ocn%FBaccum, is_local%wrap%flds_scalar_name, & - FBgeom=is_local%wrap%FBMed_aoflux_o, FBflds=is_local%wrap%FBMed_aoflux_o, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call med_methods_FB_reset(avgfiles_aoflux_ocn%FBaccum, czero, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - avgfiles_aoflux_ocn%accumcnt = 0 - end if - end if - ! accumulated atm/ocn flux on atm mesh - if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a, rc=rc)) then - if (.not. ESMF_FieldBundleIsCreated(avgfiles_aoflux_atm%FBaccum)) then - call med_methods_fb_init(avgfiles_aoflux_atm%FBaccum, is_local%wrap%flds_scalar_name, & - FBgeom=is_local%wrap%FBMed_aoflux_a, FBflds=is_local%wrap%FBMed_aoflux_a, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call med_methods_FB_reset(avgfiles_aoflux_atm%FBaccum, czero, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - avgfiles_aoflux_atm%accumcnt = 0 - end if - end if - ! accumulated ocean albedo on ocn mesh - if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o, rc=rc)) then - if (.not. ESMF_FieldBundleIsCreated(avgfiles_ocnalb_ocn%FBaccum)) then - call med_methods_fb_init(avgfiles_ocnalb_ocn%FBaccum, is_local%wrap%flds_scalar_name, & - FBgeom=is_local%wrap%FBMed_ocnalb_o, FBflds=is_local%wrap%FBMed_ocnalb_o, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call med_methods_FB_reset(avgfiles_ocnalb_ocn%FBaccum, czero, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - avgfiles_ocnalb_ocn%accumcnt = 0 - end if - end if - ! accumulated ocean albedo on atm mesh - if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_a, rc=rc)) then - if (.not. ESMF_FieldBundleIsCreated(avgfiles_ocnalb_atm%FBaccum)) then - call med_methods_fb_init(avgfiles_ocnalb_atm%FBaccum, is_local%wrap%flds_scalar_name, & - FBgeom=is_local%wrap%FBMed_ocnalb_a, FBflds=is_local%wrap%FBMed_ocnalb_a, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call med_methods_FB_reset(avgfiles_ocnalb_atm%FBaccum, czero, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - avgfiles_ocnalb_atm%accumcnt = 0 - end if - end if + ! create accumulated atm/ocn and ocnalb field bundles + call med_phases_history_init_fldbun_accum(is_local%wrap%FBMed_aoflux_o, & + is_local%wrap%flds_scalar_name, avgfiles_aoflux_ocn%FBaccum, avgfiles_aoflux_ocn%accumcnt, rc=rc) + call med_phases_history_init_fldbun_accum(is_local%wrap%FBMed_aoflux_a, & + is_local%wrap%flds_scalar_name, avgfiles_aoflux_atm%FBaccum, avgfiles_aoflux_atm%accumcnt, rc=rc) + call med_phases_history_init_fldbun_accum(is_local%wrap%FBMed_ocnalb_o, & + is_local%wrap%flds_scalar_name, avgfiles_ocnalb_ocn%FBaccum, avgfiles_ocnalb_ocn%accumcnt, rc=rc) + call med_phases_history_init_fldbun_accum(is_local%wrap%FBMed_ocnalb_a, & + is_local%wrap%flds_scalar_name, avgfiles_ocnalb_atm%FBaccum, avgfiles_ocnalb_atm%accumcnt, rc=rc) end if end if @@ -642,7 +588,7 @@ subroutine med_phases_history_write_avg_comp(gcomp, compid, first_time, subname, ! Write history file call med_phases_history_write_hfile(gcomp, trim(compname(compid)), hclock_avg_comp(compid), & - trim(alarmname), .false., rc) + trim(alarmname), .true., rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if call t_stopf('MED:'//subname) @@ -706,7 +652,7 @@ subroutine med_phases_history_write_aux_comp(gcomp, compid, first_time, subname, ! 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 @@ -776,7 +722,6 @@ subroutine med_phases_history_write_aux_comp(gcomp, compid, first_time, subname, auxfiles(nfcnt,compid)%flds(n) = trim(fieldnamelist(n)) end do - ! Deallocate memory from fieldnamelist deallocate(fieldnamelist) ! this was allocated in med_phases_history_get_auxflds @@ -795,9 +740,9 @@ subroutine med_phases_history_write_aux_comp(gcomp, compid, first_time, subname, if (auxfiles(nfcnt,compid)%useavg) then ! First duplicate all fields in FBImp(compid,compid) - call ESMF_LogWrite(trim(subname)// ": calling med_methods_fb_init for FBaccum(compid)", ESMF_LOGMSG_INFO) - call med_methods_fb_init(auxfiles(nfcnt,compid)%FBaccum, is_local%wrap%flds_scalar_name, & - FBgeom=is_local%wrap%FBImp(compid,compid), STflds=is_local%wrap%NStateImp(compid), rc=rc) + call ESMF_LogWrite(trim(subname)// ": initializing FBaccum(compid)", ESMF_LOGMSG_INFO) + call med_phases_history_init_fldbun_accum(is_local%wrap%FBImp(compid,compid), & + is_local%wrap%flds_scalar_name, auxfiles(nfcnt,compid)%FBaccum, auxfiles(nfcnt,compid)%accumcnt, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! Now remove all fields from FBAccum that are not in the input flds list @@ -940,6 +885,9 @@ subroutine med_phases_history_write_hfile(gcomp, comptype, hclock, alarmname, do if (ESMF_AlarmIsRinging(alarm, rc=rc)) then if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (mastertask) then + write(logunit,*)'DEBUG: alarm ',trim(alarmname),' is ringing' + end if ! Set write_now flag write_now = .true. ! Turn ringer off @@ -954,31 +902,31 @@ subroutine med_phases_history_write_hfile(gcomp, comptype, hclock, alarmname, do write_now = .false. end if - ! Accumulate if alarm is not on - other wise average + ! Accumulate if alarm is not on and then average if write_now flag is true if (doavg) then do n = 1,ncomps if (comptype == 'all' .or. comptype == trim(compname(n))) then - ! accumulate + if (mastertask) then + write(logunit,*)'DEBUG: write_now ',write_now,' for comp ' ,trim(compname(n)) + end if if (ESMF_FieldBundleIsCreated(avgfiles_import(n)%FBaccum)) then - call med_methods_FB_accum(avgfiles_import(n)%FBaccum, is_local%wrap%FBImp(n,n), rc=rc) + call med_phases_history_fldbun_accum(is_local%wrap%FBImp(n,n), avgfiles_import(n)%FBaccum, & + avgfiles_import(n)%accumcnt, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - avgfiles_import(n)%accumcnt = avgfiles_import(n)%accumcnt + 1 + if (write_now) then + call med_phases_history_fldbun_average(avgfiles_import(n)%FBaccum, & + avgfiles_import(n)%accumcnt, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if end if if (ESMF_FieldBundleIsCreated(avgfiles_export(n)%FBaccum)) then - call med_methods_FB_accum(avgfiles_export(n)%FBaccum, is_local%wrap%FBExp(n), rc=rc) + call med_phases_history_fldbun_accum(is_local%wrap%FBExp(n), avgfiles_export(n)%FBaccum, & + avgfiles_export(n)%accumcnt, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - avgfiles_export(n)%accumcnt = avgfiles_export(n)%accumcnt + 1 - end if - if (write_now) then - if (ESMF_FieldBundleIsCreated(avgfiles_import(n)%FBaccum)) then - call med_methods_FB_average(avgfiles_import(n)%FBaccum, avgfiles_import(n)%accumcnt, rc=rc) + if (write_now) then + call med_phases_history_fldbun_average(avgfiles_export(n)%FBaccum, & + avgfiles_export(n)%accumcnt, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - avgfiles_import(n)%accumcnt = 0 - end if - if (ESMF_FieldBundleIsCreated(avgfiles_export(n)%FBaccum)) then - call med_methods_FB_average(avgfiles_export(n)%FBaccum, avgfiles_export(n)%accumcnt, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - avgfiles_export(n)%accumcnt = 0 end if end if end if @@ -1122,6 +1070,8 @@ end subroutine med_phases_history_write_hfile !=============================================================================== subroutine med_phases_history_write_hfileaux(gcomp, nfile_index, comp_index, auxfile, rc) + use med_constants_mod, only : czero => med_constants_czero + ! input/output variables type(ESMF_GridComp) , intent(inout) :: gcomp integer , intent(in) :: nfile_index @@ -1216,14 +1166,12 @@ subroutine med_phases_history_write_hfileaux(gcomp, nfile_index, comp_index, aux ! Do accumulation and average if required if (auxfile%useavg) then - call med_methods_FB_accum(auxfile%FBaccum, is_local%wrap%FBImp(comp_index,comp_index), rc=rc) + call med_phases_history_fldbun_accum(is_local%wrap%FBImp(comp_index,comp_index), auxfile%FBaccum, & + auxfile%accumcnt, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - auxfile%accumcnt = auxfile%accumcnt + 1 - if (write_now) then - call med_methods_FB_average(auxfile%FBaccum, auxfile%accumcnt, rc=rc) + call med_phases_history_fldbun_average(auxfile%FBaccum, auxfile%accumcnt, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - auxfile%accumcnt = 0 endif end if @@ -1381,8 +1329,8 @@ subroutine med_phases_history_get_filename(gcomp, doavg, comptype, hist_file, ti write(hist_file,"(6a)") trim(case_name),'.cpl.',trim(inst_tag),trim(histstr),trim(nexttimestr),'.nc' if (mastertask) then write(logunit,*) - write(logunit,' (a)') " writing mediator history file "//trim(hist_file) - write(logunit,' (a)') " currtime = "//trim(currtimestr)//" nexttime = "//trim(nexttimestr) + write(logunit,' (a)') "writing mediator history file "//trim(hist_file) + write(logunit,' (a)') "currtime = "//trim(currtimestr)//" nexttime = "//trim(nexttimestr) end if end subroutine med_phases_history_get_filename @@ -1550,8 +1498,8 @@ subroutine med_phases_history_set_casename(gcomp, rc) integer, intent(out) :: rc ! local variables - logical :: isPresent - logical :: isSet + logical :: isPresent + logical :: isSet !--------------------------------------- rc = ESMF_SUCCESS @@ -1568,4 +1516,150 @@ subroutine med_phases_history_set_casename(gcomp, rc) end subroutine med_phases_history_set_casename + !=============================================================================== + 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 + 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 + 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 + end if + end do + deallocate(fieldnames) + + ! Reset counter + count = 0 + + end subroutine med_phases_history_fldbun_average + + !=============================================================================== + subroutine med_phases_history_init_fldbun_accum(fldbun, scalar_name, fldbun_accum, count, rc) + + use ESMF , only : ESMF_FieldBundleIsCreated + use med_constants_mod , only : czero => med_constants_czero + use med_methods_mod , only : med_methods_FB_init + use med_methods_mod , only : med_methods_FB_reset + + ! input/output variables + type(ESMF_FieldBundle) , intent(in) :: fldbun + character(len=*) , intent(in) :: scalar_name + type(ESMF_FieldBundle) , intent(inout) :: fldbun_accum + integer , intent(out) :: count + integer , intent(out) :: rc + !--------------------------------------- + + rc = ESMF_SUCCESS + + if (ESMF_FieldBundleIsCreated(fldbun) .and. .not. ESMF_FieldBundleIsCreated(fldbun_accum)) then + call med_methods_FB_init(fldbun_accum, scalar_name, FBgeom=fldbun, FBflds=fldbun, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call med_methods_FB_reset(fldbun_accum, czero, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + count = 0 + end if + + end subroutine med_phases_history_init_fldbun_accum + end module med_phases_history_mod diff --git a/mediator/med_phases_prep_rof_mod.F90 b/mediator/med_phases_prep_rof_mod.F90 index 41625bcfb..7ac41796f 100644 --- a/mediator/med_phases_prep_rof_mod.F90 +++ b/mediator/med_phases_prep_rof_mod.F90 @@ -80,7 +80,6 @@ subroutine med_phases_prep_rof_accum(gcomp, rc) ! input/output variables type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc ! local variables @@ -95,8 +94,6 @@ subroutine med_phases_prep_rof_accum(gcomp, rc) real(r8), pointer :: dataptr2d_accum(:,:) => null() type(ESMF_Field) :: lfield type(ESMF_Field) :: lfield_accum - type(ESMF_Field), pointer :: fieldlist(:) => null() - type(ESMF_Field), pointer :: fieldlist_accum(:) => null() character(CL), pointer :: lfieldnamelist(:) => null() character(len=*), parameter :: subname='(med_phases_prep_rof_mod: med_phases_prep_rof_accum)' !--------------------------------------- @@ -190,7 +187,6 @@ subroutine med_phases_prep_rof(gcomp, rc) type(ESMF_Field) :: field_irrig_flux integer :: fieldcount type(ESMF_Field) :: lfield - type(ESMF_Field), pointer :: fieldlist(:) => null() integer :: ungriddedUBound(1) character(CL), pointer :: lfieldnamelist(:) => null() character(len=*),parameter :: subname='(med_phases_prep_rof_mod: med_phases_prep_rof)' From 4e6b637a371648da4da1b3f6297e0880b7b0087d Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 30 Aug 2021 15:06:44 -0600 Subject: [PATCH 39/61] average history file fixes --- mediator/med_phases_history_mod.F90 | 52 +++++++++++++++-------------- 1 file changed, 27 insertions(+), 25 deletions(-) diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index b49a73a9e..21bfff2f5 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -203,9 +203,11 @@ subroutine med_phases_history_write(gcomp, rc) end if if (ESMF_ClockIsCreated(hclock_inst_all)) then - ! Advance the clock - call ESMF_ClockAdvance(hclock_inst_all, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (.not. first_time) then + ! Advance the clock + call ESMF_ClockAdvance(hclock_inst_all, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if ! Write the instantaneous history file for all relevant components call med_phases_history_write_hfile(gcomp, 'all', hclock_inst_all, 'alarm_history_inst_all', .false., rc) @@ -837,6 +839,9 @@ end subroutine med_phases_history_write_aux_comp !=============================================================================== subroutine med_phases_history_write_hfile(gcomp, comptype, hclock, alarmname, doavg, rc) + use med_methods_mod , only : med_methods_FB_reset + use med_constants_mod , only : czero => med_constants_czero + ! input/output variables type(ESMF_GridComp) , intent(inout) :: gcomp character(len=*) , intent(in) :: comptype @@ -885,16 +890,13 @@ subroutine med_phases_history_write_hfile(gcomp, comptype, hclock, alarmname, do if (ESMF_AlarmIsRinging(alarm, rc=rc)) then if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (mastertask) then - write(logunit,*)'DEBUG: alarm ',trim(alarmname),' is ringing' - end if ! Set write_now flag write_now = .true. ! Turn ringer off call ESMF_AlarmRingerOff(alarm, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Write diagnostic output if (debug_alarms) then + ! Write diagnostic output call med_phases_history_output_alarminfo(hclock, alarm, alarmname, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -906,9 +908,6 @@ subroutine med_phases_history_write_hfile(gcomp, comptype, hclock, alarmname, do if (doavg) then do n = 1,ncomps if (comptype == 'all' .or. comptype == trim(compname(n))) then - if (mastertask) then - write(logunit,*)'DEBUG: write_now ',write_now,' for comp ' ,trim(compname(n)) - end if if (ESMF_FieldBundleIsCreated(avgfiles_import(n)%FBaccum)) then call med_phases_history_fldbun_accum(is_local%wrap%FBImp(n,n), avgfiles_import(n)%FBaccum, & avgfiles_import(n)%accumcnt, rc=rc) @@ -933,13 +932,9 @@ subroutine med_phases_history_write_hfile(gcomp, comptype, hclock, alarmname, do end do end if - ! Check if history alarm is ringing - and if so write the mediator history file + ! Write the mediator history file if apropriate if (write_now) then - ! Determine history file name and time units - call med_phases_history_get_filename(gcomp, doavg, comptype, hist_file, time_units, days_since, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Set tbnds and avg_time if doing averaging if (doavg) then call ESMF_ClockGet(hclock, currtime=currtime, starttime=starttime, rc=rc) @@ -957,6 +952,10 @@ subroutine med_phases_history_write_hfile(gcomp, comptype, hclock, alarmname, do avg_time = 0.5_r8 * (tbnds(1) + tbnds(2)) end if + ! Determine history file name and time units + call med_phases_history_get_filename(gcomp, doavg, comptype, hist_file, time_units, days_since, 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 @@ -995,26 +994,30 @@ subroutine med_phases_history_write_hfile(gcomp, comptype, hclock, alarmname, do if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(n,n),rc=rc)) then if (doavg) then call med_io_write(hist_file, iam, avgfiles_import(n)%FBaccum, & - nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, & - pre=trim(compname(n))//'Imp', rc=rc) + nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre=trim(compname(n))//'Imp', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (wdata == .true.) then + call med_methods_FB_reset(avgfiles_import(n)%FBAccum, czero, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if else 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) + nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre=trim(compname(n))//'Imp', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if endif if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(n),rc=rc)) then if (doavg) then call med_io_write(hist_file, iam, avgfiles_export(n)%FBaccum, & - nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, & - pre=trim(compname(n))//'Exp', rc=rc) + nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre=trim(compname(n))//'Exp', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (wdata == .true.) then + call med_methods_FB_reset(avgfiles_export(n)%FBAccum, czero, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if else 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) + nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre=trim(compname(n))//'Exp', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if endif @@ -1064,7 +1067,6 @@ subroutine med_phases_history_write_hfile(gcomp, comptype, hclock, alarmname, do if (ChkErr(rc,__LINE__,u_FILE_u)) return end if ! end of if-alarm is ringingblock - end subroutine med_phases_history_write_hfile !=============================================================================== @@ -1588,7 +1590,7 @@ subroutine med_phases_history_fldbun_average(fldbun_accum, count, rc) integer , intent(out) :: rc ! local variables - integer :: n + integer :: n,i type(ESMF_Field) :: lfield_accum integer :: fieldCount character(CL), pointer :: fieldnames(:) => null() From 63996163f139d83e398bb6775022f2d0a91b87e3 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 30 Aug 2021 20:05:39 -0600 Subject: [PATCH 40/61] got time average alarms to work correctly --- mediator/med_phases_history_mod.F90 | 61 +++++++++++++++++++---------- 1 file changed, 41 insertions(+), 20 deletions(-) diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 21bfff2f5..d37c5b248 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -397,8 +397,6 @@ subroutine med_phases_history_write_inst_comp(gcomp, compid, first_time, subname type(ESMF_Alarm) :: alarm type(ESMF_Time) :: CurrTime type(ESMF_Time) :: StartTime - type(ESMF_TimeInterval) :: timestep - integer :: timestep_length 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 @@ -412,6 +410,9 @@ subroutine med_phases_history_write_inst_comp(gcomp, compid, first_time, subname alarmname = 'alarm_history_inst_'//trim(compname(compid)) + call NUOPC_ModelGet(gcomp, modelClock=mclock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (first_time) then ! Determine attribute prefix @@ -435,14 +436,12 @@ subroutine med_phases_history_write_inst_comp(gcomp, compid, first_time, subname if (hist_option /= 'none' .and. hist_option /= 'never') then ! First create hclock from mclock - THIS CALL DOES NOT COPY ALARMS - call NUOPC_ModelGet(gcomp, modelClock=mclock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return hclock_inst_comp(compid) = ESMF_ClockCreate(mclock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Set alarm for instantaneous history output ! Advance history clock to trigger alarms then reset history clock back to mcurrtime - call ESMF_ClockGet(hclock_inst_comp(compid), startTime=StartTime, currTime=CurrTime, timeStep=timestep, rc=rc) + call ESMF_ClockGet(hclock_inst_comp(compid), startTime=StartTime, currTime=CurrTime, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call med_time_alarmInit(hclock_inst_comp(compid), alarm, option=hist_option, opt_n=hist_n, & reftime=StartTime, alarmname=trim(alarmname), rc=rc) @@ -455,18 +454,20 @@ subroutine med_phases_history_write_inst_comp(gcomp, compid, first_time, subname ! Write diagnostic info if (mastertask) then - call ESMF_TimeIntervalGet(timestep, s=timestep_length, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - write(logunit,'(a,2x,i8)') " initialized instantaneous history alarm "//& + write(logunit,'(a,2x,i8)') trim(subname)//" initialized instantaneous history alarm "//& trim(alarmname)//" with option "//trim(hist_option)//" and frequency ",hist_n - write(logunit,'(a,2x,i8)') " history clock timestep = ",timestep_length end if end if end if if (ESMF_ClockIsCreated(hclock_inst_comp(compid))) then - ! Advance the clock - call ESMF_ClockAdvance(hclock_inst_comp(compid), rc=rc) + call ESMF_ClockGet(mclock, currTime=CurrTime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockSet(hclock_inst_comp(compid), currTime=currtime) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockAdvance(hclock_inst_comp(compid),rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockSet(hclock_inst_comp(compid), currTime=currtime) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Write the instantaneous history file @@ -500,8 +501,6 @@ subroutine med_phases_history_write_avg_comp(gcomp, compid, first_time, subname, type(ESMF_Alarm) :: alarm type(ESMF_Time) :: CurrTime type(ESMF_Time) :: StartTime - type(ESMF_TimeInterval) :: timestep - integer :: timestep_length 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 @@ -521,6 +520,10 @@ subroutine med_phases_history_write_avg_comp(gcomp, compid, first_time, subname, call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! First create hclock from mclock - THIS CALL DOES NOT COPY ALARMS + call NUOPC_ModelGet(gcomp, modelClock=mclock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (first_time) then ! Determine attribute prefix @@ -543,15 +546,12 @@ subroutine med_phases_history_write_avg_comp(gcomp, compid, first_time, subname, ! Create time average field bundles (module variables) if (hist_option /= 'never' .and. hist_option /= 'none') then - ! First create hclock from mclock - THIS CALL DOES NOT COPY ALARMS - call NUOPC_ModelGet(gcomp, modelClock=mclock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return hclock_avg_comp(compid) = ESMF_ClockCreate(mclock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Set alarm for time averaged history output ! Advance history clock to trigger alarms then reset history clock back to mcurrtime - call ESMF_ClockGet(hclock_avg_comp(compid), startTime=StartTime, currTime=CurrTime, timeStep=timestep, rc=rc) + call ESMF_ClockGet(hclock_avg_comp(compid), startTime=StartTime, currTime=CurrTime, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call med_time_alarmInit(hclock_avg_comp(compid), alarm, option=hist_option, opt_n=hist_n, & reftime=StartTime, alarmname=trim(alarmname), rc=rc) @@ -562,6 +562,12 @@ subroutine med_phases_history_write_avg_comp(gcomp, compid, first_time, subname, call ESMF_ClockSet(hclock_avg_comp(compid), currTime=currtime) if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Write diagnostic info + if (mastertask) then + write(logunit,'(a,2x,i8)') trim(subname)//" initialized time averaged history alarm "//& + trim(alarmname)//" with option "//trim(hist_option)//" and frequency ",hist_n + end if + if (compid /= compmed) then ! component is not mediator ! create accumulated import and export field bundles call med_phases_history_init_fldbun_accum(is_local%wrap%FBimp(compid,compid), & @@ -585,7 +591,13 @@ subroutine med_phases_history_write_avg_comp(gcomp, compid, first_time, subname, if (ESMF_ClockIsCreated(hclock_avg_comp(compid))) then ! Update clock - call ESMF_ClockAdvance(hclock_avg_comp(compid), rc=rc) + call ESMF_ClockGet(mclock, currTime=CurrTime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockSet(hclock_avg_comp(compid), currTime=currtime) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockAdvance(hclock_avg_comp(compid),rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockSet(hclock_avg_comp(compid), currTime=currtime) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Write history file @@ -648,6 +660,9 @@ subroutine med_phases_history_write_aux_comp(gcomp, compid, first_time, subname, call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_ModelGet(gcomp, modelClock=mclock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Initialize number of aux files for this component to zero nfcnt = 0 do nfile = 1,max_auxfiles @@ -790,8 +805,6 @@ subroutine med_phases_history_write_aux_comp(gcomp, compid, first_time, subname, read(cvalue,*) hist_n ! First create hclock from mclock - THIS CALL DOES NOT COPY ALARMS - call NUOPC_ModelGet(gcomp, modelClock=mclock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return auxfiles(nfcnt,compid)%hclock = ESMF_ClockCreate(mclock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -827,8 +840,16 @@ subroutine med_phases_history_write_aux_comp(gcomp, compid, first_time, subname, ! Write auxiliary history files for component compid do n = 1,num_auxfiles(compid) + ! Update clock to trigger alarm + call ESMF_ClockGet(mclock, currTime=CurrTime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockSet(auxfiles(n,compid)%hclock, currTime=currtime) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_ClockAdvance(auxfiles(n,compid)%hclock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockSet(auxfiles(n,compid)%hclock, currTime=currtime) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_phases_history_write_hfileaux(gcomp, n, compid, auxfiles(n,compid), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end do From 15e2b9b80b0f0d1197e9a1d2fb995ec35b4e62ac Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 2 Sep 2021 16:53:03 -0600 Subject: [PATCH 41/61] refactor of med_io_mod time initialization --- mediator/med_io_mod.F90 | 118 ++++++++++- mediator/med_phases_history_mod.F90 | 299 +++++++++++++++------------- mediator/med_phases_restart_mod.F90 | 2 +- 3 files changed, 273 insertions(+), 146 deletions(-) diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index fa5f696df..2e43e6124 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -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,7 @@ 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 + module procedure med_io_write_and_define_time end interface med_io_write interface med_io_date2ymd module procedure med_io_date2ymd_int @@ -1439,7 +1441,111 @@ 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,& + subroutine med_io_define_time(time_units, calendar, file_ind, rc) + + use ESMF, only : operator(==), operator(/=) + use ESMF, only : ESMF_Calendar + 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 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) :: 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 + integer :: lfile_ind + character(CL) :: calname ! calendar name + character(*),parameter :: subName = '(med_io_write_time) ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + lfile_ind = 0 + if (present(file_ind)) lfile_ind=file_ind + + ! define time + 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 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') + + 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_write_and_define_time(filename, iam, time_units, calendar, time_val, nt,& whead, wdata, tbnds, file_ind, rc) !--------------- @@ -1451,9 +1557,8 @@ subroutine med_io_write_time(filename, iam, time_units, calendar, time_val, nt,& 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 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 + use pio , only : var_desc_t, PIO_UNLIMITED, PIO_DOUBLE, PIO_DEF_VAR + use pio , only : pio_put_att, pio_inq_varid, pio_put_var, pio_def_dim, pio_def_var ! input/output variables character(len=*) , intent(in) :: filename ! file @@ -1554,8 +1659,7 @@ subroutine med_io_write_time(filename, iam, time_units, calendar, time_val, nt,& endif endif - - end subroutine med_io_write_time + end subroutine med_io_write_and_define_time !=============================================================================== subroutine med_io_read_FB(filename, vm, iam, FB, pre, frame, rc) diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index d37c5b248..96284e578 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -103,7 +103,7 @@ module med_phases_history_mod character(CS) :: alarmname ! name of write alarm integer :: ntperfile ! maximum number of time samples per file integer :: nt = 0 ! time in file - logical :: useavg ! if true, time average, otherwise instantaneous + 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) :: hclock ! auxiliary history clock @@ -653,20 +653,18 @@ subroutine med_phases_history_write_aux_comp(gcomp, compid, first_time, subname, rc = ESMF_SUCCESS call t_startf('MED:'//subname) - if (first_time) then - - ! Get the internal state - nullify(is_local%wrap) - call ESMF_GridCompGetInternalState(gcomp, is_local, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Get the internal state + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_ModelGet(gcomp, modelClock=mclock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_ModelGet(gcomp, modelClock=mclock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (first_time) 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 @@ -683,7 +681,6 @@ subroutine med_phases_history_write_aux_comp(gcomp, compid, first_time, subname, ! If file will be written - then initialize auxfiles(nfcnt,compid) if (enable_auxfile) then - ! Increment nfcnt nfcnt = nfcnt + 1 @@ -694,9 +691,9 @@ subroutine med_phases_history_write_aux_comp(gcomp, compid, first_time, subname, if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Determine if will do time average for aux file - call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_useavg', value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_doavg', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) auxfiles(nfcnt,compid)%useavg + read(cvalue,*) auxfiles(nfcnt,compid)%doavg ! Determine the colon delimited field names for this file call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_flds', value=auxflds, rc=rc) @@ -754,7 +751,7 @@ subroutine med_phases_history_write_aux_comp(gcomp, compid, first_time, subname, end if ! Create FBaccum if averaging is on - if (auxfiles(nfcnt,compid)%useavg) then + if (auxfiles(nfcnt,compid)%doavg) then ! First duplicate all fields in FBImp(compid,compid) call ESMF_LogWrite(trim(subname)// ": initializing FBaccum(compid)", ESMF_LOGMSG_INFO) @@ -850,6 +847,7 @@ subroutine med_phases_history_write_aux_comp(gcomp, compid, first_time, subname, call ESMF_ClockSet(auxfiles(n,compid)%hclock, currTime=currtime) if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Write auxiliary file(s) call med_phases_history_write_hfileaux(gcomp, n, compid, auxfiles(n,compid), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end do @@ -862,6 +860,7 @@ subroutine med_phases_history_write_hfile(gcomp, comptype, hclock, alarmname, do use med_methods_mod , only : med_methods_FB_reset use med_constants_mod , only : czero => med_constants_czero + use med_io_mod , only : med_io_write_time, med_io_define_time ! input/output variables type(ESMF_GridComp) , intent(inout) :: gcomp @@ -874,25 +873,18 @@ subroutine med_phases_history_write_hfile(gcomp, comptype, hclock, alarmname, do ! local variables type(InternalState) :: is_local type(ESMF_VM) :: vm - type(ESMF_Clock) :: mclock - type(ESMF_Alarm) :: alarm - type(ESMF_Time) :: starttime - type(ESMF_Time) :: currtime - type(ESMF_Time) :: nexttime + integer :: iam ! mpi task number type(ESMF_Calendar) :: calendar ! calendar type - type(ESMF_TimeInterval) :: timediff(2) ! time bounds upper and lower relative to start - type(ESMF_TimeInterval) :: ringInterval ! alarm interval - real(r8) :: tbnds(2) ! CF1.0 time bounds - integer :: i,j,m,n + integer :: i,m,n ! indices integer :: nx,ny ! global grid size character(CL) :: time_units ! units of time variable - character(CL) :: hist_file - real(r8) :: days_since ! Time interval since reference time - real(r8) :: avg_time ! Time coordinate output + character(CL) :: hist_file ! history file name + real(r8) :: days_since ! time interval since reference time + real(r8) :: time_val ! time coordinate output + real(r8) :: time_bnds(2) ! time bounds output logical :: whead,wdata ! for writing restart/history cdf files - integer :: iam - logical :: write_now - integer :: yr,mon,day,sec ! time units + logical :: write_now ! true => write to history type + real(r8) :: tbnds(2) ! CF1.0 time bounds character(len=*), parameter :: subname='(med_phases_history_write_hfile)' !--------------------------------------- @@ -903,29 +895,15 @@ subroutine med_phases_history_write_hfile(gcomp, comptype, hclock, alarmname, do call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Get the history file alarm and determine if alarm is ringing - ! call NUOPC_ModelGet(gcomp, modelClock=mclock, rc=rc) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockGetAlarm(hclock, alarmname=trim(alarmname), alarm=alarm, rc=rc) + ! Determine if will write to history file + call med_phases_history_query_ifwrite(hclock, alarmname, write_now, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (ESMF_AlarmIsRinging(alarm, rc=rc)) then - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Set write_now flag - write_now = .true. - ! Turn ringer off - call ESMF_AlarmRingerOff(alarm, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (debug_alarms) then - ! Write diagnostic output - call med_phases_history_output_alarminfo(hclock, alarm, alarmname, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - else - write_now = .false. - end if + ! Determine history file time info + call med_phases_history_set_timeinfo(hclock, doavg, alarmname, days_since, time_val, time_bnds, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Accumulate if alarm is not on and then average if write_now flag is true + ! If averaging history output then accumulate and then average if write_now flag is true if (doavg) then do n = 1,ncomps if (comptype == 'all' .or. comptype == trim(compname(n))) then @@ -955,28 +933,14 @@ subroutine med_phases_history_write_hfile(gcomp, comptype, hclock, alarmname, do ! Write the mediator history file if apropriate if (write_now) then - - ! Set tbnds and avg_time if doing averaging - if (doavg) then - call ESMF_ClockGet(hclock, currtime=currtime, starttime=starttime, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockGetNextTime(hclock, nextTime=nexttime, 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 - ringinterval - starttime - call ESMF_TimeIntervalGet(timediff(2), d_r8=tbnds(2), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeIntervalGet(timediff(1), d_r8=tbnds(1), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - avg_time = 0.5_r8 * (tbnds(1) + tbnds(2)) - end if - ! Determine history file name and time units call med_phases_history_get_filename(gcomp, doavg, comptype, hist_file, time_units, days_since, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Determine time_val and tbnds data for history file + call med_phases_history_set_timeinfo(hclock, doavg, alarmname, days_since, time_val, time_bnds, 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 @@ -988,21 +952,19 @@ subroutine med_phases_history_write_hfile(gcomp, comptype, hclock, alarmname, do whead = .true. wdata = .false. else if (m == 2) then + call med_io_enddef(hist_file) whead = .false. wdata = .true. - call med_io_enddef(hist_file) end if ! Write time values (tbnds does not appear in instantaneous output) - call ESMF_ClockGet(hclock, calendar=calendar, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (doavg) then - call med_io_write(hist_file, iam, time_units=time_units, calendar=calendar, time_val=avg_time, & - nt=1, tbnds=tbnds, whead=whead, wdata=wdata, rc=rc) + if (whead) then + call ESMF_ClockGet(hclock, 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(hist_file, iam, time_units=time_units, calendar=calendar, time_val=days_since, & - nt=1, whead=whead, wdata=wdata, rc=rc) + call med_io_write_time(time_val, time_bnds, nt=1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -1094,6 +1056,7 @@ end subroutine med_phases_history_write_hfile subroutine med_phases_history_write_hfileaux(gcomp, nfile_index, comp_index, auxfile, rc) use med_constants_mod, only : czero => med_constants_czero + use med_io_mod , only : med_io_write_time, med_io_define_time ! input/output variables type(ESMF_GridComp) , intent(inout) :: gcomp @@ -1105,24 +1068,21 @@ subroutine med_phases_history_write_hfileaux(gcomp, nfile_index, comp_index, aux ! local variables type(InternalState) :: is_local type(ESMF_VM) :: vm - type(ESMF_Clock) :: mclock - type(ESMF_Alarm) :: alarm type(ESMF_Time) :: starttime type(ESMF_Time) :: currtime - type(ESMF_Time) :: nexttime type(ESMF_Calendar) :: calendar ! calendar type - type(ESMF_TimeInterval) :: timediff(2) ! time bounds upper and lower relative to start - type(ESMF_TimeInterval) :: ringInterval ! alarm interval character(CS) :: timestr ! yr-mon-day-sec string character(CL) :: time_units ! units of time variable - real(r8) :: avg_time ! Time coordinate output + real(r8) :: time_coord ! Time coordinate output integer :: nx,ny ! global grid size logical :: whead,wdata ! for writing restart/history cdf files logical :: write_now ! if true, write time sample to file integer :: iam ! mpi task integer :: start_ymd ! Starting date YYYYMMDD integer :: yr,mon,day,sec ! time units - real(r8) :: tbnds(2) ! CF1.0 time bounds + real(r8) :: days_since ! time interval since reference time + real(r8) :: time_val ! time coordinate output + real(r8) :: time_bnds(2) ! time bounds output character(len=*), parameter :: subname='(med_phases_history_write_hfileaux)' !--------------------------------------- @@ -1139,56 +1099,12 @@ subroutine med_phases_history_write_hfileaux(gcomp, nfile_index, comp_index, aux call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Determine time info - ! Use nexttime rather than currtime for the time difference form - ! start since that is the time at the end of the time step - call ESMF_ClockGet(auxfile%hclock, currtime=currtime, starttime=starttime, calendar=calendar, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockGetNextTime(auxfile%hclock, nextTime=nexttime, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockGetAlarm(auxfile%hclock, alarmname=trim(auxfile%alarmname), alarm=alarm, rc=rc) + ! Determine if will write to history file + call med_phases_history_query_ifwrite(auxfile%hclock, auxfile%alarmname, write_now, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - write_now = .false. - if (ESMF_AlarmIsRinging(alarm, rc=rc)) then - write_now = .true. - call ESMF_AlarmRingerOff( alarm, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (debug_alarms) then - call med_phases_history_output_alarminfo(auxfile%hclock, alarm, auxfile%alarmname, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - call ESMF_AlarmGet(alarm, ringInterval=ringInterval, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - timediff(2) = currtime - starttime - timediff(1) = currtime - starttime - ringinterval - call ESMF_TimeIntervalGet(timediff(2), d_r8=tbnds(2), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeIntervalGet(timediff(1), d_r8=tbnds(1), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - avg_time = 0.5_r8 * (tbnds(1) + tbnds(2)) - end if - - if (mastertask .and. debug_alarms) then - if (write_now) then - write(logunit,'(a)')' alarmname = '//trim(auxfile%alarmname)//' is ringing' - write(logunit,'(a,f13.5,a,f13.5)')' tbnds(1) = ',tbnds(1),' tbnds(2) = ',tbnds(2) - else - write(logunit,'(a)')' alarmname = '//trim(auxfile%alarmname)//' is not ringing' - 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(logunit,'(a,4(i6,2x))')' nexttime is ',yr,mon,day,sec - call ESMF_TimeGet(currtime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - write(logunit,'(a,4(i6,2x))')' currtime is ',yr,mon,day,sec - call ESMF_TimeGet(starttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - write(logunit,'(a,4(i6,2x))')' starttime is ',yr,mon,day,sec - end if - ! Do accumulation and average if required - if (auxfile%useavg) then + if (auxfile%doavg) then call med_phases_history_fldbun_accum(is_local%wrap%FBImp(comp_index,comp_index), auxfile%FBaccum, & auxfile%accumcnt, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1200,7 +1116,6 @@ subroutine med_phases_history_write_hfileaux(gcomp, nfile_index, comp_index, aux ! Write time sample to file if ( write_now ) then - ! Increment number of time samples on file auxfile%nt = auxfile%nt + 1 @@ -1210,7 +1125,6 @@ subroutine med_phases_history_write_hfileaux(gcomp, nfile_index, comp_index, aux ! Write header if (auxfile%nt == 1) then - ! determine history file name call ESMF_ClockGet(auxfile%hclock, currtime=currtime, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1228,15 +1142,16 @@ subroutine med_phases_history_write_hfileaux(gcomp, nfile_index, comp_index, aux call med_io_wopen(auxfile%histfile, vm, iam, file_ind=nfile_index, clobber=.true.) ! define time units + call ESMF_ClockGet(auxfile%hclock, starttime=starttime, calendar=calendar, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return 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) + 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 ! define time variables - call med_io_write(auxfile%histfile, iam, time_units, calendar, avg_time, & - nt=auxfile%nt, tbnds=tbnds, whead=.true., wdata=.false., file_ind=nfile_index, rc=rc) + call med_io_define_time(time_units, calendar, file_ind=nfile_index, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! define data variables with a time dimension (include the nt argument below) @@ -1247,16 +1162,17 @@ subroutine med_phases_history_write_hfileaux(gcomp, nfile_index, comp_index, aux ! end definition phase call med_io_enddef(auxfile%histfile, file_ind=nfile_index) - end if ! Write time variables for time nt - call med_io_write(auxfile%histfile, iam, time_units, calendar, avg_time, & - nt=auxfile%nt, tbnds=tbnds, whead=.false., wdata=.true., file_ind=nfile_index, rc=rc) + call med_phases_history_set_timeinfo(auxfile%hclock, auxfile%doavg, auxfile%alarmname, & + days_since, time_val, time_bnds, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_io_write_time(time_val, time_bnds, nt=auxfile%nt, file_ind=nfile_index, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Write data variables for time nt - if (auxfile%useavg) then + if (auxfile%doavg) then call med_io_write(auxfile%histfile, iam, auxfile%FBaccum, & nx=nx, ny=ny, nt=auxfile%nt, whead=.false., wdata=.true., pre=trim(compname(comp_index))//'Imp', & flds=auxfile%flds, file_ind=nfile_index, rc=rc) @@ -1685,4 +1601,111 @@ subroutine med_phases_history_init_fldbun_accum(fldbun, scalar_name, fldbun_accu end subroutine med_phases_history_init_fldbun_accum + !=============================================================================== + subroutine med_phases_history_query_ifwrite(clock, alarmname, write_now, rc) + + ! input/output variables + type(ESMF_Clock) , intent(in) :: clock + character(len=*) , intent(in) :: alarmname + logical , intent(out) :: write_now + integer , intent(out) :: rc + + ! local variables + type(ESMF_Alarm) :: alarm + type(ESMF_Time) :: starttime + type(ESMF_Time) :: currtime + type(ESMF_Time) :: nexttime + integer :: yr,mon,day,sec ! time units + !--------------------------------------- + + rc = ESMF_SUCCESS + + ! Get the history file alarm and determine if alarm is ringing + call ESMF_ClockGetAlarm(clock, 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 (mastertask .and. debug_alarms) then + if (write_now) then + call med_phases_history_output_alarminfo(clock, alarm, alarmname, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(logunit,'(a)')' alarmname = '//trim(alarmname)//' is ringing' + call ESMF_ClockGet(clock, startTime=StartTime, currTime=CurrTime, 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_TimeGet(nexttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(logunit,'(a,4(i6,2x))')' nexttime is ',yr,mon,day,sec + call ESMF_TimeGet(currtime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(logunit,'(a,4(i6,2x))')' currtime is ',yr,mon,day,sec + call ESMF_TimeGet(starttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(logunit,'(a,4(i6,2x))')' starttime is ',yr,mon,day,sec + end if + end if + + end subroutine med_phases_history_query_ifwrite + + !=============================================================================== + subroutine med_phases_history_set_timeinfo(clock, doavg, alarmname, days_since, time_val, time_bnds, rc) + + ! input/output variables + type(ESMF_Clock) , intent(in) :: clock + logical , intent(in) :: doavg + character(len=*) , intent(in) :: alarmname + real(r8) , intent(in) :: days_since + real(r8) , intent(out) :: time_val + real(r8) , intent(out) :: time_bnds(2) + integer , intent(out) :: rc + + ! local variables + 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 + !--------------------------------------- + + rc = ESMF_SUCCESS + + ! Get the history file alarm and determine if alarm is ringing + call ESMF_ClockGetAlarm(clock, alarmname=trim(alarmname), alarm=alarm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Set time bounds and time coord + if (doavg) 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_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 + time_val = days_since + time_bnds(1) = time_val + time_bnds(2) = time_val + end if + + end subroutine med_phases_history_set_timeinfo + end module med_phases_history_mod diff --git a/mediator/med_phases_restart_mod.F90 b/mediator/med_phases_restart_mod.F90 index 4da865b67..d63546663 100644 --- a/mediator/med_phases_restart_mod.F90 +++ b/mediator/med_phases_restart_mod.F90 @@ -481,7 +481,7 @@ subroutine med_phases_restart_write(gcomp, rc) ! one time sample - this will be generalized in the future do nc = 2,ncomps do nf = 1,num_auxfiles(nc) - if (auxfiles(nc,nf)%useavg .and. auxfiles(nc,nf)%accumcnt > 0) then + if (auxfiles(nc,nf)%doavg .and. auxfiles(nc,nf)%accumcnt > 0) then call med_io_write(restart_file, iam, auxfiles(nc,nf)%accumcnt, & trim(compname(nc))//trim(auxfiles(nc,nf)%auxname)//'_accumcnt', & whead=whead, wdata=wdata, rc=rc) From 31525e71e3157fb45cc4d547f594af0ce4033b95 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sat, 4 Sep 2021 11:06:57 -0600 Subject: [PATCH 42/61] more refactoring of history output to enable code reuse --- cime_config/namelist_definition_drv.xml | 16 +- mediator/med_io_mod.F90 | 464 +++++++----------------- mediator/med_phases_history_mod.F90 | 383 +++++++------------ mediator/med_phases_restart_mod.F90 | 123 +++---- 4 files changed, 335 insertions(+), 651 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 8448a59cb..47cafab71 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -1184,7 +1184,7 @@ 1 - + logical aux_hist MED_attributes @@ -1249,7 +1249,7 @@ 1 - + logical aux_hist MED_attributes @@ -1316,7 +1316,7 @@ 3 - + logical aux_hist MED_attributes @@ -1385,7 +1385,7 @@ 3 - + logical aux_hist MED_attributes @@ -1450,7 +1450,7 @@ 1 - + logical aux_hist MED_attributes @@ -1668,7 +1668,7 @@ 1 - + logical aux_hist MED_attributes @@ -1733,7 +1733,7 @@ 1 - + logical aux_hist MED_attributes @@ -1900,7 +1900,7 @@ 1 - + char aux_hist MED_attributes diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index 2e43e6124..77b1acb53 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -57,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_and_define_time end interface med_io_write interface med_io_date2ymd module procedure med_io_date2ymd_int @@ -90,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 @@ -98,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 @@ -494,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 @@ -508,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 @@ -519,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) ' @@ -537,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(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. @@ -592,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 @@ -601,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) ' !------------------------------------------------------------------------------- @@ -623,6 +631,9 @@ subroutine med_io_close(filename, iam, file_ind, rc) 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) then write(logunit,*) subname,' different wfilename and filename currently open, aborting ' @@ -675,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 !=============================================================================== @@ -734,7 +745,7 @@ 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, & + subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & fillval, pre, flds, tavg, use_float, file_ind, rc) !--------------- @@ -751,21 +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 - 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 + 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 @@ -789,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(:,:) @@ -818,23 +827,11 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & if (present(fillval)) lfillvalue = fillval lpre = ' ' if (present(pre)) lpre = trim(pre) - lwhead = .true. - if (present(whead)) lwhead = whead - lwdata = .true. - if (present(wdata)) lwdata = wdata luse_float = .false. if (present(use_float)) luse_float = use_float lfile_ind = 0 if (present(file_ind)) lfile_ind=file_ind - 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 - ! Error check if (.not. ESMF_FieldBundleIsCreated(FB, rc=rc)) then call ESMF_LogWrite(trim(subname)//" FB "//trim(lpre)//" not created", ESMF_LOGMSG_INFO) @@ -906,28 +903,21 @@ 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 (present(nt)) then + frame = nt + else + frame = -1 + end if + ! Write header - if (lwhead) then + 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 @@ -941,7 +931,6 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) do k = 1,nf - ! Determine field name if (present(flds)) then itemc = trim(flds(k)) @@ -1035,13 +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 @@ -1120,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 @@ -1130,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 @@ -1142,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 @@ -1170,10 +1143,8 @@ 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) endif @@ -1181,7 +1152,7 @@ subroutine med_io_write_int(filename, iam, idata, dname, whead, wdata, file_ind, 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 @@ -1192,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 @@ -1209,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 @@ -1239,8 +1198,7 @@ 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) - else 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 @@ -1248,7 +1206,7 @@ subroutine med_io_write_int1d(filename, iam, idata, dname, whead, wdata, file_in 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 @@ -1258,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 @@ -1299,9 +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 - else 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,19 +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) @@ -1430,8 +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) - else if (lwdata) then + else if (wdata) then charvar = '' charvar = trim(rdata) rcode = pio_inq_varid(io_file(lfile_ind),trim(dname),varid) @@ -1444,10 +1357,11 @@ end subroutine med_io_write_char subroutine med_io_define_time(time_units, calendar, file_ind, rc) use ESMF, only : operator(==), operator(/=) - use ESMF, only : ESMF_Calendar + 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 @@ -1465,7 +1379,7 @@ subroutine med_io_define_time(time_units, calendar, file_ind, rc) type(var_desc_t) :: varid 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 @@ -1473,7 +1387,14 @@ subroutine med_io_define_time(time_units, calendar, file_ind, rc) lfile_ind = 0 if (present(file_ind)) lfile_ind=file_ind - ! define time + 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 + end if + + ! 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)) @@ -1545,124 +1466,7 @@ subroutine med_io_write_time(time_val, tbnds, nt, file_ind, rc) end subroutine med_io_write_time !=============================================================================== - subroutine med_io_write_and_define_time(filename, iam, time_units, calendar, time_val, nt,& - whead, wdata, tbnds, file_ind, rc) - - !--------------- - ! Write time variable to netcdf file - !--------------- - - use ESMF, only : operator(==) - use ESMF, only : ESMF_Calendar - 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 pio , only : var_desc_t, PIO_UNLIMITED, PIO_DOUBLE, PIO_DEF_VAR - use pio , only : pio_put_att, pio_inq_varid, pio_put_var, pio_def_dim, pio_def_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 - - ! 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) ' - !------------------------------------------------------------------------------- - - 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 ! Write out header - - ! define time - 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 bounds - 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) - - else if (lwdata) then ! Write out data - - ! write time - 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(1:1), count(1:1), time_val_1d) - - ! write time bounds - if (present(tbnds)) then - rcode = pio_inq_varid(io_file(lfile_ind), 'time_bnds', varid) - count(1) = 2 - count(2) = 1 - start(1) = 1 - if (present(nt)) then - start(2) = nt - else - start(2) = 1 - endif - rcode = pio_put_var(io_file(lfile_ind), varid, start(1:2), count(1:2), tbnds) - endif - - endif - end subroutine med_io_write_and_define_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 @@ -1682,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 @@ -1749,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 @@ -1935,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 @@ -1952,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) @@ -1981,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 @@ -1990,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 @@ -2001,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 @@ -2022,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 @@ -2033,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) ' !------------------------------------------------------------------------------- @@ -2040,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) @@ -2064,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 @@ -2073,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 @@ -2084,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) @@ -2092,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 @@ -2105,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 @@ -2116,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) ' !------------------------------------------------------------------------------- @@ -2123,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) @@ -2147,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 @@ -2160,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 @@ -2171,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) ' !------------------------------------------------------------------------------- @@ -2179,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_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 96284e578..3ca912c0a 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -37,7 +37,6 @@ module med_phases_history_mod use NUOPC_Model , only : NUOPC_ModelGet use esmFlds , only : compmed, compatm, complnd, compocn, compice, comprof, compglc, compwav use esmFlds , only : ncomps, compname, num_icesheets - use esmFlds , only : fldListFr, fldListTo use med_constants_mod , only : SecPerDay => med_constants_SecPerDay use med_utils_mod , only : chkerr => med_utils_ChkErr use med_methods_mod , only : med_methods_FB_reset @@ -69,10 +68,8 @@ module med_phases_history_mod private :: med_phases_history_write_aux_comp ! write auxiliary file for a given component private :: med_phases_history_write_hfile private :: med_phases_history_write_hfileaux - private :: med_phases_history_get_filename private :: med_phases_history_get_auxflds private :: med_phases_history_output_alarminfo - private :: med_phases_history_ymds2rday_offset character(CL) :: case_name = 'unset' ! case name character(CS) :: inst_tag = 'unset' ! instance tag @@ -873,13 +870,11 @@ subroutine med_phases_history_write_hfile(gcomp, comptype, hclock, alarmname, do ! local variables type(InternalState) :: is_local type(ESMF_VM) :: vm - integer :: iam ! mpi task number 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) :: days_since ! time interval since reference time real(r8) :: time_val ! time coordinate output real(r8) :: time_bnds(2) ! time bounds output logical :: whead,wdata ! for writing restart/history cdf files @@ -899,10 +894,6 @@ subroutine med_phases_history_write_hfile(gcomp, comptype, hclock, alarmname, do call med_phases_history_query_ifwrite(hclock, alarmname, write_now, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Determine history file time info - call med_phases_history_set_timeinfo(hclock, doavg, alarmname, days_since, time_val, time_bnds, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! If averaging history output then accumulate and then average if write_now flag is true if (doavg) then do n = 1,ncomps @@ -931,22 +922,18 @@ subroutine med_phases_history_write_hfile(gcomp, comptype, hclock, alarmname, do end do end if - ! Write the mediator history file if apropriate + ! If write now flag is true if (write_now) then - ! Determine history file name and time units - call med_phases_history_get_filename(gcomp, doavg, comptype, hist_file, time_units, days_since, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Determine time_val and tbnds data for history file - call med_phases_history_set_timeinfo(hclock, doavg, alarmname, days_since, time_val, time_bnds, rc) + ! Determine time_val and tbnds data for history as well as history file name + call med_phases_history_set_timeinfo(gcomp, hclock, alarmname, doavg, & + time_val, time_bnds, time_units, hist_file, compname=comptype, 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 ESMF_VMGet(vm, localPet=iam, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(hist_file, vm, iam, clobber=.true.) + call med_io_wopen(hist_file, vm, clobber=.true.) do m = 1,2 if (m == 1) then whead = .true. @@ -957,7 +944,7 @@ subroutine med_phases_history_write_hfile(gcomp, comptype, hclock, alarmname, do wdata = .true. end if - ! Write time values (tbnds does not appear in instantaneous output) + ! Write time values if (whead) then call ESMF_ClockGet(hclock, calendar=calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -976,37 +963,37 @@ subroutine med_phases_history_write_hfile(gcomp, comptype, hclock, alarmname, do ny = is_local%wrap%ny(n) if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(n,n),rc=rc)) then if (doavg) then - call med_io_write(hist_file, iam, avgfiles_import(n)%FBaccum, & - nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre=trim(compname(n))//'Imp', rc=rc) + call med_io_write(hist_file, avgfiles_import(n)%FBaccum, whead, wdata, nx, ny, & + nt=1, pre=trim(compname(n))//'Imp', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (wdata == .true.) then + if (wdata) then call med_methods_FB_reset(avgfiles_import(n)%FBAccum, czero, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if else - 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) + call med_io_write(hist_file, is_local%wrap%FBimp(n,n), whead, wdata, nx, ny, & + nt=1, pre=trim(compname(n))//'Imp', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if endif if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(n),rc=rc)) then if (doavg) then - call med_io_write(hist_file, iam, avgfiles_export(n)%FBaccum, & - nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre=trim(compname(n))//'Exp', rc=rc) + call med_io_write(hist_file, avgfiles_export(n)%FBaccum, whead, wdata, nx, ny, & + nt=1, pre=trim(compname(n))//'Exp', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (wdata == .true.) then + if (wdata) then call med_methods_FB_reset(avgfiles_export(n)%FBAccum, czero, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if else - 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) + call med_io_write(hist_file, is_local%wrap%FBexp(n), whead, wdata, nx, ny, & + nt=1, pre=trim(compname(n))//'Exp', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if endif endif end if - enddo + end do ! Write mediator fractions ! Also write atm/ocn fluxes and ocean albedoes if field bundles are created @@ -1014,42 +1001,37 @@ subroutine med_phases_history_write_hfile(gcomp, comptype, hclock, alarmname, do if (comptype == 'all' .or. comptype == 'med') then do n = 2,ncomps ! skip the mediator here if (ESMF_FieldBundleIsCreated(is_local%wrap%FBFrac(n),rc=rc)) then - call med_io_write(hist_file, iam, is_local%wrap%FBFrac(n), & - nx=is_local%wrap%nx(n), ny=is_local%wrap%ny(n), nt=1, whead=whead, wdata=wdata, & - pre='Med_frac_'//trim(compname(n)), rc=rc) + call med_io_write(hist_file, is_local%wrap%FBFrac(n), whead, wdata, & + 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 end do if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o,rc=rc)) then - call med_io_write(hist_file, iam, is_local%wrap%FBMed_ocnalb_o, & - nx=is_local%wrap%nx(compocn), ny=is_local%wrap%ny(compocn), nt=1, whead=whead, wdata=wdata, & - pre='Med_alb_ocn', rc=rc) + call med_io_write(hist_file, is_local%wrap%FBMed_ocnalb_o, whead, wdata, & + 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, iam, is_local%wrap%FBMed_aoflux_o, & - nx=is_local%wrap%nx(compocn), ny=is_local%wrap%ny(compocn), nt=1, whead=whead, wdata=wdata, & - pre='Med_aoflux_ocn', rc=rc) + call med_io_write(hist_file, is_local%wrap%FBMed_aoflux_o, whead, wdata, & + 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, iam, is_local%wrap%FBMed_ocnalb_a, & - nx=is_local%wrap%nx(compatm), ny=is_local%wrap%ny(compatm), nt=1, whead=whead, wdata=wdata, & - pre='Med_alb_atm', rc=rc) + call med_io_write(hist_file, is_local%wrap%FBMed_ocnalb_a, whead, wdata, & + 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, iam, is_local%wrap%FBMed_aoflux_a, & - nx=is_local%wrap%nx(compatm), ny=is_local%wrap%ny(compatm), nt=1, whead=whead, wdata=wdata, & - pre='Med_aoflux_atm', rc=rc) + call med_io_write(hist_file, is_local%wrap%FBMed_aoflux_a, whead, wdata, & + is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_aoflux_atm', rc=rc) end if end if end if end do ! end of loop over m - ! Close file - call med_io_close(hist_file, iam, rc=rc) + call med_io_close(hist_file, vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if ! end of if-alarm is ringingblock + end if ! end of write_now if-block + end subroutine med_phases_history_write_hfile !=============================================================================== @@ -1077,8 +1059,6 @@ subroutine med_phases_history_write_hfileaux(gcomp, nfile_index, comp_index, aux integer :: nx,ny ! global grid size logical :: whead,wdata ! for writing restart/history cdf files logical :: write_now ! if true, write time sample to file - integer :: iam ! mpi task - integer :: start_ymd ! Starting date YYYYMMDD integer :: yr,mon,day,sec ! time units real(r8) :: days_since ! time interval since reference time real(r8) :: time_val ! time coordinate output @@ -1091,8 +1071,6 @@ subroutine med_phases_history_write_hfileaux(gcomp, nfile_index, comp_index, aux ! Get the communicator and localpet 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 the internal state nullify(is_local%wrap) @@ -1116,48 +1094,35 @@ subroutine med_phases_history_write_hfileaux(gcomp, nfile_index, comp_index, aux ! Write time sample to file if ( write_now ) then - ! Increment number of time samples on file - auxfile%nt = auxfile%nt + 1 + + ! Determine time_val and tbnds data for history as well as history file name + call med_phases_history_set_timeinfo(gcomp, auxfile%hclock, auxfile%alarmname, auxfile%doavg, & + time_val, time_bnds, time_units, auxfile%histfile, auxname=auxfile%auxname, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Set shorthand variables nx = is_local%wrap%nx(comp_index) ny = is_local%wrap%ny(comp_index) + ! Increment number of time samples on file + auxfile%nt = auxfile%nt + 1 + ! Write header if (auxfile%nt == 1) then - ! determine history file name - call ESMF_ClockGet(auxfile%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(timestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec - if (trim(case_name) == 'unset') then - call med_phases_history_set_casename(gcomp, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - write(auxfile%histfile, "(8a)") & - trim(case_name),'.cpl',trim(inst_tag),'.hx.', trim(auxfile%auxname),'.',trim(timestr), '.nc' - ! open file - call med_io_wopen(auxfile%histfile, vm, iam, file_ind=nfile_index, clobber=.true.) - - ! define time units - call ESMF_ClockGet(auxfile%hclock, starttime=starttime, calendar=calendar, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - 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 + call med_io_wopen(auxfile%histfile, vm, file_ind=nfile_index, clobber=.true.) ! define time variables + call ESMF_ClockGet(auxfile%hclock, calendar=calendar, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call med_io_define_time(time_units, calendar, file_ind=nfile_index, 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(auxfile%histfile, iam, is_local%wrap%FBimp(comp_index,comp_index), & - nx=nx, ny=ny, nt=auxfile%nt, whead=.true., wdata=.false., pre=trim(compname(comp_index))//'Imp', & - flds=auxfile%flds, file_ind=nfile_index, use_float=.true., rc=rc) + whead = .true.; wdata = .false. + call med_io_write(auxfile%histfile, is_local%wrap%FBimp(comp_index,comp_index), whead, wdata, nx, ny, & + nt=auxfile%nt, pre=trim(compname(comp_index))//'Imp', flds=auxfile%flds, file_ind=nfile_index, & + use_float=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! end definition phase @@ -1165,30 +1130,26 @@ subroutine med_phases_history_write_hfileaux(gcomp, nfile_index, comp_index, aux end if ! Write time variables for time nt - call med_phases_history_set_timeinfo(auxfile%hclock, auxfile%doavg, auxfile%alarmname, & - days_since, time_val, time_bnds, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return call med_io_write_time(time_val, time_bnds, nt=auxfile%nt, file_ind=nfile_index, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Write data variables for time nt + whead = .false.; wdata = .true. if (auxfile%doavg) then - call med_io_write(auxfile%histfile, iam, auxfile%FBaccum, & - nx=nx, ny=ny, nt=auxfile%nt, whead=.false., wdata=.true., pre=trim(compname(comp_index))//'Imp', & - flds=auxfile%flds, file_ind=nfile_index, rc=rc) + call med_io_write(auxfile%histfile, auxfile%FBaccum, whead, wdata, nx, ny, & + nt=auxfile%nt, pre=trim(compname(comp_index))//'Imp', flds=auxfile%flds, file_ind=nfile_index, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call med_methods_FB_reset(auxfile%FBaccum, value=czero, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call med_io_write(auxfile%histfile, iam, is_local%wrap%FBimp(comp_index,comp_index), & - nx=nx, ny=ny, nt=auxfile%nt, whead=.false., wdata=.true., pre=trim(compname(comp_index))//'Imp', & - flds=auxfile%flds, file_ind=nfile_index, rc=rc) + call med_io_write(auxfile%histfile, is_local%wrap%FBimp(comp_index,comp_index), whead, wdata, nx, ny, & + nt=auxfile%nt, pre=trim(compname(comp_index))//'Imp', flds=auxfile%flds, file_ind=nfile_index, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if ! Close file if (auxfile%nt == auxfile%ntperfile) then - call med_io_close(auxfile%histfile, iam, file_ind=nfile_index, rc=rc) + call med_io_close(auxfile%histfile, vm, file_ind=nfile_index, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return auxfile%nt = 0 end if @@ -1197,83 +1158,6 @@ subroutine med_phases_history_write_hfileaux(gcomp, nfile_index, comp_index, aux end subroutine med_phases_history_write_hfileaux - !=============================================================================== - subroutine med_phases_history_get_filename(gcomp, doavg, comptype, hist_file, time_units, days_since, rc) - - ! input/output variables - type(ESMF_GridComp) , intent(inout) :: gcomp - logical , intent(in) :: doavg - character(len=*) , intent(in) :: comptype - character(len=*) , intent(out) :: hist_file - character(len=*) , intent(out) :: time_units - real(r8) , intent(out) :: days_since ! Time interval since reference time - integer , intent(out) :: rc - - ! local variables - type(ESMF_Clock) :: mclock - type(ESMF_Time) :: currtime - type(ESMF_Time) :: starttime - type(ESMF_Time) :: nexttime - type(ESMF_TimeInterval) :: timediff ! Used to calculate curr_time - type(ESMF_Calendar) :: calendar ! calendar type - character(len=CS) :: currtimestr - character(len=CS) :: nexttimestr - integer :: start_ymd ! Starting date YYYYMMDD - integer :: yr,mon,day,sec ! time units - logical :: isPresent - character(len=CS) :: histstr - character(len=*), parameter :: subname='(med_phases_history_get_filename)' - !--------------------------------------- - - rc = ESMF_SUCCESS - - ! Get time unit attribute value for variables - call NUOPC_ModelGet(gcomp, modelClock=mclock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockGet(mclock, currtime=currtime, starttime=starttime, calendar=calendar, 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 - 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_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 - 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 - 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 - - ! Determine history file name - ! Use nexttimestr rather than currtimestr here since that is the time at the end of - ! the timestep and is preferred for history file names - if (doavg) then - histstr = 'ha.' - else - histstr = 'hi.' - end if - if (trim(comptype) /= 'all') then - histstr = trim(histstr) // trim(comptype) // '.' - end if - if (trim(case_name) == 'unset') then - call med_phases_history_set_casename(gcomp, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - write(hist_file,"(6a)") trim(case_name),'.cpl.',trim(inst_tag),trim(histstr),trim(nexttimestr),'.nc' - if (mastertask) then - write(logunit,*) - write(logunit,' (a)') "writing mediator history file "//trim(hist_file) - write(logunit,' (a)') "currtime = "//trim(currtimestr)//" nexttime = "//trim(nexttimestr) - end if - - end subroutine med_phases_history_get_filename - !=============================================================================== subroutine med_phases_history_get_auxflds(str, flds, rc) @@ -1394,67 +1278,6 @@ subroutine med_phases_history_output_alarminfo(mclock, alarm, alarmname, rc) end subroutine med_phases_history_output_alarminfo - !=============================================================================== - subroutine med_phases_history_ymds2rday_offset(currtime, rdays_offset, & - years_offset, months_offset, days_offset, seconds_offset, rc) - - ! Given the current time and optional year, month, day and seconds offsets - ! from the current time: Return an offset from the current time given in fractional days. - ! For example, if day_offset = -2 and seconds_offset = -21600, rday_offset will be -2.25. - ! One or more of the following optional arguments should be provided: - - ! input/output variables - type(ESMF_Time) , intent(in) :: currtime ! current time - real(r8) , intent(out) :: rdays_offset ! offset from current time in fractional days - integer , intent(in), optional :: years_offset ! number of years offset from current time - integer , intent(in), optional :: months_offset ! number of months offset from current time - integer , intent(in), optional :: days_offset ! number of days offset from current time - integer , intent(in), optional :: seconds_offset ! number of seconds offset from current time - integer , intent(out) :: rc - - ! local variables - type(ESMF_TimeInterval) :: timeinterval - !--------------------------------------- - - rc = ESMF_SUCCESS - - call ESMF_TimeIntervalSet(timeinterval=timeinterval, startTime=currtime, & - YY=years_offset, MM=months_offset, D=days_offset, S=seconds_offset, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_TimeIntervalGet(timeinterval=timeinterval, d_r8=rdays_offset, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - end subroutine med_phases_history_ymds2rday_offset - - !=============================================================================== - subroutine med_phases_history_set_casename(gcomp, rc) - - ! Set module variables case_name and inst_tag - - ! input/output variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! local variables - logical :: isPresent - logical :: isSet - !--------------------------------------- - rc = ESMF_SUCCESS - - 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 subroutine med_phases_history_set_casename - !=============================================================================== subroutine med_phases_history_fldbun_accum(fldbun, fldbun_accum, count, rc) @@ -1635,8 +1458,8 @@ subroutine med_phases_history_query_ifwrite(clock, alarmname, write_now, rc) end if ! Write diagnostic output - if (mastertask .and. debug_alarms) then - if (write_now) then + if (write_now) then + if (mastertask .and. debug_alarms) then call med_phases_history_output_alarminfo(clock, alarm, alarmname, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return write(logunit,'(a)')' alarmname = '//trim(alarmname)//' is ringing' @@ -1659,37 +1482,56 @@ subroutine med_phases_history_query_ifwrite(clock, alarmname, write_now, rc) end subroutine med_phases_history_query_ifwrite !=============================================================================== - subroutine med_phases_history_set_timeinfo(clock, doavg, alarmname, days_since, time_val, time_bnds, rc) + subroutine med_phases_history_set_timeinfo(gcomp, clock, alarmname, doavg, & + time_val, time_bnds, time_units, histfile, auxname, compname, rc) ! input/output variables - type(ESMF_Clock) , intent(in) :: clock - logical , intent(in) :: doavg - character(len=*) , intent(in) :: alarmname - real(r8) , intent(in) :: days_since - real(r8) , intent(out) :: time_val - real(r8) , intent(out) :: time_bnds(2) - integer , intent(out) :: rc + type(ESMF_GridComp) , intent(in) :: gcomp + type(ESMF_Clock) , intent(in) :: clock + character(len=*) , intent(in) :: alarmname + logical , intent(in) :: doavg + real(r8) , intent(out) :: time_val + real(r8) , intent(out) :: time_bnds(2) + character(len=*) , intent(out) :: time_units + character(len=*) , intent(out) :: histfile + character(len=*) , optional , intent(in) :: auxname + character(len=*) , optional , intent(in) :: compname + integer , intent(out) :: rc ! local variables 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 + 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 !--------------------------------------- rc = ESMF_SUCCESS - ! Get the history file alarm and determine if alarm is ringing - call ESMF_ClockGetAlarm(clock, alarmname=trim(alarmname), alarm=alarm, 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 + + ! 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_ClockGet(clock, currtime=currtime, starttime=starttime, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockGetNextTime(clock, nextTime=nexttime, rc=rc) + call ESMF_ClockGetAlarm(clock, 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 @@ -1701,11 +1543,60 @@ subroutine med_phases_history_set_timeinfo(clock, doavg, alarmname, days_since, if (ChkErr(rc,__LINE__,u_FILE_u)) return time_val = 0.5_r8 * (time_bnds(1) + time_bnds(2)) else - time_val = days_since + 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)') "writing mediator history file "//trim(histfile) + write(logunit,' (a)') "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_restart_mod.F90 b/mediator/med_phases_restart_mod.F90 index d63546663..2d29e1daa 100644 --- a/mediator/med_phases_restart_mod.F90 +++ b/mediator/med_phases_restart_mod.F90 @@ -152,6 +152,7 @@ subroutine med_phases_restart_write(gcomp, rc) 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 @@ -181,7 +182,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 @@ -215,16 +216,12 @@ 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 +230,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 @@ -311,7 +307,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 @@ -348,52 +344,46 @@ 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 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 + call med_io_enddef(restart_file) whead = .false. wdata = .true. endif - if (wdata) 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) 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, wdata, 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, wdata, 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, wdata, 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, wdata, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_write(restart_file, iam, is_local%wrap%FBExpAccumCnt, 'ExpAccumCnt', & - whead=whead, wdata=wdata, rc=rc) + call med_io_write(restart_file, is_local%wrap%FBExpAccumCnt, 'ExpAccumCnt', whead, wdata, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_write(restart_file, iam, is_local%wrap%FBImpAccumCnt, 'ImpAccumCnt', & - whead=whead, wdata=wdata, rc=rc) + call med_io_write(restart_file, is_local%wrap%FBImpAccumCnt, 'ImpAccumCnt', whead, wdata, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return do n = 1,ncomps @@ -407,29 +397,29 @@ subroutine med_phases_restart_write(gcomp, rc) ! 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, wdata, 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, wdata, 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, wdata, nx, ny, & + nt=1, pre=trim(compname(n))//'Frac', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif ! Write export field bundle accumulators ! TODO: only write this out if actually have done accumulation if (ESMF_FieldBundleIsCreated(is_local%wrap%FBExpAccum(n),rc=rc)) then - call med_io_write(restart_file, iam, is_local%wrap%FBExpAccum(n), & + call med_io_write(restart_file, is_local%wrap%FBExpAccum(n), & nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre=trim(compname(n))//'ExpAccum', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif @@ -437,8 +427,8 @@ subroutine med_phases_restart_write(gcomp, rc) ! Write import field bundle accumulators ! TODO: only write this out if actually have done accumulation if (ESMF_FieldBundleIsCreated(is_local%wrap%FBImpAccum(n,n),rc=rc)) then - call med_io_write(restart_file, iam, is_local%wrap%FBImpAccum(n,n), & - nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre=trim(compname(n))//'ImpAccum', rc=rc) + call med_io_write(restart_file, is_local%wrap%FBImpAccum(n,n), whead, wdata, nx, ny, & + nt=1, pre=trim(compname(n))//'ImpAccum', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif endif @@ -448,11 +438,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, wdata, 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, wdata, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -460,19 +449,19 @@ 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, wdata, 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, wdata, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if ! Write ocn albedo field bundle (CESM only) if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o,rc=rc)) then - call med_io_write(restart_file, iam, is_local%wrap%FBMed_ocnalb_o, & - nx=is_local%wrap%nx(compocn), ny=is_local%wrap%ny(compocn), nt=1, & - whead=whead, wdata=wdata, pre='MedOcnAlb_o', rc=rc) + nx = is_local%wrap%nx(compocn) + ny = is_local%wrap%ny(compocn) + call med_io_write(restart_file, is_local%wrap%FBMed_ocnalb_o, whead, wdata, nx, ny, & + nt=1, pre='MedOcnAlb_o', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -482,13 +471,13 @@ subroutine med_phases_restart_write(gcomp, rc) do nc = 2,ncomps do nf = 1,num_auxfiles(nc) if (auxfiles(nc,nf)%doavg .and. auxfiles(nc,nf)%accumcnt > 0) then - call med_io_write(restart_file, iam, auxfiles(nc,nf)%accumcnt, & - trim(compname(nc))//trim(auxfiles(nc,nf)%auxname)//'_accumcnt', & - whead=whead, wdata=wdata, rc=rc) + nx = is_local%wrap%nx(nc) + ny = is_local%wrap%ny(nc) + call med_io_write(restart_file, auxfiles(nc,nf)%FBaccum, whead, wdata, nx, ny, & + nt=1, pre=trim(compname(nc))//trim(auxfiles(nc,nf)%auxname), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_write(restart_file, iam, auxfiles(nc,nf)%FBaccum, & - nx=is_local%wrap%nx(nc), ny=is_local%wrap%ny(nc), nt=1, whead=whead, wdata=wdata, & - pre=trim(compname(nc))//trim(auxfiles(nc,nf)%auxname), rc=rc) + call med_io_write(restart_file, auxfiles(nc,nf)%accumcnt, & + trim(compname(nc))//trim(auxfiles(nc,nf)%auxname)//'_accumcnt', whead, wdata, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if end do @@ -497,7 +486,7 @@ subroutine med_phases_restart_write(gcomp, rc) 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 @@ -627,40 +616,40 @@ subroutine med_phases_restart_read(gcomp, rc) ! Now read in the restart file - call med_io_read(restart_file, vm, iam, is_local%wrap%FBExpAccumCnt, 'ExpAccumCnt', rc=rc) + call med_io_read(restart_file, vm, is_local%wrap%FBExpAccumCnt, 'ExpAccumCnt', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_read(restart_file, vm, iam, is_local%wrap%FBImpAccumCnt, 'ImpAccumCnt', rc=rc) + call med_io_read(restart_file, vm, is_local%wrap%FBImpAccumCnt, 'ImpAccumCnt', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return 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 ! Read export field bundle accumulator if (ESMF_FieldBundleIsCreated(is_local%wrap%FBExpAccum(n),rc=rc)) then - call med_io_read(restart_file, vm, iam, is_local%wrap%FBExpAccum(n), pre=trim(compname(n))//'ExpAccum', rc=rc) + call med_io_read(restart_file, vm, is_local%wrap%FBExpAccum(n), pre=trim(compname(n))//'ExpAccum', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif ! Read import field bundle accumulator if (ESMF_FieldBundleIsCreated(is_local%wrap%FBImpAccum(n,n),rc=rc)) then - call med_io_read(restart_file, vm, iam, is_local%wrap%FBImpAccum(n,n), pre=trim(compname(n))//'ImpAccum', rc=rc) + call med_io_read(restart_file, vm, is_local%wrap%FBImpAccum(n,n), pre=trim(compname(n))//'ImpAccum', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif endif @@ -668,23 +657,23 @@ subroutine med_phases_restart_read(gcomp, rc) ! 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 From 8d07938f7b5f8dfcd75c4e4d1023c73c8b0fd632 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 6 Sep 2021 14:22:42 -0600 Subject: [PATCH 43/61] more cleanup --- mediator/med_phases_history_mod.F90 | 454 ++++++++++++++++------------ 1 file changed, 266 insertions(+), 188 deletions(-) diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 3ca912c0a..dd334ea78 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -52,28 +52,27 @@ module med_phases_history_mod private ! Public routines called from the run sequence - public :: med_phases_history_write ! inst only - public :: med_phases_history_write_med ! inst only - public :: med_phases_history_write_atm ! inst, avg, aux - public :: med_phases_history_write_ice ! inst, avg, aux - public :: med_phases_history_write_glc ! inst, avg, aux - public :: med_phases_history_write_lnd ! inst, avg, aux - public :: med_phases_history_write_ocn ! inst, avg, aux - public :: med_phases_history_write_rof ! inst, avg, aux - public :: med_phases_history_write_wav ! inst, avg, aux + public :: med_phases_history_write ! inst only - for all variables + public :: med_phases_history_write_med ! inst only - for med + + ! Public routines called from post phases + public :: med_phases_history_write_atm ! inst, avg, aux for atm + public :: med_phases_history_write_ice ! inst, avg, aux for ice + public :: med_phases_history_write_glc ! inst, avg, aux for glc + public :: med_phases_history_write_lnd ! inst, avg, aux for lnd + public :: med_phases_history_write_ocn ! inst, avg, aux for ocn + public :: med_phases_history_write_rof ! inst, avg, aux for rof + public :: med_phases_history_write_wav ! inst, avg, aux for wav ! Private routines - private :: med_phases_history_write_inst_comp ! write instantaneous file for a given component - private :: med_phases_history_write_avg_comp ! write averaged file for a given component - private :: med_phases_history_write_aux_comp ! write auxiliary file for a given component - private :: med_phases_history_write_hfile - private :: med_phases_history_write_hfileaux - private :: med_phases_history_get_auxflds + private :: med_phases_history_write_inst_comp ! write instantaneous file for a given component + private :: med_phases_history_write_avg_comp ! write averaged file for a given component + private :: med_phases_history_write_aux_comp ! write auxiliary file for a given component + private :: med_phases_history_write_hfile_inst ! write instantaneous history (either for all or for a component) + private :: med_phases_history_write_hfile_avg + private :: med_phases_history_write_hfile_aux private :: med_phases_history_output_alarminfo - character(CL) :: case_name = 'unset' ! case name - character(CS) :: inst_tag = 'unset' ! instance tag - ! ---------------------------- ! Time averaging history files ! ---------------------------- @@ -114,6 +113,8 @@ module med_phases_history_mod type(ESMF_Clock) :: hclock_inst_all type(ESMF_Clock) :: hclock_inst_comp(ncomps) + character(CL) :: case_name = 'unset' ! case name + character(CS) :: inst_tag = 'unset' ! instance tag logical :: debug_alarms = .true. character(*), parameter :: u_FILE_u = & __FILE__ @@ -207,7 +208,7 @@ subroutine med_phases_history_write(gcomp, rc) end if ! Write the instantaneous history file for all relevant components - call med_phases_history_write_hfile(gcomp, 'all', hclock_inst_all, 'alarm_history_inst_all', .false., rc) + call med_phases_history_write_hfile_inst(gcomp, 'all', hclock_inst_all, 'alarm_history_inst_all', rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -468,8 +469,8 @@ subroutine med_phases_history_write_inst_comp(gcomp, compid, first_time, subname if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Write the instantaneous history file - call med_phases_history_write_hfile(gcomp, trim(compname(compid)), hclock_inst_comp(compid), & - trim(alarmname), .false., rc) + call med_phases_history_write_hfile_inst(gcomp, trim(compname(compid)), hclock_inst_comp(compid), & + trim(alarmname), rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -598,8 +599,8 @@ subroutine med_phases_history_write_avg_comp(gcomp, compid, first_time, subname, if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Write history file - call med_phases_history_write_hfile(gcomp, trim(compname(compid)), hclock_avg_comp(compid), & - trim(alarmname), .true., rc) + call med_phases_history_write_hfile_avg(gcomp, trim(compname(compid)), hclock_avg_comp(compid), & + trim(alarmname), rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if call t_stopf('MED:'//subname) @@ -712,7 +713,7 @@ subroutine med_phases_history_write_aux_comp(gcomp, compid, first_time, subname, ! Translate the colon deliminted string (auxflds) into a character array (fieldnamelist) ! Note that the following call allocates the memory for fieldnamelist - call med_phases_history_get_auxflds(auxflds, fieldnamelist, rc) + 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 @@ -845,15 +846,81 @@ subroutine med_phases_history_write_aux_comp(gcomp, compid, first_time, subname, if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Write auxiliary file(s) - call med_phases_history_write_hfileaux(gcomp, n, compid, auxfiles(n,compid), rc=rc) + call med_phases_history_write_hfile_aux(gcomp, n, compid, auxfiles(n,compid), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return 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_aux_comp !=============================================================================== - subroutine med_phases_history_write_hfile(gcomp, comptype, hclock, alarmname, doavg, rc) + subroutine med_phases_history_write_hfile_inst(gcomp, comptype, hclock, alarmname, rc) use med_methods_mod , only : med_methods_FB_reset use med_constants_mod , only : czero => med_constants_czero @@ -864,7 +931,6 @@ subroutine med_phases_history_write_hfile(gcomp, comptype, hclock, alarmname, do character(len=*) , intent(in) :: comptype type(ESMF_Clock) , intent(in) :: hclock character(len=*) , intent(in) :: alarmname - logical , intent(in) :: doavg integer , intent(out) :: rc ! local variables @@ -894,40 +960,169 @@ subroutine med_phases_history_write_hfile(gcomp, comptype, hclock, alarmname, do call med_phases_history_query_ifwrite(hclock, alarmname, write_now, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! If averaging history output then accumulate and then average if write_now flag is true - if (doavg) then - do n = 1,ncomps - if (comptype == 'all' .or. comptype == trim(compname(n))) then - if (ESMF_FieldBundleIsCreated(avgfiles_import(n)%FBaccum)) then - call med_phases_history_fldbun_accum(is_local%wrap%FBImp(n,n), avgfiles_import(n)%FBaccum, & - avgfiles_import(n)%accumcnt, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (write_now) then - call med_phases_history_fldbun_average(avgfiles_import(n)%FBaccum, & - avgfiles_import(n)%accumcnt, rc=rc) + ! 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, hclock, alarmname, & + time_val, time_bnds, time_units, hist_file, doavg=.false., compname=comptype, 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 + if (m == 1) then + whead = .true. + wdata = .false. + else if (m == 2) then + call med_io_enddef(hist_file) + whead = .false. + wdata = .true. + end if + + ! Write time values + if (whead) then + call ESMF_ClockGet(hclock, 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 + + ! Write import and export field bundles + do n = 2,ncomps ! skip the mediator here + if (comptype == 'all' .or. comptype == trim(compname(n))) then + if (is_local%wrap%comp_present(n)) then + nx = is_local%wrap%nx(n) + ny = is_local%wrap%ny(n) + 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, wdata, nx, ny, & + 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, wdata, nx, ny, & + nt=1, pre=trim(compname(n))//'Exp', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + endif + end if + end do + + ! Write mediator fractions + ! Also write atm/ocn fluxes and ocean albedoes if field bundles are created + if (comptype == 'all' .or. comptype == 'med') then + do n = 2,ncomps ! skip the mediator here + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBFrac(n),rc=rc)) then + call med_io_write(hist_file, is_local%wrap%FBFrac(n), whead, wdata, & + 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 + end do + 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, wdata, & + 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, wdata, & + 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, wdata, & + 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, wdata, & + is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_aoflux_atm', rc=rc) + end if + 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 subroutine med_phases_history_write_hfile_inst + + !=============================================================================== + subroutine med_phases_history_write_hfile_avg(gcomp, comptype, hclock, alarmname, rc) + + use med_methods_mod , only : med_methods_FB_reset + use med_constants_mod , only : czero => med_constants_czero + use med_io_mod , only : med_io_write_time, med_io_define_time + + ! input/output variables + type(ESMF_GridComp) , intent(inout) :: gcomp + character(len=*) , intent(in) :: comptype + type(ESMF_Clock) , intent(in) :: hclock + character(len=*) , intent(in) :: alarmname + integer , intent(out) :: rc + + ! local variables + 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 :: whead,wdata ! for writing restart/history cdf files + logical :: write_now ! true => write to history type + real(r8) :: tbnds(2) ! CF1.0 time bounds + character(len=*), parameter :: subname='(med_phases_history_write_hfile)' + !--------------------------------------- + + 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 + + ! Determine if will write to history file + call med_phases_history_query_ifwrite(hclock, alarmname, write_now, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! If averaging history output then accumulate and then average if write_now flag is true + do n = 1,ncomps + if (comptype == 'all' .or. comptype == trim(compname(n))) then + if (ESMF_FieldBundleIsCreated(avgfiles_import(n)%FBaccum)) then + call med_phases_history_fldbun_accum(is_local%wrap%FBImp(n,n), avgfiles_import(n)%FBaccum, & + avgfiles_import(n)%accumcnt, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (write_now) then + call med_phases_history_fldbun_average(avgfiles_import(n)%FBaccum, & + avgfiles_import(n)%accumcnt, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - if (ESMF_FieldBundleIsCreated(avgfiles_export(n)%FBaccum)) then - call med_phases_history_fldbun_accum(is_local%wrap%FBExp(n), avgfiles_export(n)%FBaccum, & - avgfiles_export(n)%accumcnt, rc=rc) + end if + if (ESMF_FieldBundleIsCreated(avgfiles_export(n)%FBaccum)) then + call med_phases_history_fldbun_accum(is_local%wrap%FBExp(n), avgfiles_export(n)%FBaccum, & + avgfiles_export(n)%accumcnt, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (write_now) then + call med_phases_history_fldbun_average(avgfiles_export(n)%FBaccum, & + avgfiles_export(n)%accumcnt, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (write_now) then - call med_phases_history_fldbun_average(avgfiles_export(n)%FBaccum, & - avgfiles_export(n)%accumcnt, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if end if end if - end do - end if + end if + end do ! 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, hclock, alarmname, doavg, & - time_val, time_bnds, time_units, hist_file, compname=comptype, rc=rc) + call med_phases_history_set_timeinfo(gcomp, hclock, alarmname, & + time_val, time_bnds, time_units, hist_file, doavg=.true., compname=comptype, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Create history file @@ -962,80 +1157,38 @@ subroutine med_phases_history_write_hfile(gcomp, comptype, hclock, alarmname, do nx = is_local%wrap%nx(n) ny = is_local%wrap%ny(n) if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(n,n),rc=rc)) then - if (doavg) then - call med_io_write(hist_file, avgfiles_import(n)%FBaccum, whead, wdata, nx, ny, & - nt=1, pre=trim(compname(n))//'Imp', rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (wdata) then - call med_methods_FB_reset(avgfiles_import(n)%FBAccum, czero, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end if - else - call med_io_write(hist_file, is_local%wrap%FBimp(n,n), whead, wdata, nx, ny, & - nt=1, pre=trim(compname(n))//'Imp', rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_io_write(hist_file, avgfiles_import(n)%FBaccum, whead, wdata, nx, ny, & + nt=1, pre=trim(compname(n))//'Imp', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (wdata) then + call med_methods_FB_reset(avgfiles_import(n)%FBAccum, 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 - if (doavg) then - call med_io_write(hist_file, avgfiles_export(n)%FBaccum, whead, wdata, nx, ny, & - nt=1, pre=trim(compname(n))//'Exp', rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (wdata) then - call med_methods_FB_reset(avgfiles_export(n)%FBAccum, czero, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end if - else - call med_io_write(hist_file, is_local%wrap%FBexp(n), whead, wdata, nx, ny, & - nt=1, pre=trim(compname(n))//'Exp', rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_io_write(hist_file, avgfiles_export(n)%FBaccum, whead, wdata, nx, ny, & + nt=1, pre=trim(compname(n))//'Exp', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (wdata) then + call med_methods_FB_reset(avgfiles_export(n)%FBAccum, czero, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return end if endif endif end if end do - - ! Write mediator fractions - ! Also write atm/ocn fluxes and ocean albedoes if field bundles are created - if (.not. doavg) then - if (comptype == 'all' .or. comptype == 'med') then - do n = 2,ncomps ! skip the mediator here - if (ESMF_FieldBundleIsCreated(is_local%wrap%FBFrac(n),rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBFrac(n), whead, wdata, & - 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 - end do - 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, wdata, & - 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, wdata, & - 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, wdata, & - 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, wdata, & - is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_aoflux_atm', rc=rc) - end if - end if - 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 subroutine med_phases_history_write_hfile + end subroutine med_phases_history_write_hfile_avg !=============================================================================== - subroutine med_phases_history_write_hfileaux(gcomp, nfile_index, comp_index, auxfile, rc) + subroutine med_phases_history_write_hfile_aux(gcomp, nfile_index, comp_index, auxfile, rc) use med_constants_mod, only : czero => med_constants_czero use med_io_mod , only : med_io_write_time, med_io_define_time @@ -1096,8 +1249,8 @@ subroutine med_phases_history_write_hfileaux(gcomp, nfile_index, comp_index, aux 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, auxfile%hclock, auxfile%alarmname, auxfile%doavg, & - time_val, time_bnds, time_units, auxfile%histfile, auxname=auxfile%auxname, rc=rc) + call med_phases_history_set_timeinfo(gcomp, auxfile%hclock, auxfile%alarmname, & + time_val, time_bnds, time_units, auxfile%histfile, auxfile%doavg, auxname=auxfile%auxname, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Set shorthand variables @@ -1156,82 +1309,7 @@ subroutine med_phases_history_write_hfileaux(gcomp, nfile_index, comp_index, aux end if ! end of write_now if-block - end subroutine med_phases_history_write_hfileaux - - !=============================================================================== - subroutine med_phases_history_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 med_phases_history_get_auxflds + end subroutine med_phases_history_write_hfile_aux !=============================================================================== subroutine med_phases_history_output_alarminfo(mclock, alarm, alarmname, rc) @@ -1482,18 +1560,18 @@ subroutine med_phases_history_query_ifwrite(clock, alarmname, write_now, rc) end subroutine med_phases_history_query_ifwrite !=============================================================================== - subroutine med_phases_history_set_timeinfo(gcomp, clock, alarmname, doavg, & - time_val, time_bnds, time_units, histfile, auxname, compname, rc) + subroutine med_phases_history_set_timeinfo(gcomp, clock, alarmname, & + time_val, time_bnds, time_units, histfile, doavg, auxname, compname, rc) ! input/output variables type(ESMF_GridComp) , intent(in) :: gcomp type(ESMF_Clock) , intent(in) :: clock character(len=*) , intent(in) :: alarmname - logical , intent(in) :: doavg 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 From 4c291c4e2d248666a0d767caf40a1de85b2bf612 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 6 Sep 2021 20:51:19 -0600 Subject: [PATCH 44/61] refactored different write phases to use module datatypes --- mediator/med_phases_history_mod.F90 | 1445 +++++++++++++++------------ 1 file changed, 802 insertions(+), 643 deletions(-) diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index dd334ea78..5be071f19 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -68,25 +68,42 @@ module med_phases_history_mod private :: med_phases_history_write_inst_comp ! write instantaneous file for a given component private :: med_phases_history_write_avg_comp ! write averaged file for a given component private :: med_phases_history_write_aux_comp ! write auxiliary file for a given component - private :: med_phases_history_write_hfile_inst ! write instantaneous history (either for all or for a component) - private :: med_phases_history_write_hfile_avg - private :: med_phases_history_write_hfile_aux + private :: med_phases_history_query_ifwrite + private :: med_phases_history_set_timeinfo private :: med_phases_history_output_alarminfo + 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 + end type instfile_type + type(instfile_type) , public :: instfiles(ncomps) + type(instfile_type) , public :: instfile_all ! ---------------------------- ! Time averaging history files ! ---------------------------- type, public :: avgfile_type - type(ESMF_FieldBundle) :: FBaccum ! field bundle for time averaging - integer :: accumcnt ! field bundle accumulation counter + 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 end type avgfile_type - type(avgfile_type) :: avgfiles_import(ncomps) - type(avgfile_type) :: avgfiles_export(ncomps) - type(avgfile_type) :: avgfiles_aoflux_ocn - type(avgfile_type) :: avgfiles_ocnalb_ocn - type(avgfile_type) :: avgfiles_aoflux_atm - type(avgfile_type) :: avgfiles_ocnalb_atm - type(ESMF_Clock) :: hclock_avg_comp(ncomps) + type(avgfile_type) :: avgfiles(ncomps) ! ---------------------------- ! Auxiliary history files @@ -96,23 +113,18 @@ module med_phases_history_mod character(CS), allocatable :: flds(:) ! array of aux field names character(CS) :: auxname ! name for history file creation character(CL) :: histfile = '' ! current history file name - character(CS) :: alarmname ! name of write alarm integer :: ntperfile ! maximum number of time samples per file integer :: nt = 0 ! time in file - logical :: doavg ! if true, time average, otherwise instantaneous + 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) :: hclock ! auxiliary history clock + 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 , public :: num_auxfiles(ncomps) = 0 type(auxfile_type) , public :: auxfiles(max_auxfiles,ncomps) - ! ---------------------------- - ! Instantaneous history files - ! ---------------------------- - type(ESMF_Clock) :: hclock_inst_all - type(ESMF_Clock) :: hclock_inst_comp(ncomps) - character(CL) :: case_name = 'unset' ! case name character(CS) :: inst_tag = 'unset' ! instance tag logical :: debug_alarms = .true. @@ -124,34 +136,52 @@ module med_phases_history_mod !=============================================================================== subroutine med_phases_history_write(gcomp, rc) + ! -------------------------------------- ! Write instantaneous mediator history file for all variables ! -------------------------------------- + use med_io_mod, only : med_io_write_time, med_io_define_time + ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc ! local variables - character(CL) :: alarmname - type(ESMF_Clock) :: mclock - type(ESMF_Alarm) :: alarm - type(ESMF_Time) :: CurrTime - type(ESMF_Time) :: StartTime - type(ESMF_TimeInterval) :: timestep - integer :: timestep_length - 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 - logical :: first_time = .true. + type(InternalState) :: is_local + type(ESMF_Clock) :: mclock + type(ESMF_Time) :: CurrTime + type(ESMF_Time) :: StartTime + type(ESMF_TimeInterval) :: timestep + integer :: timestep_length + 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 :: whead,wdata ! for writing restart/history cdf files + logical :: write_now ! true => write to history type + real(r8) :: tbnds(2) ! CF1.0 time bounds + logical :: first_time = .true. character(len=*), parameter :: subname='(med_phases_history_write)' !--------------------------------------- + rc = ESMF_SUCCESS call t_startf('MED:'//subname) - alarmname = 'alarm_history_inst_all' + ! Get the internal state + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, 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 @@ -168,23 +198,27 @@ subroutine med_phases_history_write(gcomp, rc) end if if (hist_option /= 'none' .and. hist_option /= 'never') then - ! First create hclock from mclock - THIS CALL DOES NOT COPY ALARMS + + ! Create instfile_all%clock from mclock - THIS CALL DOES NOT COPY ALARMS call NUOPC_ModelGet(gcomp, modelClock=mclock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - hclock_inst_all = ESMF_ClockCreate(mclock, rc=rc) + instfile_all%clock = ESMF_ClockCreate(mclock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Set alarm name + instfile_all%alarmname = 'alarm_history_inst_all' + ! Set alarm for instantaneous history output ! Advance history clock to trigger alarms then reset history clock back to mcurrtime - call ESMF_ClockGet(hclock_inst_all, startTime=StartTime, currTime=CurrTime, timeStep=timestep, rc=rc) + call ESMF_ClockGet(instfile_all%clock, startTime=StartTime, currTime=CurrTime, timeStep=timestep, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_time_alarmInit(hclock_inst_all, alarm, option=hist_option, opt_n=hist_n, & - reftime=StartTime, alarmname=trim(alarmname), rc=rc) - call ESMF_AlarmSet(alarm, clock=hclock_inst_all, rc=rc) + call med_time_alarmInit(instfile_all%clock, instfile_all%alarm, option=hist_option, opt_n=hist_n, & + reftime=StartTime, alarmname=trim(instfile_all%alarmname), rc=rc) + call ESMF_AlarmSet(instfile_all%alarm, clock=instfile_all%clock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockAdvance(hclock_inst_all,rc=rc) + call ESMF_ClockAdvance(instfile_all%clock,rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockSet(hclock_inst_all, currTime=currtime) + call ESMF_ClockSet(instfile_all%clock, currTime=currtime) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Write diagnostic info @@ -192,7 +226,7 @@ subroutine med_phases_history_write(gcomp, rc) call ESMF_TimeIntervalGet(timestep, s=timestep_length, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return write(logunit,'(a,2x,i8)') " initialized instantaneous history alarm "//& - trim(alarmname)//" with option "//trim(hist_option)//" and frequency ",hist_n + trim(instfile_all%alarmname)//" with option "//trim(hist_option)//" and frequency ",hist_n write(logunit,'(a,2x,i8)') " history clock timestep = ",timestep_length end if end if @@ -200,16 +234,101 @@ subroutine med_phases_history_write(gcomp, rc) first_time = .false. end if - if (ESMF_ClockIsCreated(hclock_inst_all)) then + if (ESMF_ClockIsCreated(instfile_all%clock)) then + if (.not. first_time) then ! Advance the clock - call ESMF_ClockAdvance(hclock_inst_all, rc=rc) + call ESMF_ClockAdvance(instfile_all%clock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if ! Write the instantaneous history file for all relevant components - call med_phases_history_write_hfile_inst(gcomp, 'all', hclock_inst_all, 'alarm_history_inst_all', rc) + ! Determine if will write to history file + call med_phases_history_query_ifwrite(instfile_all%clock, instfile_all%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, instfile_all%clock, instfile_all%alarmname, & + time_val, time_bnds, time_units, hist_file, doavg=.false., compname='all', 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 + if (m == 1) then + whead = .true. + wdata = .false. + else if (m == 2) then + call med_io_enddef(hist_file) + whead = .false. + wdata = .true. + end if + + ! Write time values + if (whead) then + call ESMF_ClockGet(instfile_all%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_time(time_val, time_bnds, nt=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + ! Write import and export field bundles and mediator fields + do n = 2,ncomps ! skip the mediator here + if (is_local%wrap%comp_present(n)) then + nx = is_local%wrap%nx(n) + ny = is_local%wrap%ny(n) + 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, wdata, nx, ny, & + 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, wdata, nx, ny, & + nt=1, pre=trim(compname(n))//'Exp', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + end if + ! Write mediator fractions + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBFrac(n),rc=rc)) then + call med_io_write(hist_file, is_local%wrap%FBFrac(n), whead, wdata, & + 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 + 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, wdata, & + 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, wdata, & + 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, wdata, & + 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, wdata, & + is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_aoflux_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 write_now if-block end if call t_stopf('MED:'//subname) @@ -221,16 +340,168 @@ subroutine med_phases_history_write_med(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 + + use med_io_mod, only : med_io_write_time, med_io_define_time + ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc - logical :: first_time = .true. + + ! local variables + 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 :: whead,wdata ! for writing restart/history cdf files + logical :: write_now ! true => write to history type + real(r8) :: tbnds(2) ! CF1.0 time bounds + type(ESMF_Clock) :: mclock + type(ESMF_Time) :: CurrTime + type(ESMF_Time) :: StartTime + 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 + logical :: first_time = .true. + character(len=*), parameter :: subname='(med_phases_history_write_med)' !--------------------------------------- rc = ESMF_SUCCESS - call med_phases_history_write_inst_comp(gcomp, compmed, & - first_time, 'med_phases_history_write_inst_med', rc) + + ! Get the internal state + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (first_time) first_time = .false. + + if (first_time) 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 + + if (hist_option /= 'none' .and. hist_option /= 'never') then + + ! Set alarm name + instfiles(compmed)%alarmname = 'alarm_history_inst_med' + + ! Set alarm for instantaneous history output + ! Advance history clock to trigger alarms then reset history clock back to mcurrtime + call ESMF_ClockGet(instfiles(compmed)%clock, startTime=StartTime, currTime=CurrTime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_time_alarmInit(instfiles(compmed)%clock, instfiles(compmed)%alarm, option=hist_option, opt_n=hist_n, & + reftime=StartTime, alarmname=instfiles(compmed)%alarmname, rc=rc) + call ESMF_AlarmSet(instfiles(compmed)%alarm, clock=instfiles(compmed)%clock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockAdvance(instfiles(compmed)%clock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockSet(instfiles(compmed)%clock, currTime=currtime) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Write diagnostic info + if (mastertask) then + write(logunit,'(a,2x,i8)') trim(subname)//" initialized instantaneous history alarm "//& + trim(instfiles(compmed)%alarmname)//" with option "//trim(hist_option)//" and frequency ",hist_n + end if + + end if + end if + + if (ESMF_ClockIsCreated(instfiles(compmed)%clock)) then + + call ESMF_ClockGet(mclock, currTime=CurrTime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockSet(instfiles(compmed)%clock, currTime=currtime) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockAdvance(instfiles(compmed)%clock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockSet(instfiles(compmed)%clock, currTime=currtime) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Determine if will write to history file + call med_phases_history_query_ifwrite(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 + if (m == 1) then + whead = .true. + wdata = .false. + else if (m == 2) then + call med_io_enddef(hist_file) + whead = .false. + wdata = .true. + end if + + ! Write time values + if (whead) 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_write_time(time_val, time_bnds, nt=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + ! Write fields 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, wdata, & + 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, wdata, & + 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, wdata, & + 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, wdata, & + is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_aoflux_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 write_now if-block + end if ! end of clockiscreated if-block + end subroutine med_phases_history_write_med !=============================================================================== @@ -241,13 +512,13 @@ subroutine med_phases_history_write_atm(gcomp, rc) logical :: first_time = .true. !--------------------------------------- rc = ESMF_SUCCESS - call med_phases_history_write_inst_comp(gcomp, compatm, & + call med_phases_history_write_inst_comp(gcomp, compatm, instfiles(compatm), & first_time, 'med_phases_history_write_inst_atm', rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_write_avg_comp(gcomp, compatm, & + call med_phases_history_write_avg_comp(gcomp, compatm, avgfiles(compatm), & first_time, 'med_phases_history_write_avg_atm', rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_write_aux_comp(gcomp, compatm, & + call med_phases_history_write_aux_comp(gcomp, compatm, auxfiles(:,compatm), & first_time, 'med_phases_history_write_aux_atm', rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (first_time) first_time = .false. @@ -261,13 +532,13 @@ subroutine med_phases_history_write_ice(gcomp, rc) logical :: first_time = .true. !--------------------------------------- rc = ESMF_SUCCESS - call med_phases_history_write_inst_comp(gcomp, compice, & + call med_phases_history_write_inst_comp(gcomp, compice, instfiles(compice), & first_time, 'med_phases_history_write_inst_ice', rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_write_avg_comp(gcomp, compice, & + call med_phases_history_write_avg_comp(gcomp, compice, avgfiles(compice), & first_time, 'med_phases_history_write_avg_ice', rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_write_aux_comp(gcomp, compice, & + call med_phases_history_write_aux_comp(gcomp, compice, auxfiles(:,compice), & first_time, 'med_phases_history_write_aux_ice', rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (first_time) first_time = .false. @@ -285,13 +556,13 @@ subroutine med_phases_history_write_glc(gcomp, rc) rc = ESMF_SUCCESS do ns = 1,num_icesheets write(cns,*) ns - call med_phases_history_write_inst_comp(gcomp, compglc(ns), & + call med_phases_history_write_inst_comp(gcomp, compglc(ns), instfiles(compglc(ns)), & first_time, 'med_phases_history_write_inst_glc'//trim(cns), rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_write_avg_comp(gcomp, compglc(ns), & + call med_phases_history_write_avg_comp(gcomp, compglc(ns), avgfiles(compglc(ns)), & first_time, 'med_phases_history_write_avg_glc'//trim(cns), rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_write_aux_comp(gcomp, compglc(ns), & + call med_phases_history_write_aux_comp(gcomp, compglc(ns), auxfiles(:,compglc(ns)), & first_time, 'med_phases_history_write_aux_glc'//trim(cns), rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end do @@ -306,13 +577,13 @@ subroutine med_phases_history_write_lnd(gcomp, rc) logical :: first_time = .true. !--------------------------------------- rc = ESMF_SUCCESS - call med_phases_history_write_inst_comp(gcomp, complnd, & + call med_phases_history_write_inst_comp(gcomp, complnd, instfiles(complnd), & first_time, 'med_phases_history_write_inst_lnd', rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_write_avg_comp(gcomp, complnd, & + call med_phases_history_write_avg_comp(gcomp, complnd, avgfiles(complnd), & first_time, 'med_phases_history_write_avg_lnd', rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_write_aux_comp(gcomp, complnd, & + call med_phases_history_write_aux_comp(gcomp, complnd, auxfiles(:,complnd), & first_time, 'med_phases_history_write_aux_lnd', rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (first_time) first_time = .false. @@ -326,13 +597,13 @@ subroutine med_phases_history_write_ocn(gcomp, rc) logical :: first_time = .true. !--------------------------------------- rc = ESMF_SUCCESS - call med_phases_history_write_inst_comp(gcomp, compocn, & + call med_phases_history_write_inst_comp(gcomp, compocn, instfiles(compocn), & first_time, 'med_phases_history_write_inst_ocn', rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_write_avg_comp(gcomp, compocn, & + call med_phases_history_write_avg_comp(gcomp, compocn, avgfiles(compocn), & first_time, 'med_phases_history_write_avg_ocn', rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_write_aux_comp(gcomp, compocn, & + call med_phases_history_write_aux_comp(gcomp, compocn, auxfiles(:,compocn), & first_time, 'med_phases_history_write_aux_ocn', rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (first_time) first_time = .false. @@ -346,13 +617,13 @@ subroutine med_phases_history_write_rof(gcomp, rc) logical :: first_time = .true. !--------------------------------------- rc = ESMF_SUCCESS - call med_phases_history_write_inst_comp(gcomp, comprof, & + call med_phases_history_write_inst_comp(gcomp, comprof, instfiles(comprof), & first_time, 'med_phases_history_write_inst_rof', rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_write_avg_comp(gcomp, comprof, & + call med_phases_history_write_avg_comp(gcomp, comprof, avgfiles(comprof), & first_time, 'med_phases_history_write_avg_rof', rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_write_aux_comp(gcomp, comprof, & + call med_phases_history_write_aux_comp(gcomp, comprof, auxfiles(:,comprof), & first_time, 'med_phases_history_write_aux_rof', rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (first_time) first_time = .false. @@ -366,57 +637,75 @@ subroutine med_phases_history_write_wav(gcomp, rc) logical :: first_time = .true. !--------------------------------------- rc = ESMF_SUCCESS - call med_phases_history_write_inst_comp(gcomp, compwav, & + call med_phases_history_write_inst_comp(gcomp, compwav, instfiles(compwav), & first_time, 'med_phases_history_write_inst_wav', rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_write_avg_comp(gcomp, compwav, & + call med_phases_history_write_avg_comp(gcomp, compwav, avgfiles(compwav), & first_time, 'med_phases_history_write_avg_wav', rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_write_aux_comp(gcomp, compwav, & + call med_phases_history_write_aux_comp(gcomp, compwav, auxfiles(:,compwav), & first_time, 'med_phases_history_write_aux_wav', rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (first_time) first_time = .false. end subroutine med_phases_history_write_wav !=============================================================================== - subroutine med_phases_history_write_inst_comp(gcomp, compid, first_time, subname, rc) + subroutine med_phases_history_write_inst_comp(gcomp, compid, instfile, first_time, subname, rc) + ! Write instantaneous mediator history file for component compid + use med_io_mod, only : med_io_write_time, med_io_define_time + ! input/output variables type(ESMF_GridComp) , intent(inout) :: gcomp integer , intent(in) :: compid logical , intent(in) :: first_time + type(instfile_type) , intent(inout) :: instfile character(len=*) , intent(in) :: subname integer , intent(out) :: rc ! local variables - character(CL) :: alarmname - type(ESMF_Clock) :: mclock - type(ESMF_Alarm) :: alarm - type(ESMF_Time) :: CurrTime - type(ESMF_Time) :: StartTime - 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 - character(CL) :: cvalue ! attribute string - logical :: isPresent - logical :: isSet + type(InternalState) :: is_local + type(ESMF_Clock) :: mclock + type(ESMF_Time) :: CurrTime + type(ESMF_Time) :: StartTime + 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 :: whead,wdata ! for writing restart/history cdf files + logical :: write_now ! true => write to history type + real(r8) :: tbnds(2) ! CF1.0 time bounds !--------------------------------------- + rc = ESMF_SUCCESS call t_startf('MED:'//subname) - alarmname = 'alarm_history_inst_'//trim(compname(compid)) - call NUOPC_ModelGet(gcomp, modelClock=mclock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (first_time) 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 ! 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 @@ -433,45 +722,111 @@ subroutine med_phases_history_write_inst_comp(gcomp, compid, first_time, subname end if if (hist_option /= 'none' .and. hist_option /= 'never') then - ! First create hclock from mclock - THIS CALL DOES NOT COPY ALARMS - hclock_inst_comp(compid) = ESMF_ClockCreate(mclock, rc=rc) + + ! Set alarm name + instfile%alarmname = 'alarm_history_inst_'//trim(compname(compid)) + + ! First create instfile%clock from mclock - THIS CALL DOES NOT COPY ALARMS + instfile%clock = ESMF_ClockCreate(mclock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Set alarm for instantaneous history output ! Advance history clock to trigger alarms then reset history clock back to mcurrtime - call ESMF_ClockGet(hclock_inst_comp(compid), startTime=StartTime, currTime=CurrTime, rc=rc) + call ESMF_ClockGet(instfile%clock, startTime=StartTime, currTime=CurrTime, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_time_alarmInit(hclock_inst_comp(compid), alarm, option=hist_option, opt_n=hist_n, & - reftime=StartTime, alarmname=trim(alarmname), rc=rc) - call ESMF_AlarmSet(alarm, clock=hclock_inst_comp(compid), rc=rc) + call med_time_alarmInit(instfile%clock, instfile%alarm, option=hist_option, opt_n=hist_n, & + reftime=StartTime, alarmname=trim(instfile%alarmname), rc=rc) + call ESMF_AlarmSet(instfile%alarm, clock=instfile%clock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockAdvance(hclock_inst_comp(compid),rc=rc) + call ESMF_ClockAdvance(instfile%clock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockSet(hclock_inst_comp(compid), currTime=currtime) + call ESMF_ClockSet(instfile%clock, currTime=currtime) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Write diagnostic info if (mastertask) then write(logunit,'(a,2x,i8)') trim(subname)//" initialized instantaneous history alarm "//& - trim(alarmname)//" with option "//trim(hist_option)//" and frequency ",hist_n + trim(instfile%alarmname)//" with option "//trim(hist_option)//" and frequency ",hist_n end if end if - end if + end if ! end of first_time if-block + + if (ESMF_ClockIsCreated(instfile%clock)) then - if (ESMF_ClockIsCreated(hclock_inst_comp(compid))) then + ! Update clock to trigger alarm call ESMF_ClockGet(mclock, currTime=CurrTime, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockSet(hclock_inst_comp(compid), currTime=currtime) + call ESMF_ClockSet(instfile%clock, currTime=currtime) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockAdvance(hclock_inst_comp(compid),rc=rc) + call ESMF_ClockAdvance(instfile%clock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockSet(hclock_inst_comp(compid), currTime=currtime) + call ESMF_ClockSet(instfile%clock, currTime=currtime) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Write the instantaneous history file - call med_phases_history_write_hfile_inst(gcomp, trim(compname(compid)), hclock_inst_comp(compid), & - trim(alarmname), rc) + ! Determine if should write to history file + call med_phases_history_query_ifwrite(instfile%clock, instfile%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, 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 + if (m == 1) then + whead = .true. + wdata = .false. + else if (m == 2) then + call med_io_enddef(hist_file) + whead = .false. + wdata = .true. + end if + + ! Write time values + if (whead) 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_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, wdata, 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, wdata, 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, wdata, 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 call t_stopf('MED:'//subname) @@ -479,24 +834,26 @@ subroutine med_phases_history_write_inst_comp(gcomp, compid, first_time, subname end subroutine med_phases_history_write_inst_comp !=============================================================================== - subroutine med_phases_history_write_avg_comp(gcomp, compid, first_time, subname, rc) + subroutine med_phases_history_write_avg_comp(gcomp, compid, avgfile, first_time, subname, rc) ! Write mediator average history file variables for component compid - use med_constants_mod, only : czero => med_constants_czero + 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 ! input/output variables type(ESMF_GridComp) , intent(inout) :: gcomp integer , intent(in) :: compid + type(avgfile_type) , intent(inout) :: avgfile logical , intent(in) :: first_time character(len=*) , intent(in) :: subname integer , intent(out) :: rc + ! local variables - integer :: n - character(CL) :: alarmname type(InternalState) :: is_local type(ESMF_Clock) :: mclock - type(ESMF_Alarm) :: alarm type(ESMF_Time) :: CurrTime type(ESMF_Time) :: StartTime character(CL) :: cvalue ! attribute string @@ -506,19 +863,29 @@ subroutine med_phases_history_write_avg_comp(gcomp, compid, first_time, subname, 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 :: whead,wdata ! for writing restart/history cdf files + logical :: write_now ! true => write to history type + real(r8) :: tbnds(2) ! CF1.0 time bounds + character(CS) :: scalar_name !--------------------------------------- rc = ESMF_SUCCESS - call t_startf('MED:'//subname) - ! Set alarm name - alarmname = 'alarm_history_avg_'//trim(compname(compid)) + call t_startf('MED:'//subname) nullify(is_local%wrap) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! First create hclock from mclock - THIS CALL DOES NOT COPY ALARMS + ! Obtain model clock call NUOPC_ModelGet(gcomp, modelClock=mclock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -541,97 +908,194 @@ subroutine med_phases_history_write_avg_comp(gcomp, compid, first_time, subname, hist_option = 'none' hist_n = -999 end if + ! Create time average field bundles (module variables) if (hist_option /= 'never' .and. hist_option /= 'none') then - hclock_avg_comp(compid) = ESMF_ClockCreate(mclock, rc=rc) + ! Determine alarm name + avgfile%alarmname = 'alarm_history_avg_'//trim(compname(compid)) + + ! Create clock from mclock - THIS CALL DOES NOT COPY ALARMS + avgfile%clock = ESMF_ClockCreate(mclock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Set alarm for time averaged history output ! Advance history clock to trigger alarms then reset history clock back to mcurrtime - call ESMF_ClockGet(hclock_avg_comp(compid), startTime=StartTime, currTime=CurrTime, rc=rc) + call ESMF_ClockGet(avgfile%clock, startTime=StartTime, currTime=CurrTime, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_time_alarmInit(hclock_avg_comp(compid), alarm, option=hist_option, opt_n=hist_n, & - reftime=StartTime, alarmname=trim(alarmname), rc=rc) - call ESMF_AlarmSet(alarm, clock=hclock_avg_comp(compid), rc=rc) + call med_time_alarmInit(avgfile%clock, avgfile%alarm, option=hist_option, opt_n=hist_n, & + reftime=StartTime, alarmname=trim(avgfile%alarmname), rc=rc) + call ESMF_AlarmSet(avgfile%alarm, clock=avgfile%clock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockAdvance(hclock_avg_comp(compid),rc=rc) + call ESMF_ClockAdvance(avgfile%clock,rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockSet(hclock_avg_comp(compid), currTime=currtime) + call ESMF_ClockSet(avgfile%clock, currTime=currtime) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Write diagnostic info if (mastertask) then write(logunit,'(a,2x,i8)') trim(subname)//" initialized time averaged history alarm "//& - trim(alarmname)//" with option "//trim(hist_option)//" and frequency ",hist_n + trim(avgfile%alarmname)//" with option "//trim(hist_option)//" and frequency ",hist_n end if - if (compid /= compmed) then ! component is not mediator - ! create accumulated import and export field bundles - call med_phases_history_init_fldbun_accum(is_local%wrap%FBimp(compid,compid), & - is_local%wrap%flds_scalar_name, avgfiles_import(compid)%FBaccum, avgfiles_import(compid)%accumcnt, rc=rc) - call med_phases_history_init_fldbun_accum(is_local%wrap%FBExp(compid), & - is_local%wrap%flds_scalar_name, avgfiles_export(compid)%FBaccum, avgfiles_export(compid)%accumcnt, rc=rc) - else ! component is mediator - ! create accumulated atm/ocn and ocnalb field bundles - call med_phases_history_init_fldbun_accum(is_local%wrap%FBMed_aoflux_o, & - is_local%wrap%flds_scalar_name, avgfiles_aoflux_ocn%FBaccum, avgfiles_aoflux_ocn%accumcnt, rc=rc) - call med_phases_history_init_fldbun_accum(is_local%wrap%FBMed_aoflux_a, & - is_local%wrap%flds_scalar_name, avgfiles_aoflux_atm%FBaccum, avgfiles_aoflux_atm%accumcnt, rc=rc) - call med_phases_history_init_fldbun_accum(is_local%wrap%FBMed_ocnalb_o, & - is_local%wrap%flds_scalar_name, avgfiles_ocnalb_ocn%FBaccum, avgfiles_ocnalb_ocn%accumcnt, rc=rc) - call med_phases_history_init_fldbun_accum(is_local%wrap%FBMed_ocnalb_a, & - is_local%wrap%flds_scalar_name, avgfiles_ocnalb_atm%FBaccum, avgfiles_ocnalb_atm%accumcnt, rc=rc) + ! 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 end if end if ! end of initialization (first_time) if block - if (ESMF_ClockIsCreated(hclock_avg_comp(compid))) then - ! Update clock + if (ESMF_ClockIsCreated(avgfile%clock)) then + + ! Update clock to trigger alarm call ESMF_ClockGet(mclock, currTime=CurrTime, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockSet(hclock_avg_comp(compid), currTime=currtime) + call ESMF_ClockSet(avgfile%clock, currTime=currtime) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockAdvance(hclock_avg_comp(compid),rc=rc) + call ESMF_ClockAdvance(avgfile%clock,rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockSet(hclock_avg_comp(compid), currTime=currtime) + call ESMF_ClockSet(avgfile%clock, currTime=currtime) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Write history file - call med_phases_history_write_hfile_avg(gcomp, trim(compname(compid)), hclock_avg_comp(compid), & - trim(alarmname), rc) + ! Determine if will write to history file + call med_phases_history_query_ifwrite(avgfile%clock, avgfile%alarmname, write_now, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - call t_stopf('MED:'//subname) - end subroutine med_phases_history_write_avg_comp + ! 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 + 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 + end if + end if - !=============================================================================== - subroutine med_phases_history_write_aux_comp(gcomp, compid, first_time, subname, rc) + ! If write now flag is true + if (write_now) then - ! ----------------------------- - ! Write mediator history file for component compid - ! 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 - ! ----------------------------- + ! 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 - ! input/output variables - type(ESMF_GridComp) , intent(inout) :: gcomp - integer , intent(in) :: compid - logical , intent(in) :: first_time + ! 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 + if (m == 1) then + whead = .true. + wdata = .false. + else if (m == 2) then + call med_io_enddef(hist_file) + whead = .false. + wdata = .true. + end if + + ! Write time values + if (whead) 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_write_time(time_val, time_bnds, nt=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + ! 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, wdata, nx, ny, & + nt=1, pre=trim(compname(compid))//'Imp', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (wdata) 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(compid),rc=rc)) then + call med_io_write(hist_file, avgfile%FBaccum_export, whead, wdata, nx, ny, & + nt=1, pre=trim(compname(compid))//'Exp', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (wdata) then + call med_methods_FB_reset(avgfile%FBAccum_export, czero, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + endif + 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_avg_comp + + !=============================================================================== + subroutine med_phases_history_write_aux_comp(gcomp, compid, auxfile, first_time, subname, rc) + + ! ----------------------------- + ! Write mediator auxiliary history file for component compid + ! 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 med_constants_mod, only : czero => med_constants_czero + use med_io_mod , only : med_io_write_time, med_io_define_time + + ! input/output variables + type(ESMF_GridComp) , intent(inout) :: gcomp + integer , intent(in) :: compid + type(auxfile_type) , intent(inout) :: auxfile(:) + logical , intent(in) :: first_time character(len=*) , intent(in) :: subname integer , intent(out) :: rc ! local variables type(InternalState) :: is_local + type(ESMF_VM) :: vm type(ESMF_Clock) :: mclock ! mediator clock type(ESMF_Time) :: starttime type(ESMF_Time) :: currtime - type(ESMF_TimeInterval) :: timestep - type(ESMF_Alarm) :: alarm + 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) @@ -639,13 +1103,21 @@ subroutine med_phases_history_write_aux_comp(gcomp, compid, first_time, subname, integer :: nfcnt integer :: nfile integer :: nfld - integer :: n,n1 + 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 :: whead,wdata ! for writing restart/history cdf files + 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(:) !--------------------------------------- rc = ESMF_SUCCESS @@ -660,6 +1132,7 @@ subroutine med_phases_history_write_aux_comp(gcomp, compid, first_time, subname, if (ChkErr(rc,__LINE__,u_FILE_u)) return if (first_time) then + ! Initialize number of aux files for this component to zero nfcnt = 0 do nfile = 1,max_auxfiles @@ -677,7 +1150,7 @@ subroutine med_phases_history_write_aux_comp(gcomp, compid, first_time, subname, enable_auxfile = .false. end if - ! If file will be written - then initialize auxfiles(nfcnt,compid) + ! If file will be written - then initialize auxfiles(nfcnt) if (enable_auxfile) then ! Increment nfcnt nfcnt = nfcnt + 1 @@ -685,13 +1158,13 @@ subroutine med_phases_history_write_aux_comp(gcomp, compid, first_time, subname, ! 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,*) auxfiles(nfcnt,compid)%ntperfile + read(cvalue,*) auxfile(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,*) auxfiles(nfcnt,compid)%doavg + read(cvalue,*) auxfile(nfcnt)%doavg ! Determine the colon delimited field names for this file call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_flds', value=auxflds, rc=rc) @@ -701,12 +1174,10 @@ subroutine med_phases_history_write_aux_comp(gcomp, compid, first_time, subname, 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) + call ESMF_FieldBundleGet(is_local%wrap%FBImp(compid,compid), fieldCount=fieldCount, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - allocate(auxfiles(nfcnt,compid)%flds(fieldcount)) - call ESMF_FieldBundleGet(is_local%wrap%FBImp(compid,compid), & - fieldNameList=auxfiles(nfcnt,compid)%flds, rc=rc) + allocate(auxfile(nfcnt)%flds(fieldcount)) + call ESMF_FieldBundleGet(is_local%wrap%FBImp(compid,compid), fieldNameList=auxfile(nfcnt)%flds, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return else @@ -728,10 +1199,10 @@ subroutine med_phases_history_write_aux_comp(gcomp, compid, first_time, subname, end if end do - ! Create auxfiles(nfcnt,compid)%flds array - allocate(auxfiles(nfcnt,compid)%flds(fieldcount)) + ! Create auxfile(nfcnt)%flds array + allocate(auxfile(nfcnt)%flds(fieldcount)) do n = 1,fieldcount - auxfiles(nfcnt,compid)%flds(n) = trim(fieldnamelist(n)) + auxfile(nfcnt)%flds(n) = trim(fieldnamelist(n)) end do ! Deallocate memory from fieldnamelist @@ -743,18 +1214,18 @@ subroutine med_phases_history_write_aux_comp(gcomp, compid, first_time, subname, write(logunit,*) write(logunit,'(a,i4,a)') ' Writing the following fields to auxfile ',nfcnt,& ' for component '//trim(compname(compid)) - do nfld = 1,size(auxfiles(nfcnt,compid)%flds) - write(logunit,'(8x,a)') trim(auxfiles(nfcnt,compid)%flds(nfld)) + do nfld = 1,size(auxfile(nfcnt)%flds) + write(logunit,'(8x,a)') trim(auxfile(nfcnt)%flds(nfld)) end do end if ! Create FBaccum if averaging is on - if (auxfiles(nfcnt,compid)%doavg) then + if (auxfile(nfcnt)%doavg) then ! First duplicate all fields in FBImp(compid,compid) call ESMF_LogWrite(trim(subname)// ": initializing FBaccum(compid)", ESMF_LOGMSG_INFO) call med_phases_history_init_fldbun_accum(is_local%wrap%FBImp(compid,compid), & - is_local%wrap%flds_scalar_name, auxfiles(nfcnt,compid)%FBaccum, auxfiles(nfcnt,compid)%accumcnt, rc=rc) + is_local%wrap%flds_scalar_name, auxfile(nfcnt)%FBaccum, auxfile(nfcnt)%accumcnt, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! Now remove all fields from FBAccum that are not in the input flds list @@ -765,24 +1236,24 @@ subroutine med_phases_history_write_aux_comp(gcomp, compid, first_time, subname, if (chkerr(rc,__LINE__,u_FILE_u)) return do n = 1,size(fieldnamelist) found = .false. - do n1 = 1,size(auxfiles(nfcnt,compid)%flds) - if (trim(fieldnamelist(n)) == trim(auxfiles(nfcnt,compid)%flds(n1))) then + do n1 = 1,size(auxfile(nfcnt)%flds) + if (trim(fieldnamelist(n)) == trim(auxfile(nfcnt)%flds(n1))) then found = .true. exit end if end do if (.not. found) then - call ESMF_FieldBundleRemove(auxfiles(nfcnt,compid)%FBaccum, fieldnamelist(n:n), rc=rc) + call ESMF_FieldBundleRemove(auxfile(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(auxfiles(nfcnt,compid)%FBAccum, fieldCount=nfld, rc=rc) + call ESMF_FieldBundleGet(auxfile(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(auxfiles(nfcnt,compid)%auxname), & + call ESMF_LogWrite(subname//'FBAccum is zero for '//trim(auxfile(nfcnt)%auxname), & ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) then @@ -799,55 +1270,136 @@ subroutine med_phases_history_write_aux_comp(gcomp, compid, first_time, subname, if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) hist_n - ! First create hclock from mclock - THIS CALL DOES NOT COPY ALARMS - auxfiles(nfcnt,compid)%hclock = ESMF_ClockCreate(mclock, rc=rc) + ! Create auxfile(nfcnt)%clock from mclock - THIS CALL DOES NOT COPY ALARMS + auxfile(nfcnt)%clock = ESMF_ClockCreate(mclock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Determine auxfile%alarmname + call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_auxname', value=auxfile(nfcnt)%auxname, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(auxfile(nfcnt)%alarmname,'(a,i0)') 'alarm_'//trim(prefix) + ! Set alarm for auxiliary history output ! Advance history clock to trigger alarms then reset history clock back to mcurrtime - call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_auxname', & - value=auxfiles(nfcnt,compid)%auxname, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - write(auxfiles(nfcnt,compid)%alarmname,'(a,i0)') 'alarm_'//trim(prefix) - call ESMF_ClockGet(auxfiles(nfcnt,compid)%hclock, & - startTime=starttime, currTime=currtime, timeStep=timestep, rc=rc) + call ESMF_ClockGet(auxfile(nfcnt)%clock, startTime=starttime, currTime=currtime, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_time_alarmInit(auxfiles(nfcnt,compid)%hclock, alarm, option=hist_option, opt_n=hist_n, & - reftime=starttime, alarmname=trim(auxfiles(nfcnt,compid)%alarmname), rc=rc) + call med_time_alarmInit(auxfile(nfcnt)%clock, auxfile(nfcnt)%alarm, option=hist_option, opt_n=hist_n, & + reftime=starttime, alarmname=trim(auxfile(nfcnt)%alarmname), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_AlarmSet(alarm, clock=auxfiles(nfcnt,compid)%hclock, rc=rc) + call ESMF_AlarmSet(auxfile(nfcnt)%alarm, clock=auxfile(nfcnt)%clock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockAdvance(auxfiles(nfcnt,compid)%hclock, rc=rc) + call ESMF_ClockAdvance(auxfile(nfcnt)%clock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockSet(auxfiles(nfcnt,compid)%hclock, currtime=currtime) + call ESMF_ClockSet(auxfile(nfcnt)%clock, currtime=currtime) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (mastertask) then write(logunit,'(a,2x,i8)') " created auxiliary history alarm "//& - trim(auxfiles(nfcnt,compid)%alarmname)//" with option "//trim(hist_option)//" and frequency ",hist_n + trim(auxfile(nfcnt)%alarmname)//" with option "//trim(hist_option)//" and frequency ",hist_n end if 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 + ! Set number of aux files for this component - this is a module variable num_auxfiles(compid) = nfcnt end if ! end of initialization (first time) block ! Write auxiliary history files for component compid - do n = 1,num_auxfiles(compid) + do nf = 1,num_auxfiles(compid) + ! Update clock to trigger alarm call ESMF_ClockGet(mclock, currTime=CurrTime, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockSet(auxfiles(n,compid)%hclock, currTime=currtime) + call ESMF_ClockSet(auxfile(nf)%clock, currTime=currtime) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockAdvance(auxfiles(n,compid)%hclock, rc=rc) + call ESMF_ClockAdvance(auxfile(nf)%clock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockSet(auxfiles(n,compid)%hclock, currTime=currtime) + call ESMF_ClockSet(auxfile(nf)%clock, currTime=currtime) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Write auxiliary file(s) - call med_phases_history_write_hfile_aux(gcomp, n, compid, auxfiles(n,compid), rc=rc) + ! Determine if will write to history file + call med_phases_history_query_ifwrite(auxfile(nf)%clock, auxfile(nf)%alarmname, write_now, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Do accumulation and average if required + if (auxfile(nf)%doavg) then + call med_phases_history_fldbun_accum(is_local%wrap%FBImp(compid,compid), & + auxfile(nf)%FBaccum, auxfile(nf)%accumcnt, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (write_now) then + call med_phases_history_fldbun_average(auxfile(nf)%FBaccum, auxfile(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, auxfile(nf)%clock, auxfile(nf)%alarmname, & + time_val, time_bnds, time_units, auxfile(nf)%histfile, auxfile(nf)%doavg, & + auxname=auxfile(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 + auxfile(nf)%nt = auxfile(nf)%nt + 1 + + ! Write header + if (auxfile(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(auxfile(nf)%histfile, vm, file_ind=nf, clobber=.true.) + + ! define time variables + call ESMF_ClockGet(auxfile(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) + whead = .true.; wdata = .false. + call med_io_write(auxfile(nf)%histfile, is_local%wrap%FBimp(compid,compid), whead, wdata, nx, ny, & + nt=auxfile(nf)%nt, pre=trim(compname(compid))//'Imp', flds=auxfile(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(auxfile(nf)%histfile, file_ind=nf) + end if + + ! Write time variables for time nt + call med_io_write_time(time_val, time_bnds, nt=auxfile(nf)%nt, file_ind=nf, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Write data variables for time nt + whead = .false.; wdata = .true. + if (auxfile(nf)%doavg) then + call med_io_write(auxfile(nf)%histfile, auxfile(nf)%FBaccum, whead, wdata, nx, ny, & + nt=auxfile(nf)%nt, pre=trim(compname(compid))//'Imp', flds=auxfile(nf)%flds, file_ind=nf, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_methods_FB_reset(auxfile(nf)%FBaccum, value=czero, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call med_io_write(auxfile(nf)%histfile, is_local%wrap%FBimp(compid,compid), whead, wdata, nx, ny, & + nt=auxfile(nf)%nt, pre=trim(compname(compid))//'Imp', flds=auxfile(nf)%flds, file_ind=nf, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + ! Close file + if (auxfile(nf)%nt == auxfile(nf)%ntperfile) then + call med_io_close(auxfile(nf)%histfile, vm, file_ind=nf, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + auxfile(nf)%nt = 0 + end if + + end if ! end of write_now if-block + end do call t_stopf('MED:'//subname) @@ -919,443 +1471,6 @@ end subroutine get_auxflds end subroutine med_phases_history_write_aux_comp - !=============================================================================== - subroutine med_phases_history_write_hfile_inst(gcomp, comptype, hclock, alarmname, rc) - - use med_methods_mod , only : med_methods_FB_reset - use med_constants_mod , only : czero => med_constants_czero - use med_io_mod , only : med_io_write_time, med_io_define_time - - ! input/output variables - type(ESMF_GridComp) , intent(inout) :: gcomp - character(len=*) , intent(in) :: comptype - type(ESMF_Clock) , intent(in) :: hclock - character(len=*) , intent(in) :: alarmname - integer , intent(out) :: rc - - ! local variables - 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 :: whead,wdata ! for writing restart/history cdf files - logical :: write_now ! true => write to history type - real(r8) :: tbnds(2) ! CF1.0 time bounds - character(len=*), parameter :: subname='(med_phases_history_write_hfile)' - !--------------------------------------- - - 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 - - ! Determine if will write to history file - call med_phases_history_query_ifwrite(hclock, 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, hclock, alarmname, & - time_val, time_bnds, time_units, hist_file, doavg=.false., compname=comptype, 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 - if (m == 1) then - whead = .true. - wdata = .false. - else if (m == 2) then - call med_io_enddef(hist_file) - whead = .false. - wdata = .true. - end if - - ! Write time values - if (whead) then - call ESMF_ClockGet(hclock, 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 - - ! Write import and export field bundles - do n = 2,ncomps ! skip the mediator here - if (comptype == 'all' .or. comptype == trim(compname(n))) then - if (is_local%wrap%comp_present(n)) then - nx = is_local%wrap%nx(n) - ny = is_local%wrap%ny(n) - 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, wdata, nx, ny, & - 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, wdata, nx, ny, & - nt=1, pre=trim(compname(n))//'Exp', rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - endif - endif - end if - end do - - ! Write mediator fractions - ! Also write atm/ocn fluxes and ocean albedoes if field bundles are created - if (comptype == 'all' .or. comptype == 'med') then - do n = 2,ncomps ! skip the mediator here - if (ESMF_FieldBundleIsCreated(is_local%wrap%FBFrac(n),rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBFrac(n), whead, wdata, & - 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 - end do - 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, wdata, & - 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, wdata, & - 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, wdata, & - 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, wdata, & - is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_aoflux_atm', rc=rc) - end if - 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 subroutine med_phases_history_write_hfile_inst - - !=============================================================================== - subroutine med_phases_history_write_hfile_avg(gcomp, comptype, hclock, alarmname, rc) - - use med_methods_mod , only : med_methods_FB_reset - use med_constants_mod , only : czero => med_constants_czero - use med_io_mod , only : med_io_write_time, med_io_define_time - - ! input/output variables - type(ESMF_GridComp) , intent(inout) :: gcomp - character(len=*) , intent(in) :: comptype - type(ESMF_Clock) , intent(in) :: hclock - character(len=*) , intent(in) :: alarmname - integer , intent(out) :: rc - - ! local variables - 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 :: whead,wdata ! for writing restart/history cdf files - logical :: write_now ! true => write to history type - real(r8) :: tbnds(2) ! CF1.0 time bounds - character(len=*), parameter :: subname='(med_phases_history_write_hfile)' - !--------------------------------------- - - 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 - - ! Determine if will write to history file - call med_phases_history_query_ifwrite(hclock, alarmname, write_now, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! If averaging history output then accumulate and then average if write_now flag is true - do n = 1,ncomps - if (comptype == 'all' .or. comptype == trim(compname(n))) then - if (ESMF_FieldBundleIsCreated(avgfiles_import(n)%FBaccum)) then - call med_phases_history_fldbun_accum(is_local%wrap%FBImp(n,n), avgfiles_import(n)%FBaccum, & - avgfiles_import(n)%accumcnt, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (write_now) then - call med_phases_history_fldbun_average(avgfiles_import(n)%FBaccum, & - avgfiles_import(n)%accumcnt, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - end if - if (ESMF_FieldBundleIsCreated(avgfiles_export(n)%FBaccum)) then - call med_phases_history_fldbun_accum(is_local%wrap%FBExp(n), avgfiles_export(n)%FBaccum, & - avgfiles_export(n)%accumcnt, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (write_now) then - call med_phases_history_fldbun_average(avgfiles_export(n)%FBaccum, & - avgfiles_export(n)%accumcnt, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - end if - end if - end do - - ! 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, hclock, alarmname, & - time_val, time_bnds, time_units, hist_file, doavg=.true., compname=comptype, 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 - if (m == 1) then - whead = .true. - wdata = .false. - else if (m == 2) then - call med_io_enddef(hist_file) - whead = .false. - wdata = .true. - end if - - ! Write time values - if (whead) then - call ESMF_ClockGet(hclock, 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 - - ! Write import and export field bundles - do n = 2,ncomps ! skip the mediator here - if (comptype == 'all' .or. comptype == trim(compname(n))) then - if (is_local%wrap%comp_present(n)) then - nx = is_local%wrap%nx(n) - ny = is_local%wrap%ny(n) - if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(n,n),rc=rc)) then - call med_io_write(hist_file, avgfiles_import(n)%FBaccum, whead, wdata, nx, ny, & - nt=1, pre=trim(compname(n))//'Imp', rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (wdata) then - call med_methods_FB_reset(avgfiles_import(n)%FBAccum, 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 - call med_io_write(hist_file, avgfiles_export(n)%FBaccum, whead, wdata, nx, ny, & - nt=1, pre=trim(compname(n))//'Exp', rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (wdata) then - call med_methods_FB_reset(avgfiles_export(n)%FBAccum, czero, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end if - endif - endif - end if - end do - 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 subroutine med_phases_history_write_hfile_avg - - !=============================================================================== - subroutine med_phases_history_write_hfile_aux(gcomp, nfile_index, comp_index, auxfile, rc) - - use med_constants_mod, only : czero => med_constants_czero - use med_io_mod , only : med_io_write_time, med_io_define_time - - ! input/output variables - type(ESMF_GridComp) , intent(inout) :: gcomp - integer , intent(in) :: nfile_index - integer , intent(in) :: comp_index - type(auxfile_type) , intent(inout) :: auxfile - integer , intent(out) :: rc - - ! local variables - type(InternalState) :: is_local - type(ESMF_VM) :: vm - type(ESMF_Time) :: starttime - type(ESMF_Time) :: currtime - type(ESMF_Calendar) :: calendar ! calendar type - character(CS) :: timestr ! yr-mon-day-sec string - character(CL) :: time_units ! units of time variable - real(r8) :: time_coord ! Time coordinate output - integer :: nx,ny ! global grid size - logical :: whead,wdata ! for writing restart/history cdf files - logical :: write_now ! if true, write time sample to file - integer :: yr,mon,day,sec ! time units - real(r8) :: days_since ! time interval since reference time - real(r8) :: time_val ! time coordinate output - real(r8) :: time_bnds(2) ! time bounds output - character(len=*), parameter :: subname='(med_phases_history_write_hfileaux)' - !--------------------------------------- - - rc = ESMF_SUCCESS - - ! Get the communicator and localpet - call ESMF_GridCompGet(gcomp, vm=vm, 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) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! Determine if will write to history file - call med_phases_history_query_ifwrite(auxfile%hclock, auxfile%alarmname, write_now, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! Do accumulation and average if required - if (auxfile%doavg) then - call med_phases_history_fldbun_accum(is_local%wrap%FBImp(comp_index,comp_index), auxfile%FBaccum, & - auxfile%accumcnt, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (write_now) then - call med_phases_history_fldbun_average(auxfile%FBaccum, auxfile%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, auxfile%hclock, auxfile%alarmname, & - time_val, time_bnds, time_units, auxfile%histfile, auxfile%doavg, auxname=auxfile%auxname, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! Set shorthand variables - nx = is_local%wrap%nx(comp_index) - ny = is_local%wrap%ny(comp_index) - - ! Increment number of time samples on file - auxfile%nt = auxfile%nt + 1 - - ! Write header - if (auxfile%nt == 1) then - ! open file - call med_io_wopen(auxfile%histfile, vm, file_ind=nfile_index, clobber=.true.) - - ! define time variables - call ESMF_ClockGet(auxfile%hclock, calendar=calendar, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_define_time(time_units, calendar, file_ind=nfile_index, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! define data variables with a time dimension (include the nt argument below) - whead = .true.; wdata = .false. - call med_io_write(auxfile%histfile, is_local%wrap%FBimp(comp_index,comp_index), whead, wdata, nx, ny, & - nt=auxfile%nt, pre=trim(compname(comp_index))//'Imp', flds=auxfile%flds, file_ind=nfile_index, & - use_float=.true., rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! end definition phase - call med_io_enddef(auxfile%histfile, file_ind=nfile_index) - end if - - ! Write time variables for time nt - call med_io_write_time(time_val, time_bnds, nt=auxfile%nt, file_ind=nfile_index, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! Write data variables for time nt - whead = .false.; wdata = .true. - if (auxfile%doavg) then - call med_io_write(auxfile%histfile, auxfile%FBaccum, whead, wdata, nx, ny, & - nt=auxfile%nt, pre=trim(compname(comp_index))//'Imp', flds=auxfile%flds, file_ind=nfile_index, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_methods_FB_reset(auxfile%FBaccum, value=czero, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - call med_io_write(auxfile%histfile, is_local%wrap%FBimp(comp_index,comp_index), whead, wdata, nx, ny, & - nt=auxfile%nt, pre=trim(compname(comp_index))//'Imp', flds=auxfile%flds, file_ind=nfile_index, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - - ! Close file - if (auxfile%nt == auxfile%ntperfile) then - call med_io_close(auxfile%histfile, vm, file_ind=nfile_index, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - auxfile%nt = 0 - end if - - end if ! end of write_now if-block - - end subroutine med_phases_history_write_hfile_aux - - !=============================================================================== - subroutine med_phases_history_output_alarminfo(mclock, alarm, alarmname, rc) - - ! input/output variables - type(ESMF_Clock), intent(in) :: mclock - type(ESMF_Alarm), intent(in) :: alarm - character(len=*), intent(in) :: alarmname - integer , intent(out) :: rc - - ! local variables - type(ESMF_TimeInterval) :: ringInterval - integer :: ringInterval_length - type(ESMF_Time) :: currtime - type(ESMF_Time) :: nexttime - character(len=CS) :: currtimestr - character(len=CS) :: nexttimestr - integer :: yr,mon,day,sec ! time units - character(len=*), parameter :: subname='(med_phases_history_output_alarminfo)' - !--------------------------------------- - - rc = ESMF_SUCCESS - - 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) - 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 - if (mastertask) then - write(nexttimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec - write(logunit,*) - write(logunit,'(a,i8)') trim(subname)//": history alarmname "//trim(alarmname)//& - ' is ringing, interval length is ', ringInterval_length - write(logunit,'(a)') trim(subname)//": currtime = "//trim(currtimestr)//" nexttime = "//trim(nexttimestr) - end if - - end subroutine med_phases_history_output_alarminfo - !=============================================================================== subroutine med_phases_history_fldbun_accum(fldbun, fldbun_accum, count, rc) @@ -1556,15 +1671,59 @@ subroutine med_phases_history_query_ifwrite(clock, alarmname, write_now, rc) write(logunit,'(a,4(i6,2x))')' starttime is ',yr,mon,day,sec end if end if - end subroutine med_phases_history_query_ifwrite + !=============================================================================== + subroutine med_phases_history_output_alarminfo(mclock, alarm, alarmname, rc) + + ! input/output variables + type(ESMF_Clock), intent(in) :: mclock + type(ESMF_Alarm), intent(in) :: alarm + character(len=*), intent(in) :: alarmname + integer , intent(out) :: rc + + ! local variables + type(ESMF_TimeInterval) :: ringInterval + integer :: ringInterval_length + type(ESMF_Time) :: currtime + type(ESMF_Time) :: nexttime + character(len=CS) :: currtimestr + character(len=CS) :: nexttimestr + integer :: yr,mon,day,sec ! time units + character(len=*), parameter :: subname='(med_phases_history_output_alarminfo)' + !--------------------------------------- + + rc = ESMF_SUCCESS + + 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) + 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 + if (mastertask) then + write(nexttimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + write(logunit,*) + write(logunit,'(a,i8)') trim(subname)//": history alarmname "//trim(alarmname)//& + ' is ringing, interval length is ', ringInterval_length + write(logunit,'(a)') trim(subname)//": currtime = "//trim(currtimestr)//" nexttime = "//trim(nexttimestr) + end if + + end subroutine med_phases_history_output_alarminfo + !=============================================================================== subroutine med_phases_history_set_timeinfo(gcomp, clock, alarmname, & time_val, time_bnds, time_units, histfile, doavg, auxname, compname, rc) ! input/output variables - type(ESMF_GridComp) , intent(in) :: gcomp + type(ESMF_GridComp) , intent(in) :: gcomp type(ESMF_Clock) , intent(in) :: clock character(len=*) , intent(in) :: alarmname real(r8) , intent(out) :: time_val From dd0a5af9ed4115a1491496d25d48866920f71b7c Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 8 Sep 2021 10:25:01 -0600 Subject: [PATCH 45/61] more code reuse introduced in med_phases_history_mod --- mediator/med.F90 | 17 +- mediator/med_phases_history_mod.F90 | 545 ++++++++++------------------ 2 files changed, 217 insertions(+), 345 deletions(-) diff --git a/mediator/med.F90 b/mediator/med.F90 index fb5cc9272..aed48fe0f 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 diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 5be071f19..aea71a8e7 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -2,19 +2,6 @@ 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 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 med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 @@ -69,10 +56,10 @@ module med_phases_history_mod private :: med_phases_history_write_avg_comp ! write averaged file for a given component private :: med_phases_history_write_aux_comp ! write auxiliary file for a given component private :: med_phases_history_query_ifwrite - private :: med_phases_history_set_timeinfo - private :: med_phases_history_output_alarminfo private :: med_phases_history_fldbun_accum private :: med_phases_history_fldbun_average + private :: med_phases_history_set_timeinfo + private :: med_phases_history_init_histclock ! ---------------------------- ! Instantaneous history files datatypes/variables @@ -125,6 +112,13 @@ module med_phases_history_mod integer , public :: num_auxfiles(ncomps) = 0 type(auxfile_type) , public :: auxfiles(max_auxfiles,ncomps) + ! ---------------------------- + ! 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. @@ -149,9 +143,6 @@ subroutine med_phases_history_write(gcomp, rc) ! local variables type(InternalState) :: is_local - type(ESMF_Clock) :: mclock - type(ESMF_Time) :: CurrTime - type(ESMF_Time) :: StartTime type(ESMF_TimeInterval) :: timestep integer :: timestep_length character(CL) :: hist_option ! freq_option setting (ndays, nsteps, etc) @@ -167,7 +158,6 @@ subroutine med_phases_history_write(gcomp, rc) character(CL) :: hist_file ! history file name real(r8) :: time_val ! time coordinate output real(r8) :: time_bnds(2) ! time bounds output - logical :: whead,wdata ! for writing restart/history cdf files logical :: write_now ! true => write to history type real(r8) :: tbnds(2) ! CF1.0 time bounds logical :: first_time = .true. @@ -197,53 +187,21 @@ subroutine med_phases_history_write(gcomp, rc) 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 - - ! Create instfile_all%clock from mclock - THIS CALL DOES NOT COPY ALARMS - call NUOPC_ModelGet(gcomp, modelClock=mclock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - instfile_all%clock = ESMF_ClockCreate(mclock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! Set alarm name instfile_all%alarmname = 'alarm_history_inst_all' - - ! Set alarm for instantaneous history output - ! Advance history clock to trigger alarms then reset history clock back to mcurrtime - call ESMF_ClockGet(instfile_all%clock, startTime=StartTime, currTime=CurrTime, timeStep=timestep, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_time_alarmInit(instfile_all%clock, instfile_all%alarm, option=hist_option, opt_n=hist_n, & - reftime=StartTime, alarmname=trim(instfile_all%alarmname), rc=rc) - call ESMF_AlarmSet(instfile_all%alarm, clock=instfile_all%clock, rc=rc) + call med_phases_history_init_histclock(gcomp, instfile_all%clock, & + instfile_all%alarm, instfile_all%alarmname, hist_option, hist_n, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockAdvance(instfile_all%clock,rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockSet(instfile_all%clock, currTime=currtime) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! Write diagnostic info - if (mastertask) then - call ESMF_TimeIntervalGet(timestep, s=timestep_length, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - write(logunit,'(a,2x,i8)') " initialized instantaneous history alarm "//& - trim(instfile_all%alarmname)//" with option "//trim(hist_option)//" and frequency ",hist_n - write(logunit,'(a,2x,i8)') " history clock timestep = ",timestep_length - end if end if - first_time = .false. end if if (ESMF_ClockIsCreated(instfile_all%clock)) then - if (.not. first_time) then - ! Advance the clock - call ESMF_ClockAdvance(instfile_all%clock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - - ! Write the instantaneous history file for all relevant components ! Determine if will write to history file + call ESMF_ClockAdvance(instfile_all%clock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call med_phases_history_query_ifwrite(instfile_all%clock, instfile_all%alarmname, write_now, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -258,20 +216,14 @@ subroutine med_phases_history_write(gcomp, rc) ! 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 - if (m == 1) then - whead = .true. - wdata = .false. - else if (m == 2) then + if (m == 2) then call med_io_enddef(hist_file) - whead = .false. - wdata = .true. end if ! Write time values - if (whead) then + if (whead(m)) then call ESMF_ClockGet(instfile_all%clock, calendar=calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call med_io_define_time(time_units, calendar, rc=rc) @@ -287,38 +239,39 @@ subroutine med_phases_history_write(gcomp, rc) nx = is_local%wrap%nx(n) ny = is_local%wrap%ny(n) 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, wdata, nx, ny, & + call med_io_write(hist_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 if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(n),rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBexp(n), whead, wdata, nx, ny, & + call med_io_write(hist_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 end if ! Write mediator fractions if (ESMF_FieldBundleIsCreated(is_local%wrap%FBFrac(n),rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBFrac(n), whead, wdata, & + 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 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, wdata, & + 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, wdata, & + 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, wdata, & + 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, wdata, & + 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 @@ -337,6 +290,7 @@ end subroutine med_phases_history_write !=============================================================================== subroutine med_phases_history_write_med(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 @@ -357,12 +311,8 @@ subroutine med_phases_history_write_med(gcomp, rc) character(CL) :: hist_file ! history file name real(r8) :: time_val ! time coordinate output real(r8) :: time_bnds(2) ! time bounds output - logical :: whead,wdata ! for writing restart/history cdf files logical :: write_now ! true => write to history type real(r8) :: tbnds(2) ! CF1.0 time bounds - type(ESMF_Clock) :: mclock - type(ESMF_Time) :: CurrTime - type(ESMF_Time) :: StartTime 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 @@ -381,7 +331,6 @@ subroutine med_phases_history_write_med(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (first_time) then - ! Determine attribute prefix write(hist_option_in,'(a)') 'history_option_med_inst' write(hist_n_in,'(a)') 'history_n_med_inst' @@ -401,45 +350,21 @@ subroutine med_phases_history_write_med(gcomp, rc) 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 - - ! Set alarm name instfiles(compmed)%alarmname = 'alarm_history_inst_med' - - ! Set alarm for instantaneous history output - ! Advance history clock to trigger alarms then reset history clock back to mcurrtime - call ESMF_ClockGet(instfiles(compmed)%clock, startTime=StartTime, currTime=CurrTime, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_time_alarmInit(instfiles(compmed)%clock, instfiles(compmed)%alarm, option=hist_option, opt_n=hist_n, & - reftime=StartTime, alarmname=instfiles(compmed)%alarmname, rc=rc) - call ESMF_AlarmSet(instfiles(compmed)%alarm, clock=instfiles(compmed)%clock, rc=rc) + 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 - call ESMF_ClockAdvance(instfiles(compmed)%clock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockSet(instfiles(compmed)%clock, currTime=currtime) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! Write diagnostic info - if (mastertask) then - write(logunit,'(a,2x,i8)') trim(subname)//" initialized instantaneous history alarm "//& - trim(instfiles(compmed)%alarmname)//" with option "//trim(hist_option)//" and frequency ",hist_n - end if - end if + first_time = .false. end if if (ESMF_ClockIsCreated(instfiles(compmed)%clock)) then - call ESMF_ClockGet(mclock, currTime=CurrTime, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockSet(instfiles(compmed)%clock, currTime=currtime) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockAdvance(instfiles(compmed)%clock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockSet(instfiles(compmed)%clock, currTime=currtime) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Determine if will write to history file + call med_phases_history_update_hclock(gcomp, instfiles(compmed)%clock, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call med_phases_history_query_ifwrite(instfiles(compmed)%clock, instfiles(compmed)%alarmname, write_now, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -456,41 +381,33 @@ subroutine med_phases_history_write_med(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call med_io_wopen(hist_file, vm, clobber=.true.) do m = 1,2 - if (m == 1) then - whead = .true. - wdata = .false. - else if (m == 2) then - call med_io_enddef(hist_file) - whead = .false. - wdata = .true. - end if - ! Write time values - if (whead) then + 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 fields 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, wdata, & + 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, wdata, & + 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, wdata, & + 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, wdata, & + 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 end do ! end of loop over m @@ -506,7 +423,9 @@ end subroutine med_phases_history_write_med !=============================================================================== subroutine med_phases_history_write_atm(gcomp, rc) + ! Write mediator history file for atm variables + type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc logical :: first_time = .true. @@ -525,8 +444,10 @@ subroutine med_phases_history_write_atm(gcomp, rc) end subroutine med_phases_history_write_atm !=============================================================================== - ! Write mediator history file for ice variables subroutine med_phases_history_write_ice(gcomp, rc) + + ! Write mediator history file for ice variables + type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc logical :: first_time = .true. @@ -545,8 +466,10 @@ subroutine med_phases_history_write_ice(gcomp, rc) end subroutine med_phases_history_write_ice !=============================================================================== - ! Write mediator history file for glc variables subroutine med_phases_history_write_glc(gcomp, rc) + + ! Write mediator history file for glc variables + type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc integer :: ns @@ -570,8 +493,10 @@ subroutine med_phases_history_write_glc(gcomp, rc) end subroutine med_phases_history_write_glc !=============================================================================== - ! Write mediator history file for lnd variables subroutine med_phases_history_write_lnd(gcomp, rc) + + ! Write mediator history file for lnd variables + type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc logical :: first_time = .true. @@ -590,8 +515,10 @@ subroutine med_phases_history_write_lnd(gcomp, rc) end subroutine med_phases_history_write_lnd !=============================================================================== - ! Write mediator history file for ocn variables subroutine med_phases_history_write_ocn(gcomp, rc) + + ! Write mediator history file for ocn variables + type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc logical :: first_time = .true. @@ -610,8 +537,10 @@ subroutine med_phases_history_write_ocn(gcomp, rc) end subroutine med_phases_history_write_ocn !=============================================================================== - ! Write mediator history file for rof variables subroutine med_phases_history_write_rof(gcomp, rc) + + ! Write mediator history file for rof variables + type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc logical :: first_time = .true. @@ -630,8 +559,10 @@ subroutine med_phases_history_write_rof(gcomp, rc) end subroutine med_phases_history_write_rof !=============================================================================== - ! Write mediator history file for wav variables subroutine med_phases_history_write_wav(gcomp, rc) + + ! Write mediator history file for wav variables + type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc logical :: first_time = .true. @@ -666,9 +597,6 @@ subroutine med_phases_history_write_inst_comp(gcomp, compid, instfile, first_tim ! local variables type(InternalState) :: is_local - type(ESMF_Clock) :: mclock - type(ESMF_Time) :: CurrTime - type(ESMF_Time) :: StartTime 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 @@ -684,7 +612,6 @@ subroutine med_phases_history_write_inst_comp(gcomp, compid, instfile, first_tim character(CL) :: hist_file ! history file name real(r8) :: time_val ! time coordinate output real(r8) :: time_bnds(2) ! time bounds output - logical :: whead,wdata ! for writing restart/history cdf files logical :: write_now ! true => write to history type real(r8) :: tbnds(2) ! CF1.0 time bounds !--------------------------------------- @@ -692,15 +619,11 @@ subroutine med_phases_history_write_inst_comp(gcomp, compid, instfile, first_tim rc = ESMF_SUCCESS call t_startf('MED:'//subname) - call NUOPC_ModelGet(gcomp, modelClock=mclock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - nullify(is_local%wrap) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (first_time) 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' @@ -721,49 +644,20 @@ subroutine med_phases_history_write_inst_comp(gcomp, compid, instfile, first_tim 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 - - ! Set alarm name instfile%alarmname = 'alarm_history_inst_'//trim(compname(compid)) - - ! First create instfile%clock from mclock - THIS CALL DOES NOT COPY ALARMS - instfile%clock = ESMF_ClockCreate(mclock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! Set alarm for instantaneous history output - ! Advance history clock to trigger alarms then reset history clock back to mcurrtime - call ESMF_ClockGet(instfile%clock, startTime=StartTime, currTime=CurrTime, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_time_alarmInit(instfile%clock, instfile%alarm, option=hist_option, opt_n=hist_n, & - reftime=StartTime, alarmname=trim(instfile%alarmname), rc=rc) - call ESMF_AlarmSet(instfile%alarm, clock=instfile%clock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockAdvance(instfile%clock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockSet(instfile%clock, currTime=currtime) + 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 - - ! Write diagnostic info - if (mastertask) then - write(logunit,'(a,2x,i8)') trim(subname)//" initialized instantaneous history alarm "//& - trim(instfile%alarmname)//" with option "//trim(hist_option)//" and frequency ",hist_n - end if end if end if ! end of first_time if-block if (ESMF_ClockIsCreated(instfile%clock)) then - ! Update clock to trigger alarm - call ESMF_ClockGet(mclock, currTime=CurrTime, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockSet(instfile%clock, currTime=currtime) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockAdvance(instfile%clock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockSet(instfile%clock, currTime=currtime) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Determine if should write to history file + call med_phases_history_update_hclock(gcomp, instfile%clock, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call med_phases_history_query_ifwrite(instfile%clock, instfile%alarmname, write_now, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -779,22 +673,14 @@ subroutine med_phases_history_write_inst_comp(gcomp, compid, instfile, first_tim if (ChkErr(rc,__LINE__,u_FILE_u)) return call med_io_wopen(hist_file, vm, clobber=.true.) do m = 1,2 - if (m == 1) then - whead = .true. - wdata = .false. - else if (m == 2) then - call med_io_enddef(hist_file) - whead = .false. - wdata = .true. - end if - ! Write time values - if (whead) then + 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 @@ -803,19 +689,19 @@ subroutine med_phases_history_write_inst_comp(gcomp, compid, instfile, first_tim 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, wdata, nx, ny, & + 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, wdata, nx, ny, & + 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, wdata, nx, ny, & + 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 @@ -853,9 +739,6 @@ subroutine med_phases_history_write_avg_comp(gcomp, compid, avgfile, first_time, ! local variables type(InternalState) :: is_local - type(ESMF_Clock) :: mclock - type(ESMF_Time) :: CurrTime - type(ESMF_Time) :: StartTime 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 @@ -871,7 +754,6 @@ subroutine med_phases_history_write_avg_comp(gcomp, compid, avgfile, first_time, character(CL) :: hist_file ! history file name real(r8) :: time_val ! time coordinate output real(r8) :: time_bnds(2) ! time bounds output - logical :: whead,wdata ! for writing restart/history cdf files logical :: write_now ! true => write to history type real(r8) :: tbnds(2) ! CF1.0 time bounds character(CS) :: scalar_name @@ -885,10 +767,6 @@ subroutine med_phases_history_write_avg_comp(gcomp, compid, avgfile, first_time, call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Obtain model clock - call NUOPC_ModelGet(gcomp, modelClock=mclock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (first_time) then ! Determine attribute prefix @@ -908,36 +786,14 @@ subroutine med_phases_history_write_avg_comp(gcomp, compid, avgfile, first_time, hist_option = 'none' hist_n = -999 end if - - ! Create time average field bundles (module variables) if (hist_option /= 'never' .and. hist_option /= 'none') then - ! Determine alarm name + ! Set alarm name, initialize clock and alarm for average history output and avgfile%alarmname = 'alarm_history_avg_'//trim(compname(compid)) - - ! Create clock from mclock - THIS CALL DOES NOT COPY ALARMS - avgfile%clock = ESMF_ClockCreate(mclock, rc=rc) + 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 - ! Set alarm for time averaged history output - ! Advance history clock to trigger alarms then reset history clock back to mcurrtime - call ESMF_ClockGet(avgfile%clock, startTime=StartTime, currTime=CurrTime, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_time_alarmInit(avgfile%clock, avgfile%alarm, option=hist_option, opt_n=hist_n, & - reftime=StartTime, alarmname=trim(avgfile%alarmname), rc=rc) - call ESMF_AlarmSet(avgfile%alarm, clock=avgfile%clock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockAdvance(avgfile%clock,rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockSet(avgfile%clock, currTime=currtime) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! Write diagnostic info - if (mastertask) then - write(logunit,'(a,2x,i8)') trim(subname)//" initialized time averaged history alarm "//& - trim(avgfile%alarmname)//" with option "//trim(hist_option)//" and frequency ",hist_n - end if - ! 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. & @@ -964,17 +820,9 @@ subroutine med_phases_history_write_avg_comp(gcomp, compid, avgfile, first_time, if (ESMF_ClockIsCreated(avgfile%clock)) then - ! Update clock to trigger alarm - call ESMF_ClockGet(mclock, currTime=CurrTime, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockSet(avgfile%clock, currTime=currtime) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockAdvance(avgfile%clock,rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockSet(avgfile%clock, currTime=currtime) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Determine if will write to history file + call med_phases_history_update_hclock(gcomp, avgfile%clock, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call med_phases_history_query_ifwrite(avgfile%clock, avgfile%alarmname, write_now, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1011,22 +859,14 @@ subroutine med_phases_history_write_avg_comp(gcomp, compid, avgfile, first_time, if (ChkErr(rc,__LINE__,u_FILE_u)) return call med_io_wopen(hist_file, vm, clobber=.true.) do m = 1,2 - if (m == 1) then - whead = .true. - wdata = .false. - else if (m == 2) then - call med_io_enddef(hist_file) - whead = .false. - wdata = .true. - end if - ! Write time values - if (whead) then + 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 @@ -1036,19 +876,19 @@ subroutine med_phases_history_write_avg_comp(gcomp, compid, avgfile, first_time, 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, wdata, nx, ny, & + 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) then + 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(compid),rc=rc)) then - call med_io_write(hist_file, avgfile%FBaccum_export, whead, wdata, nx, ny, & + 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) then + 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 @@ -1080,6 +920,7 @@ subroutine med_phases_history_write_aux_comp(gcomp, compid, auxfile, first_time, 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, med_methods_FB_reset ! input/output variables type(ESMF_GridComp) , intent(inout) :: gcomp @@ -1092,10 +933,7 @@ subroutine med_phases_history_write_aux_comp(gcomp, compid, auxfile, first_time, ! local variables type(InternalState) :: is_local type(ESMF_VM) :: vm - type(ESMF_Clock) :: mclock ! mediator clock - type(ESMF_Time) :: starttime - type(ESMF_Time) :: currtime - type(ESMF_Calendar) :: calendar ! calendar type + 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) @@ -1113,13 +951,13 @@ subroutine med_phases_history_write_aux_comp(gcomp, compid, auxfile, first_time, character(CS) :: timestr ! yr-mon-day-sec string character(CL) :: time_units ! units of time variable integer :: nx,ny ! global grid size - logical :: whead,wdata ! for writing restart/history cdf files 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(:) !--------------------------------------- + rc = ESMF_SUCCESS call t_startf('MED:'//subname) @@ -1128,9 +966,6 @@ subroutine med_phases_history_write_aux_comp(gcomp, compid, auxfile, first_time, call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_ModelGet(gcomp, modelClock=mclock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (first_time) then ! Initialize number of aux files for this component to zero @@ -1212,7 +1047,7 @@ subroutine med_phases_history_write_aux_comp(gcomp, compid, auxfile, first_time, if (mastertask) then write(logunit,*) - write(logunit,'(a,i4,a)') ' Writing the following fields to auxfile ',nfcnt,& + write(logunit,'(a,i4,a)') trim(subname) // ' Writing the following fields to auxfile ',nfcnt,& ' for component '//trim(compname(compid)) do nfld = 1,size(auxfile(nfcnt)%flds) write(logunit,'(8x,a)') trim(auxfile(nfcnt)%flds(nfld)) @@ -1224,9 +1059,15 @@ subroutine med_phases_history_write_aux_comp(gcomp, compid, auxfile, first_time, ! First duplicate all fields in FBImp(compid,compid) call ESMF_LogWrite(trim(subname)// ": initializing FBaccum(compid)", ESMF_LOGMSG_INFO) - call med_phases_history_init_fldbun_accum(is_local%wrap%FBImp(compid,compid), & - is_local%wrap%flds_scalar_name, auxfile(nfcnt)%FBaccum, auxfile(nfcnt)%accumcnt, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + if ( ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compid,compid)) .and. .not. & + ESMF_FieldBundleIsCreated(auxfile(nfcnt)%FBaccum)) then + call med_methods_FB_init(auxfile(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(auxfile(nfcnt)%FBaccum, czero, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + auxfile(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) @@ -1270,32 +1111,16 @@ subroutine med_phases_history_write_aux_comp(gcomp, compid, auxfile, first_time, if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) hist_n - ! Create auxfile(nfcnt)%clock from mclock - THIS CALL DOES NOT COPY ALARMS - auxfile(nfcnt)%clock = ESMF_ClockCreate(mclock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Determine auxfile%alarmname call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_auxname', value=auxfile(nfcnt)%auxname, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return write(auxfile(nfcnt)%alarmname,'(a,i0)') 'alarm_'//trim(prefix) - ! Set alarm for auxiliary history output - ! Advance history clock to trigger alarms then reset history clock back to mcurrtime - call ESMF_ClockGet(auxfile(nfcnt)%clock, startTime=starttime, currTime=currtime, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_time_alarmInit(auxfile(nfcnt)%clock, auxfile(nfcnt)%alarm, option=hist_option, opt_n=hist_n, & - reftime=starttime, alarmname=trim(auxfile(nfcnt)%alarmname), rc=rc) + ! Initialize clock and alarm for instantaneous history output + call med_phases_history_init_histclock(gcomp, auxfile(nfcnt)%clock, & + auxfile(nfcnt)%alarm, auxfile(nfcnt)%alarmname, hist_option, hist_n, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_AlarmSet(auxfile(nfcnt)%alarm, clock=auxfile(nfcnt)%clock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockAdvance(auxfile(nfcnt)%clock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockSet(auxfile(nfcnt)%clock, currtime=currtime) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (mastertask) then - write(logunit,'(a,2x,i8)') " created auxiliary history alarm "//& - trim(auxfile(nfcnt)%alarmname)//" with option "//trim(hist_option)//" and frequency ",hist_n - end if + end if ! end of isPresent and isSet and if flag is on for file n end do ! end of loop over nfile @@ -1307,18 +1132,9 @@ subroutine med_phases_history_write_aux_comp(gcomp, compid, auxfile, first_time, ! Write auxiliary history files for component compid do nf = 1,num_auxfiles(compid) - ! Update clock to trigger alarm - call ESMF_ClockGet(mclock, currTime=CurrTime, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockSet(auxfile(nf)%clock, currTime=currtime) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockAdvance(auxfile(nf)%clock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockSet(auxfile(nf)%clock, currTime=currtime) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! Write auxiliary file(s) ! Determine if will write to history file + call med_phases_history_update_hclock(gcomp, auxfile(nf)%clock, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call med_phases_history_query_ifwrite(auxfile(nf)%clock, auxfile(nf)%alarmname, write_now, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1363,8 +1179,7 @@ subroutine med_phases_history_write_aux_comp(gcomp, compid, auxfile, first_time, if (ChkErr(rc,__LINE__,u_FILE_u)) return ! define data variables with a time dimension (include the nt argument below) - whead = .true.; wdata = .false. - call med_io_write(auxfile(nf)%histfile, is_local%wrap%FBimp(compid,compid), whead, wdata, nx, ny, & + call med_io_write(auxfile(nf)%histfile, is_local%wrap%FBimp(compid,compid), whead(1), wdata(1), nx, ny, & nt=auxfile(nf)%nt, pre=trim(compname(compid))//'Imp', flds=auxfile(nf)%flds, & file_ind=nf, use_float=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1378,15 +1193,14 @@ subroutine med_phases_history_write_aux_comp(gcomp, compid, auxfile, first_time, if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Write data variables for time nt - whead = .false.; wdata = .true. if (auxfile(nf)%doavg) then - call med_io_write(auxfile(nf)%histfile, auxfile(nf)%FBaccum, whead, wdata, nx, ny, & + call med_io_write(auxfile(nf)%histfile, auxfile(nf)%FBaccum, whead(2), wdata(2), nx, ny, & nt=auxfile(nf)%nt, pre=trim(compname(compid))//'Imp', flds=auxfile(nf)%flds, file_ind=nf, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call med_methods_FB_reset(auxfile(nf)%FBaccum, value=czero, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call med_io_write(auxfile(nf)%histfile, is_local%wrap%FBimp(compid,compid), whead, wdata, nx, ny, & + call med_io_write(auxfile(nf)%histfile, is_local%wrap%FBimp(compid,compid), whead(2), wdata(2), nx, ny, & nt=auxfile(nf)%nt, pre=trim(compname(compid))//'Imp', flds=auxfile(nf)%flds, file_ind=nf, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -1590,32 +1404,31 @@ subroutine med_phases_history_fldbun_average(fldbun_accum, count, rc) end subroutine med_phases_history_fldbun_average !=============================================================================== - subroutine med_phases_history_init_fldbun_accum(fldbun, scalar_name, fldbun_accum, count, rc) + subroutine med_phases_history_update_hclock(gcomp, clock, rc) - use ESMF , only : ESMF_FieldBundleIsCreated - use med_constants_mod , only : czero => med_constants_czero - use med_methods_mod , only : med_methods_FB_init - use med_methods_mod , only : med_methods_FB_reset + type(ESMF_GridComp) , intent(in) :: gcomp + type(ESMF_Clock) , intent(inout) :: clock + integer , intent(out) :: rc - ! input/output variables - type(ESMF_FieldBundle) , intent(in) :: fldbun - character(len=*) , intent(in) :: scalar_name - type(ESMF_FieldBundle) , intent(inout) :: fldbun_accum - integer , intent(out) :: count - integer , intent(out) :: rc + ! local variables + type(ESMF_CLock) :: mclock + type(ESMF_Time) :: currtime !--------------------------------------- - rc = ESMF_SUCCESS - if (ESMF_FieldBundleIsCreated(fldbun) .and. .not. ESMF_FieldBundleIsCreated(fldbun_accum)) then - call med_methods_FB_init(fldbun_accum, scalar_name, FBgeom=fldbun, FBflds=fldbun, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call med_methods_FB_reset(fldbun_accum, czero, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - count = 0 - end if + ! Update clock to trigger alarm + call NUOPC_ModelGet(gcomp, modelClock=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_ClockSet(clock, currTime=currtime) + 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) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - end subroutine med_phases_history_init_fldbun_accum + end subroutine med_phases_history_update_hclock !=============================================================================== subroutine med_phases_history_query_ifwrite(clock, alarmname, write_now, rc) @@ -1627,11 +1440,16 @@ subroutine med_phases_history_query_ifwrite(clock, alarmname, write_now, rc) integer , intent(out) :: rc ! local variables - type(ESMF_Alarm) :: alarm - type(ESMF_Time) :: starttime - type(ESMF_Time) :: currtime - type(ESMF_Time) :: nexttime - integer :: yr,mon,day,sec ! time units + type(ESMF_Alarm) :: alarm + 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 + character(len=*), parameter :: subname='(med_phases_history_query_ifwrite) ' !--------------------------------------- rc = ESMF_SUCCESS @@ -1653,75 +1471,113 @@ subroutine med_phases_history_query_ifwrite(clock, alarmname, write_now, rc) ! Write diagnostic output if (write_now) then if (mastertask .and. debug_alarms) then - call med_phases_history_output_alarminfo(clock, alarm, alarmname, rc) + + ! 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(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 + call ESMF_ClockGetNextTime(clock, nextTime=nexttime, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - write(logunit,'(a)')' alarmname = '//trim(alarmname)//' is ringing' + call ESMF_TimeGet(nexttime, yy=yr, mm=mon, dd=day, s=sec, rc=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,'(a,i8)') trim(subname)//" : history alarmname "//trim(alarmname)//& + ' is ringing, interval length is ', ringInterval_length + write(logunit,'(a)') trim(subname)//" : currtime = "//trim(currtimestr)//" nexttime = "//trim(nexttimestr) + end if + + ! output starttime, currtime and nexttime call ESMF_ClockGet(clock, startTime=StartTime, currTime=CurrTime, 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_TimeGet(nexttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - write(logunit,'(a,4(i6,2x))')' nexttime is ',yr,mon,day,sec + write(logunit,'(a,4(i6,2x))') trim(subname) //' nexttime is ',yr,mon,day,sec call ESMF_TimeGet(currtime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - write(logunit,'(a,4(i6,2x))')' currtime is ',yr,mon,day,sec + write(logunit,'(a,4(i6,2x))') trim(subname) //' currtime is ',yr,mon,day,sec call ESMF_TimeGet(starttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - write(logunit,'(a,4(i6,2x))')' starttime is ',yr,mon,day,sec + write(logunit,'(a,4(i6,2x))') trim(subname) // ' starttime is ',yr,mon,day,sec end if + end if end subroutine med_phases_history_query_ifwrite !=============================================================================== - subroutine med_phases_history_output_alarminfo(mclock, alarm, alarmname, rc) + subroutine med_phases_history_init_histclock(gcomp, hclock, alarm, alarmname, hist_option, hist_n, rc) + + use ESMF , only : ESMF_ClockCreate, ESMF_ClockGet, ESMF_ClockSet, ESMF_ClockAdvance + use ESMF , only : ESMF_AlarmSet + use med_time_mod , only : med_time_alarmInit ! input/output variables - type(ESMF_Clock), intent(in) :: mclock - type(ESMF_Alarm), intent(in) :: alarm - character(len=*), intent(in) :: alarmname - integer , intent(out) :: rc + 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_TimeInterval) :: ringInterval - integer :: ringInterval_length - type(ESMF_Time) :: currtime - type(ESMF_Time) :: nexttime - character(len=CS) :: currtimestr - character(len=CS) :: nexttimestr - integer :: yr,mon,day,sec ! time units - character(len=*), parameter :: subname='(med_phases_history_output_alarminfo)' + type(ESMF_Clock):: mclock + type(ESMF_Time) :: StartTime + type(ESMF_Time) :: CurrTime + character(len=*), parameter :: subname='(med_phases_history_init_histclock) ' !--------------------------------------- rc = ESMF_SUCCESS - call ESMF_AlarmGet(alarm, ringInterval=ringInterval, rc=rc) + ! Create history from model clock - THIS CALL DOES NOT COPY ALARMS + call NUOPC_ModelGet(gcomp, modelClock=mclock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeIntervalGet(ringInterval, s=ringinterval_length, rc=rc) + hclock = ESMF_ClockCreate(mclock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockGet(mclock, currtime=currtime, rc=rc) + + ! Initialize history alarm + call ESMF_ClockGet(hclock, startTime=StartTime, 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) + call med_time_alarmInit(hclock, alarm, option=hist_option, opt_n=hist_n, & + reftime=StartTime, alarmname=trim(alarmname), rc=rc) + + ! Advance history clock to trigger alarms then reset history clock back to mcurrtime + call ESMF_AlarmSet(alarm, clock=hclock, 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) + call ESMF_ClockAdvance(hclock,rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeGet(nexttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) + call ESMF_ClockSet(hclock, currTime=currtime) if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Write diagnostic info if (mastertask) then - write(nexttimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec - write(logunit,*) - write(logunit,'(a,i8)') trim(subname)//": history alarmname "//trim(alarmname)//& - ' is ringing, interval length is ', ringInterval_length - write(logunit,'(a)') trim(subname)//": currtime = "//trim(currtimestr)//" nexttime = "//trim(nexttimestr) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + 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_output_alarminfo + end subroutine med_phases_history_init_histclock !=============================================================================== subroutine med_phases_history_set_timeinfo(gcomp, clock, alarmname, & time_val, time_bnds, time_units, histfile, doavg, auxname, compname, rc) + 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_io_mod , only : med_io_ymd2date + use med_constants_mod , only : SecPerDay => med_constants_SecPerDay + use med_io_mod , only : med_io_date2yyyymmdd, med_io_sec2hms + ! input/output variables type(ESMF_GridComp) , intent(in) :: gcomp type(ESMF_Clock) , intent(in) :: clock @@ -1749,6 +1605,7 @@ subroutine med_phases_history_set_timeinfo(gcomp, clock, alarmname, & integer :: start_ymd ! Starting date YYYYMMDD logical :: isPresent logical :: isSet + character(len=*), parameter :: subname='(med_phases_history_set_timeinfo) ' !--------------------------------------- rc = ESMF_SUCCESS @@ -1830,8 +1687,8 @@ subroutine med_phases_history_set_timeinfo(gcomp, clock, alarmname, & 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)') "writing mediator history file "//trim(histfile) - write(logunit,' (a)') "currtime = "//trim(currtime_str)//" nexttime = "//trim(nexttime_str) + 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 From 9cb2db402acf43326a1d2974af6a5a3a1c307e77 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 9 Sep 2021 08:50:13 -0600 Subject: [PATCH 46/61] refactored history all write to use model clock --- mediator/med_phases_history_mod.F90 | 108 ++++++++++++++++++++-------- mediator/med_time_mod.F90 | 1 + 2 files changed, 80 insertions(+), 29 deletions(-) diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index aea71a8e7..6568f41ce 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -40,6 +40,8 @@ module med_phases_history_mod ! Public routines called from the run sequence public :: med_phases_history_write ! inst only - for all variables + + ! Public routine called from aoflux computation- TODO: public :: med_phases_history_write_med ! inst only - for med ! Public routines called from post phases @@ -73,7 +75,6 @@ module med_phases_history_mod character(CS) :: alarmname end type instfile_type type(instfile_type) , public :: instfiles(ncomps) - type(instfile_type) , public :: instfile_all ! ---------------------------- ! Time averaging history files @@ -143,8 +144,9 @@ subroutine med_phases_history_write(gcomp, rc) ! local variables type(InternalState) :: is_local - type(ESMF_TimeInterval) :: timestep - integer :: timestep_length + type(ESMF_Clock) :: mclock + type(ESMF_Alarm) :: alarm + 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 @@ -160,6 +162,14 @@ subroutine med_phases_history_write(gcomp, rc) 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)' !--------------------------------------- @@ -172,6 +182,8 @@ subroutine med_phases_history_write(gcomp, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + alarmname='alarm_history_inst_all' + 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 @@ -188,28 +200,83 @@ subroutine med_phases_history_write(gcomp, rc) end if ! 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 - instfile_all%alarmname = 'alarm_history_inst_all' - call med_phases_history_init_histclock(gcomp, instfile_all%clock, & - instfile_all%alarm, instfile_all%alarmname, hist_option, hist_n, rc) + + ! 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 - if (ESMF_ClockIsCreated(instfile_all%clock)) then + write_now = .false. + 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 - ! Determine if will write to history file - call ESMF_ClockAdvance(instfile_all%clock, rc=rc) + if (ESMF_AlarmIsRinging(alarm, rc=rc)) then if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_query_ifwrite(instfile_all%clock, instfile_all%alarmname, write_now, rc) + ! Set write flag to .true. + write_now = .true. + + ! Turn ringer off + call ESMF_AlarmRingerOff( alarm, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! 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_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 + + 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)//" : currtime = "//trim(currtimestr)//" nexttime = "//trim(nexttimestr) + 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, instfile_all%clock, instfile_all%alarmname, & + 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 @@ -224,7 +291,7 @@ subroutine med_phases_history_write(gcomp, rc) ! Write time values if (whead(m)) then - call ESMF_ClockGet(instfile_all%clock, calendar=calendar, rc=rc) + 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 @@ -1441,7 +1508,6 @@ subroutine med_phases_history_query_ifwrite(clock, alarmname, write_now, rc) ! local variables type(ESMF_Alarm) :: alarm - type(ESMF_Time) :: starttime type(ESMF_Time) :: currtime type(ESMF_Time) :: nexttime character(len=CS) :: currtimestr @@ -1493,21 +1559,6 @@ subroutine med_phases_history_query_ifwrite(clock, alarmname, write_now, rc) ' is ringing, interval length is ', ringInterval_length write(logunit,'(a)') trim(subname)//" : currtime = "//trim(currtimestr)//" nexttime = "//trim(nexttimestr) end if - - ! output starttime, currtime and nexttime - call ESMF_ClockGet(clock, startTime=StartTime, currTime=CurrTime, 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_TimeGet(nexttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - write(logunit,'(a,4(i6,2x))') trim(subname) //' nexttime is ',yr,mon,day,sec - call ESMF_TimeGet(currtime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - write(logunit,'(a,4(i6,2x))') trim(subname) //' currtime is ',yr,mon,day,sec - call ESMF_TimeGet(starttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - write(logunit,'(a,4(i6,2x))') trim(subname) // ' starttime is ',yr,mon,day,sec end if end if @@ -1560,7 +1611,6 @@ subroutine med_phases_history_init_histclock(gcomp, hclock, alarm, alarmname, hi ! Write diagnostic info if (mastertask) then - if (ChkErr(rc,__LINE__,u_FILE_u)) return write(logunit,'(a,2x,i8)') trim(subname) // " initialized history alarm "//& trim(alarmname)//" with option "//trim(hist_option)//" and frequency ",hist_n end if diff --git a/mediator/med_time_mod.F90 b/mediator/med_time_mod.F90 index 4866d511c..c6ab5fe3a 100644 --- a/mediator/med_time_mod.F90 +++ b/mediator/med_time_mod.F90 @@ -254,6 +254,7 @@ subroutine med_time_alarmInit( clock, alarm, option, & endif if (mastertask) then + write(logunit,*) write(logunit,'(a)') trim(subname) //' creating alarm '// trim(lalarmname) end if From ff422ba56139a7fd0b177d339569a372d78fb1ba Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 10 Sep 2021 12:18:03 -0600 Subject: [PATCH 47/61] put in call to mediator history output in med_phases_aofluxes_mod.F90 --- mediator/med.F90 | 25 +++++-------------------- mediator/med_phases_aofluxes_mod.F90 | 5 +++++ mediator/med_phases_history_mod.F90 | 20 +++++++++++--------- 3 files changed, 21 insertions(+), 29 deletions(-) diff --git a/mediator/med.F90 b/mediator/med.F90 index aed48fe0f..765d52a36 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -104,7 +104,6 @@ subroutine SetServices(gcomp, rc) use NUOPC_Mediator , only: mediator_label_SetRunClock => label_SetRunClock use NUOPC_Mediator , only: mediator_label_Finalize => label_Finalize use med_phases_history_mod , only: med_phases_history_write - use med_phases_history_mod , only: med_phases_history_write_med use med_phases_restart_mod , only: med_phases_restart_write use med_phases_prep_atm_mod , only: med_phases_prep_atm use med_phases_prep_ice_mod , only: med_phases_prep_ice @@ -206,7 +205,7 @@ subroutine SetServices(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ - ! setup mediator history phases for all output + ! setup mediator history phases for all output variables !------------------ call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & @@ -216,20 +215,6 @@ subroutine SetServices(gcomp, rc) specPhaseLabel="med_phases_history_write", specRoutine=med_phases_history_write, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - !------------------ - ! setup mediator history phases for med output - !------------------ - - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_history_write_med"/), userRoutine=mediator_routine_Run, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_history_write_med", specRoutine=med_phases_history_write_med, 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 !------------------ @@ -330,7 +315,7 @@ subroutine SetServices(gcomp, 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, & @@ -351,7 +336,7 @@ subroutine SetServices(gcomp, 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, & @@ -373,7 +358,7 @@ subroutine SetServices(gcomp, 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, & @@ -394,7 +379,7 @@ subroutine SetServices(gcomp, 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, & diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index ca2750793..15ab4fe84 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_atm ! 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 6568f41ce..a97b0b8ec 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -460,23 +460,25 @@ subroutine med_phases_history_write_med(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - ! Write fields 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 + ! 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_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 + + ! 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 From a8fa99910f78de29ac4d74b20246204a0332833f Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sat, 11 Sep 2021 22:43:09 -0600 Subject: [PATCH 48/61] more cleanup and code sharing --- mediator/med.F90 | 31 +++--- mediator/med_phases_history_mod.F90 | 110 +++++++++------------ mediator/med_phases_restart_mod.F90 | 148 +++++++++------------------- 3 files changed, 107 insertions(+), 182 deletions(-) diff --git a/mediator/med.F90 b/mediator/med.F90 index 0004897bb..c705745a4 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -39,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 @@ -2431,7 +2431,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 @@ -2452,27 +2453,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 @@ -2484,20 +2485,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 diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index a97b0b8ec..8aebfee11 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -38,12 +38,9 @@ module med_phases_history_mod implicit none private - ! Public routines called from the run sequence + ! Public routine called from the run sequence public :: med_phases_history_write ! inst only - for all variables - ! Public routine called from aoflux computation- TODO: - public :: med_phases_history_write_med ! inst only - for med - ! Public routines called from post phases public :: med_phases_history_write_atm ! inst, avg, aux for atm public :: med_phases_history_write_ice ! inst, avg, aux for ice @@ -52,16 +49,17 @@ module med_phases_history_mod public :: med_phases_history_write_ocn ! inst, avg, aux for ocn public :: med_phases_history_write_rof ! inst, avg, aux for rof public :: med_phases_history_write_wav ! inst, avg, aux for wav + public :: med_phases_history_write_med ! inst only for med aoflux and ocn albedoes ! Private routines private :: med_phases_history_write_inst_comp ! write instantaneous file for a given component private :: med_phases_history_write_avg_comp ! write averaged file for a given component private :: med_phases_history_write_aux_comp ! 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 - private :: med_phases_history_set_timeinfo - private :: med_phases_history_init_histclock ! ---------------------------- ! Instantaneous history files datatypes/variables @@ -284,6 +282,8 @@ subroutine med_phases_history_write(gcomp, rc) 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.) + + ! Loop over whead/wdata phases do m = 1,2 if (m == 2) then call med_io_enddef(hist_file) @@ -300,28 +300,29 @@ subroutine med_phases_history_write(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - ! Write import and export field bundles and mediator fields do n = 2,ncomps ! skip the mediator here + ! Write import and export field bundles if (is_local%wrap%comp_present(n)) then - nx = is_local%wrap%nx(n) - ny = is_local%wrap%ny(n) 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), nx, ny, & - nt=1, pre=trim(compname(n))//'Imp', rc=rc) + 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), nx, ny, & - nt=1, pre=trim(compname(n))//'Exp', rc=rc) + 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 fractions + ! 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 @@ -342,7 +343,7 @@ subroutine med_phases_history_write(gcomp, rc) is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_aoflux_atm', rc=rc) end if - end do ! end of loop over m + end do ! end of loop over whead/wdata m index phases ! Close file call med_io_close(hist_file, vm, rc=rc) @@ -430,9 +431,8 @@ subroutine med_phases_history_write_med(gcomp, rc) if (ESMF_ClockIsCreated(instfiles(compmed)%clock)) then ! Determine if will write to history file - call med_phases_history_update_hclock(gcomp, instfiles(compmed)%clock, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_query_ifwrite(instfiles(compmed)%clock, instfiles(compmed)%alarmname, write_now, rc) + 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 @@ -725,9 +725,7 @@ subroutine med_phases_history_write_inst_comp(gcomp, compid, instfile, first_tim if (ESMF_ClockIsCreated(instfile%clock)) then ! Determine if should write to history file - call med_phases_history_update_hclock(gcomp, instfile%clock, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_query_ifwrite(instfile%clock, instfile%alarmname, write_now, rc) + call med_phases_history_query_ifwrite(gcomp, instfile%clock, instfile%alarmname, write_now, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! If write now flag is true @@ -890,9 +888,7 @@ subroutine med_phases_history_write_avg_comp(gcomp, compid, avgfile, first_time, if (ESMF_ClockIsCreated(avgfile%clock)) then ! Determine if will write to history file - call med_phases_history_update_hclock(gcomp, avgfile%clock, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_query_ifwrite(avgfile%clock, avgfile%alarmname, write_now, rc) + call med_phases_history_query_ifwrite(gcomp, avgfile%clock, avgfile%alarmname, write_now, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Accumulate and then average if write_now flag is true @@ -1202,9 +1198,7 @@ subroutine med_phases_history_write_aux_comp(gcomp, compid, auxfile, first_time, do nf = 1,num_auxfiles(compid) ! Determine if will write to history file - call med_phases_history_update_hclock(gcomp, auxfile(nf)%clock, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_query_ifwrite(auxfile(nf)%clock, auxfile(nf)%alarmname, write_now, rc) + call med_phases_history_query_ifwrite(gcomp, auxfile(nf)%clock, auxfile(nf)%alarmname, write_now, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Do accumulation and average if required @@ -1473,42 +1467,17 @@ subroutine med_phases_history_fldbun_average(fldbun_accum, count, rc) end subroutine med_phases_history_fldbun_average !=============================================================================== - subroutine med_phases_history_update_hclock(gcomp, clock, rc) - - type(ESMF_GridComp) , intent(in) :: gcomp - type(ESMF_Clock) , intent(inout) :: clock - integer , intent(out) :: rc - - ! local variables - type(ESMF_CLock) :: mclock - type(ESMF_Time) :: currtime - !--------------------------------------- - rc = ESMF_SUCCESS - - ! Update clock to trigger alarm - call NUOPC_ModelGet(gcomp, modelClock=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_ClockSet(clock, currTime=currtime) - 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) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - end subroutine med_phases_history_update_hclock - - !=============================================================================== - subroutine med_phases_history_query_ifwrite(clock, alarmname, write_now, rc) + subroutine med_phases_history_query_ifwrite(gcomp, wclock, alarmname, write_now, rc) ! input/output variables - type(ESMF_Clock) , intent(in) :: clock - character(len=*) , intent(in) :: alarmname - logical , intent(out) :: write_now - integer , intent(out) :: rc + type(ESMF_GridComp) , intent(in) :: gcomp + type(ESMF_Clock) , intent(inout) :: wclock ! 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 type(ESMF_Alarm) :: alarm type(ESMF_Time) :: currtime type(ESMF_Time) :: nexttime @@ -1522,8 +1491,20 @@ subroutine med_phases_history_query_ifwrite(clock, alarmname, write_now, rc) rc = ESMF_SUCCESS + ! Update wclock to trigger alarm + call NUOPC_ModelGet(gcomp, modelClock=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_ClockSet(wclock, currTime=currtime) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockAdvance(wclock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockSet(wclock, currTime=currtime) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Get the history file alarm and determine if alarm is ringing - call ESMF_ClockGetAlarm(clock, alarmname=trim(alarmname), alarm=alarm, rc=rc) + call ESMF_ClockGetAlarm(wclock, 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 @@ -1539,18 +1520,15 @@ subroutine med_phases_history_query_ifwrite(clock, alarmname, write_now, rc) ! 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(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 - call ESMF_ClockGetNextTime(clock, nextTime=nexttime, rc=rc) + call ESMF_ClockGetNextTime(wclock, 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 @@ -1562,8 +1540,8 @@ subroutine med_phases_history_query_ifwrite(clock, alarmname, write_now, rc) write(logunit,'(a)') trim(subname)//" : currtime = "//trim(currtimestr)//" nexttime = "//trim(nexttimestr) end if end if - end if + end subroutine med_phases_history_query_ifwrite !=============================================================================== @@ -1591,7 +1569,7 @@ subroutine med_phases_history_init_histclock(gcomp, hclock, alarm, alarmname, hi rc = ESMF_SUCCESS - ! Create history from model clock - THIS CALL DOES NOT COPY ALARMS + ! Create history clock from model clock - THIS CALL DOES NOT COPY ALARMS call NUOPC_ModelGet(gcomp, modelClock=mclock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return hclock = ESMF_ClockCreate(mclock, rc=rc) diff --git a/mediator/med_phases_restart_mod.F90 b/mediator/med_phases_restart_mod.F90 index ae6c541bf..09ac25a73 100644 --- a/mediator/med_phases_restart_mod.F90 +++ b/mediator/med_phases_restart_mod.F90 @@ -35,7 +35,7 @@ module med_phases_restart_mod subroutine med_phases_restart_alarm_init(gcomp, rc) ! -------------------------------------- - ! Initialize mediator restart file alarms (module variables) + ! Initialize mediator restart file alarm on mediator clock ! -------------------------------------- use ESMF , only : ESMF_GridComp, ESMF_GridCompGet @@ -45,7 +45,7 @@ subroutine med_phases_restart_alarm_init(gcomp, rc) 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 ESMF , only : ESMF_Alarm, ESMF_AlarmSet use NUOPC , only : NUOPC_CompAttributeGet use NUOPC_Model , only : NUOPC_ModelGet use med_time_mod , only : med_time_AlarmInit @@ -72,61 +72,44 @@ 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 option 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 on model clock for instantaneous mediator restart output + call NUOPC_ModelGet(gcomp, modelClock=mclock, 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) + ! Advance model clock to trigger alarm then reset model clock back to currtime 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=mCurrTime, timeStep=mtimestep, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeIntervalGet(mtimestep, s=timestep_length, rc=rc) + call ESMF_ClockGet(mclock, currTime=mCurrTime, 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=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) + 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 - ! ----------------------------- - + ! Write diagnostic output if (mastertask) then write(logunit,*) + call ESMF_ClockGet(mclock, 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(logunit,100) trim(subname)//" restart clock timestep = ",timestep_length write(logunit,100) trim(subname)//" set restart alarm with option "//& trim(restart_option)//" and frequency ",restart_n @@ -138,7 +121,6 @@ subroutine med_phases_restart_alarm_init(gcomp, rc) end subroutine med_phases_restart_alarm_init !=============================================================================== - subroutine med_phases_restart_write(gcomp, rc) ! Write mediator restart @@ -324,8 +306,8 @@ subroutine med_phases_restart_write(gcomp, rc) ! 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 restart_pfile = "rpointer.cpl"//cpl_inst_tag @@ -340,7 +322,7 @@ subroutine med_phases_restart_write(gcomp, rc) do m = 1,2 if (m == 2) then - call med_io_enddef(hist_file) + call med_io_enddef(restart_file) end if tbnds = days_since @@ -358,7 +340,6 @@ subroutine med_phases_restart_write(gcomp, rc) ! 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, start_ymd, 'start_ymd', whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call med_io_write(restart_file, start_tod, 'start_tod', whead(m), wdata(m), rc=rc) @@ -397,10 +378,10 @@ subroutine med_phases_restart_write(gcomp, rc) 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, whead(m), wdata(m)(m), nx, ny, & + 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, is_local%wrap%ExpAccumOcnCnt, 'ocnExpAccum_cnt', whead(m), wdata(m), 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 @@ -408,10 +389,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, whead(m), wdata(m), nx, ny, & + 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, lndAccum2glc_cnt, 'lndImpAccum2glc_cnt', whead(m), wdata(m), 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 @@ -422,7 +403,7 @@ subroutine med_phases_restart_write(gcomp, 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(m), wdata(m), 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 @@ -485,8 +466,8 @@ subroutine med_phases_restart_read(gcomp, rc) 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 @@ -503,65 +484,46 @@ subroutine med_phases_restart_read(gcomp, rc) 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 (iam == 0) 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 call ESMF_LogWrite(trim(subname)//" read rpointer file = "//trim(restart_pfile), ESMF_LOGMSG_INFO) @@ -580,70 +542,59 @@ 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_VMGet(vm, localPet=iam, 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 - - call med_io_read(restart_file, vm, is_local%wrap%FBExpAccumCnt, 'ExpAccumCnt', rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_read(restart_file, vm, is_local%wrap%FBImpAccumCnt, 'ImpAccumCnt', rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - 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, 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, 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, is_local%wrap%FBfrac(n), pre=trim(compname(n))//'Frac', rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - endif - - ! Read export field bundle accumulator - if (ESMF_FieldBundleIsCreated(is_local%wrap%FBExpAccum(n),rc=rc)) then - call med_io_read(restart_file, vm, is_local%wrap%FBExpAccum(n), pre=trim(compname(n))//'ExpAccum', rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - endif - - ! Read import field bundle accumulator - if (ESMF_FieldBundleIsCreated(is_local%wrap%FBImpAccum(n,n),rc=rc)) then - call med_io_read(restart_file, vm, is_local%wrap%FBImpAccum(n,n), pre=trim(compname(n))//'ImpAccum', 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, is_local%wrap%FBExpAccumOcn, pre='ocnExpAccum', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + 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 glc (CESM only) if (ESMF_FieldBundleIsCreated(FBlndAccum2glc_l)) then - call med_io_read(restart_file, vm, 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, 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, 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, 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, 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 @@ -657,7 +608,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) From 76a5e4827872183ec81bd8cdc8208b125750040d Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 15 Sep 2021 15:09:38 -0600 Subject: [PATCH 49/61] fixes based on aux_glc testing --- cime_config/runseq/driver_config.py | 10 +- cime_config/runseq/runseq_TG.py | 1 + mediator/med_diag_mod.F90 | 1 - mediator/med_phases_history_mod.F90 | 237 ++++++++++++++------------- mediator/med_phases_prep_glc_mod.F90 | 91 +++++----- mediator/med_phases_restart_mod.F90 | 66 ++++---- mediator/med_time_mod.F90 | 43 +++-- 7 files changed, 226 insertions(+), 223 deletions(-) diff --git a/cime_config/runseq/driver_config.py b/cime_config/runseq/driver_config.py index c2b5556ba..e5fe2715d 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/runseq/runseq_TG.py b/cime_config/runseq/runseq_TG.py index c0bb4ab92..71afd50b2 100644 --- a/cime_config/runseq/runseq_TG.py +++ b/cime_config/runseq/runseq_TG.py @@ -23,6 +23,7 @@ def gen_runseq(case, coupling_times): run_lnd, _ , lnd_cpl_time = driver_config['lnd'] if lnd_cpl_time != glc_cpl_time: + print ("lnd_cpl_time, glc_cpl_time are {} and {}".format(lnd_cpl_time,glc_cpl_time)) expect(False,"for TG compset require that lnd_cpl_time equal glc_cpl_time") with RunSeq(os.path.join(caseroot, "CaseDocs", "nuopc.runseq")) as runseq: diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index b64c8bbf4..0d717c964 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_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 8aebfee11..7764adc6f 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -5,34 +5,24 @@ module med_phases_history_mod !----------------------------------------------------------------------------- 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_GridComp, ESMF_GridCompGet - use ESMF , only : ESMF_VM, ESMF_VMGet - use ESMF , only : ESMF_Clock, ESMF_ClockGet, ESMF_ClockSet, ESMF_ClockAdvance, ESMF_ClockCreate + 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 - use ESMF , only : ESMF_Time, ESMF_TimeGet + use ESMF , only : ESMF_Calendar, ESMF_Time, ESMF_TimeGet use ESMF , only : ESMF_TimeInterval, ESMF_TimeIntervalGet, ESMF_TimeIntervalSet - use ESMF , only : ESMF_Alarm, ESMF_AlarmCreate, ESMF_AlarmSet - use ESMF , only : ESMF_AlarmIsRinging, ESMF_AlarmRingerOff, ESMF_AlarmGet + use ESMF , only : ESMF_Alarm, ESMF_AlarmIsRinging, ESMF_AlarmRingerOff, ESMF_AlarmGet use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet - use ESMF , only : ESMF_FieldBundleIsCreated, ESMF_FieldBundleRemove 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(-), operator(+), operator(/=), operator(<=) + use ESMF , only : operator(-), operator(+) use NUOPC , only : NUOPC_CompAttributeGet use NUOPC_Model , only : NUOPC_ModelGet - use esmFlds , only : compmed, compatm, complnd, compocn, compice, comprof, compglc, compwav - use esmFlds , only : ncomps, compname, num_icesheets - use med_constants_mod , only : SecPerDay => med_constants_SecPerDay - use med_utils_mod , only : chkerr => med_utils_ChkErr - use med_methods_mod , only : med_methods_FB_reset - use med_methods_mod , only : med_methods_FB_fldchk + 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 implicit none @@ -58,7 +48,7 @@ module med_phases_history_mod 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_accum private :: med_phases_history_fldbun_average ! ---------------------------- @@ -135,6 +125,9 @@ subroutine med_phases_history_write(gcomp, rc) ! -------------------------------------- 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 @@ -229,44 +222,44 @@ subroutine med_phases_history_write(gcomp, rc) end if write_now = .false. - 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 - - if (ESMF_AlarmIsRinging(alarm, rc=rc)) then + 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 - ! Set write flag to .true. - write_now = .true. - - ! Turn ringer off - call ESMF_AlarmRingerOff( alarm, rc=rc ) + call ESMF_ClockGetAlarm(mclock, alarmname=trim(alarmname), alarm=alarm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Write diagnostic info if appropriate - if (mastertask .and. debug_alarms) then - call ESMF_AlarmGet(alarm, ringInterval=ringInterval, rc=rc) + if (ESMF_AlarmIsRinging(alarm, rc=rc)) then if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeIntervalGet(ringInterval, s=ringinterval_length, rc=rc) + ! 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 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 + ! 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_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 + 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 - 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)//" : currtime = "//trim(currtimestr)//" nexttime = "//trim(nexttimestr) + 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)//" : currtime = "//trim(currtimestr)//" nexttime = "//trim(nexttimestr) + end if end if end if @@ -301,7 +294,7 @@ subroutine med_phases_history_write(gcomp, rc) end if do n = 2,ncomps ! skip the mediator here - ! Write import and export field bundles + ! 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), & @@ -363,7 +356,9 @@ subroutine med_phases_history_write_med(gcomp, rc) ! This writes out ocean albedoes and atm/ocean fluxes computed by the mediator ! along with the fractions computed by the mediator + 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 @@ -495,6 +490,8 @@ subroutine med_phases_history_write_atm(gcomp, rc) ! Write mediator history file for atm variables + use esmFlds, only : compatm + type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc logical :: first_time = .true. @@ -517,6 +514,8 @@ subroutine med_phases_history_write_ice(gcomp, rc) ! Write mediator history file for ice variables + use esmFlds, only : compice + type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc logical :: first_time = .true. @@ -539,6 +538,8 @@ subroutine med_phases_history_write_glc(gcomp, rc) ! Write mediator history file for glc variables + use esmFlds, only : compglc, num_icesheets + type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc integer :: ns @@ -566,6 +567,8 @@ subroutine med_phases_history_write_lnd(gcomp, rc) ! Write mediator history file for lnd variables + use esmFlds, only : complnd + type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc logical :: first_time = .true. @@ -588,6 +591,8 @@ subroutine med_phases_history_write_ocn(gcomp, rc) ! Write mediator history file for ocn variables + use esmFlds, only : compocn + type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc logical :: first_time = .true. @@ -610,6 +615,8 @@ subroutine med_phases_history_write_rof(gcomp, rc) ! Write mediator history file for rof variables + use esmFlds, only : comprof + type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc logical :: first_time = .true. @@ -632,6 +639,8 @@ subroutine med_phases_history_write_wav(gcomp, rc) ! Write mediator history file for wav variables + use esmFlds, only : compwav + type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc logical :: first_time = .true. @@ -655,6 +664,7 @@ subroutine med_phases_history_write_inst_comp(gcomp, compid, instfile, first_tim ! 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 @@ -855,7 +865,7 @@ subroutine med_phases_history_write_avg_comp(gcomp, compid, avgfile, first_time, end if if (hist_option /= 'never' .and. hist_option /= 'none') then - ! Set alarm name, initialize clock and alarm for average history output and + ! 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) @@ -983,9 +993,12 @@ subroutine med_phases_history_write_aux_comp(gcomp, compid, auxfile, first_time, ! 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, med_methods_FB_reset + 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 @@ -1466,6 +1479,50 @@ subroutine med_phases_history_fldbun_average(fldbun_accum, count, rc) end subroutine med_phases_history_fldbun_average + !=============================================================================== + subroutine med_phases_history_init_histclock(gcomp, hclock, alarm, alarmname, hist_option, hist_n, rc) + + 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 + type(ESMF_Time) :: StartTime + character(len=*), parameter :: subname='(med_phases_history_init_histclock) ' + !--------------------------------------- + + rc = ESMF_SUCCESS + + ! Create history clock from model clock - THIS CALL DOES NOT COPY ALARMS + call NUOPC_ModelGet(gcomp, modelClock=mclock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + 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 ESMF_ClockGet(hclock, startTime=StartTime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + 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, wclock, alarmname, write_now, rc) @@ -1477,13 +1534,13 @@ subroutine med_phases_history_query_ifwrite(gcomp, wclock, alarmname, write_now, integer , intent(out) :: rc ! error code ! local variables - type(ESMF_Clock) :: mclock - type(ESMF_Alarm) :: alarm - 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_Clock) :: mclock ! mediator clock + type(ESMF_Alarm) :: alarm ! write alarm + type(ESMF_Time) :: currtime ! current time + type(ESMF_Time) :: nexttime ! next time + character(len=CS) :: currtimestr ! current time string + 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) ' @@ -1544,65 +1601,12 @@ subroutine med_phases_history_query_ifwrite(gcomp, wclock, alarmname, write_now, end subroutine med_phases_history_query_ifwrite - !=============================================================================== - subroutine med_phases_history_init_histclock(gcomp, hclock, alarm, alarmname, hist_option, hist_n, rc) - - use ESMF , only : ESMF_ClockCreate, ESMF_ClockGet, ESMF_ClockSet, ESMF_ClockAdvance - use ESMF , only : ESMF_AlarmSet - 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 - type(ESMF_Time) :: StartTime - type(ESMF_Time) :: CurrTime - character(len=*), parameter :: subname='(med_phases_history_init_histclock) ' - !--------------------------------------- - - rc = ESMF_SUCCESS - - ! Create history clock from model clock - THIS CALL DOES NOT COPY ALARMS - call NUOPC_ModelGet(gcomp, modelClock=mclock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - hclock = ESMF_ClockCreate(mclock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! Initialize history alarm - call ESMF_ClockGet(hclock, startTime=StartTime, currTime=CurrTime, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_time_alarmInit(hclock, alarm, option=hist_option, opt_n=hist_n, & - reftime=StartTime, alarmname=trim(alarmname), rc=rc) - - ! Advance history clock to trigger alarms then reset history clock back to mcurrtime - call ESMF_AlarmSet(alarm, clock=hclock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockAdvance(hclock,rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockSet(hclock, currTime=currtime) - 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 subroutine med_phases_history_init_histclock - !=============================================================================== subroutine med_phases_history_set_timeinfo(gcomp, clock, alarmname, & time_val, time_bnds, time_units, histfile, doavg, auxname, compname, rc) 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_ClockGet, ESMF_ClockGetNextTime, ESMF_ClockGetAlarm use ESMF , only : ESMF_AlarmGet, ESMF_TimeIntervalGet, ESMF_TimeGet use med_io_mod , only : med_io_ymd2date use med_constants_mod , only : SecPerDay => med_constants_SecPerDay @@ -1701,15 +1705,14 @@ subroutine med_phases_history_set_timeinfo(gcomp, clock, alarmname, & trim(nexttime_str),'.nc' else if (present(compname)) then if (doavg) then - hist_str = 'ha.' + hist_str = '.ha.' else - hist_str = 'hi.' + 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' + write(histfile, "(6a)") trim(case_name),'.cpl',trim(inst_tag),trim(hist_str),trim(nexttime_str),'.nc' end if if (mastertask) then diff --git a/mediator/med_phases_prep_glc_mod.F90 b/mediator/med_phases_prep_glc_mod.F90 index 2009f27fe..0fabf21ea 100644 --- a/mediator/med_phases_prep_glc_mod.F90 +++ b/mediator/med_phases_prep_glc_mod.F90 @@ -415,11 +415,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 +425,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) @@ -593,6 +545,7 @@ 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 character(len=*) , parameter :: subname=' (med_phases_prep_glc) ' !--------------------------------------- @@ -608,6 +561,48 @@ subroutine med_phases_prep_glc(gcomp, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (chkErr(rc,__LINE__,u_FILE_u)) return + 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 + ! Check time call NUOPC_ModelGet(gcomp, modelClock=med_clock, 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 09ac25a73..3c4e0defd 100644 --- a/mediator/med_phases_restart_mod.F90 +++ b/mediator/med_phases_restart_mod.F90 @@ -35,17 +35,15 @@ module med_phases_restart_mod subroutine med_phases_restart_alarm_init(gcomp, rc) ! -------------------------------------- - ! Initialize mediator restart file alarm on mediator clock + ! 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_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 ESMF , only : operator(==), operator(-) - use ESMF , only : ESMF_Alarm, ESMF_AlarmSet use NUOPC , only : NUOPC_CompAttributeGet use NUOPC_Model , only : NUOPC_ModelGet use med_time_mod , only : med_time_AlarmInit @@ -72,23 +70,29 @@ subroutine med_phases_restart_alarm_init(gcomp, rc) rc = ESMF_SUCCESS - ! Determine restart option + ! Get model clock + call NUOPC_ModelGet(gcomp, modelClock=mclock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! 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 on model clock for instantaneous mediator restart output - call NUOPC_ModelGet(gcomp, modelClock=mclock, rc=rc) + ! 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 alarm then reset model clock back to currtime - call ESMF_AlarmSet(alarm, clock=mclock, rc=rc) + call ESMF_ClockGet(mclock, currTime=mCurrTime, timeStep=mtimestep, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockGet(mclock, currTime=mCurrTime, rc=rc) + call ESMF_TimeIntervalGet(mtimestep, s=timestep_length, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_ClockAdvance(mclock,rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -96,25 +100,19 @@ subroutine med_phases_restart_alarm_init(gcomp, 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) + 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 diagnostic output + ! Write mediator diagnostic output if (mastertask) then write(logunit,*) - call ESMF_ClockGet(mclock, 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(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 @@ -129,7 +127,7 @@ 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 @@ -180,7 +178,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 - integer :: iam ! vm stuff character(ESMF_MAXSTR) :: tmpstr logical :: isPresent logical :: first_time = .true. @@ -200,10 +197,6 @@ 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) @@ -247,7 +240,7 @@ subroutine med_phases_restart_write(gcomp, rc) ! 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. @@ -301,7 +294,7 @@ 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 !--------------------------------------- @@ -309,7 +302,7 @@ subroutine med_phases_restart_write(gcomp, rc) 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') @@ -318,6 +311,8 @@ subroutine med_phases_restart_write(gcomp, rc) endif call ESMF_LogWrite(trim(subname)//": write "//trim(restart_file), ESMF_LOGMSG_INFO) + 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 @@ -452,7 +447,7 @@ subroutine med_phases_restart_write(gcomp, rc) end subroutine med_phases_restart_write - !=============================================================================== + !=============================================================================== subroutine med_phases_restart_read(gcomp, rc) ! Read mediator restart @@ -460,7 +455,7 @@ 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 @@ -478,7 +473,6 @@ subroutine med_phases_restart_read(gcomp, rc) 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 @@ -518,14 +512,14 @@ subroutine med_phases_restart_read(gcomp, rc) 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 ! 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 @@ -544,8 +538,6 @@ subroutine med_phases_restart_read(gcomp, rc) endif 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 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) diff --git a/mediator/med_time_mod.F90 b/mediator/med_time_mod.F90 index c6ab5fe3a..51e4db6e4 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 @@ -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): ' @@ -262,8 +263,23 @@ subroutine med_time_alarmInit( clock, alarm, option, & 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 @@ -274,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 @@ -282,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 From 594fd002fb04fb05e934db754d773d1d19f8f139 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 19 Sep 2021 20:05:01 -0600 Subject: [PATCH 50/61] updates to have l2x1yr aux file written --- cime_config/config_component.xml | 15 +++ cime_config/namelist_definition_drv.xml | 64 +---------- mediator/esmFlds.F90 | 1 + mediator/med.F90 | 20 +++- mediator/med_phases_history_mod.F90 | 138 +++++++++++++++++++++-- mediator/med_phases_post_lnd_mod.F90 | 16 ++- mediator/med_phases_prep_glc_mod.F90 | 144 +++++++++++++----------- 7 files changed, 258 insertions(+), 140 deletions(-) diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index cf9d450eb..5753dad3e 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -2468,6 +2468,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/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 47cafab71..5d096e126 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -1631,7 +1631,7 @@ - + logical aux_hist @@ -1696,70 +1696,18 @@ - - + + + + logical aux_hist - MED_attributes + ALLCOMP_attributes Auxiliary mediator lnd2med fields every year .false. - - char - aux_hist - MED_attributes - auxiliary file lnd2med sno fields averaged over a year - - Sl_tsrf_elev:Sl_topo_elev:Flgl_qice_elev - - - - char - aux_hist - MED_attributes - history option type - - nyears - - - - 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 - - lnd.1yr.avrg - - diff --git a/mediator/esmFlds.F90 b/mediator/esmFlds.F90 index a2bf9f98b..86a3449e4 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 c705745a4..d2b072b98 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -48,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 @@ -1682,6 +1683,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. @@ -2090,7 +2092,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 diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 7764adc6f..519e4237e 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -29,17 +29,18 @@ module med_phases_history_mod private ! Public routine called from the run sequence - public :: med_phases_history_write ! inst only - for all variables + public :: med_phases_history_write ! inst only - for all variables ! Public routines called from post phases - public :: med_phases_history_write_atm ! inst, avg, aux for atm - public :: med_phases_history_write_ice ! inst, avg, aux for ice - public :: med_phases_history_write_glc ! inst, avg, aux for glc - public :: med_phases_history_write_lnd ! inst, avg, aux for lnd - public :: med_phases_history_write_ocn ! inst, avg, aux for ocn - public :: med_phases_history_write_rof ! inst, avg, aux for rof - public :: med_phases_history_write_wav ! inst, avg, aux for wav - public :: med_phases_history_write_med ! inst only for med aoflux and ocn albedoes + public :: med_phases_history_write_atm ! inst, avg, aux for atm + public :: med_phases_history_write_ice ! inst, avg, aux for ice + public :: med_phases_history_write_glc ! inst, avg, aux for glc + public :: med_phases_history_write_lnd ! inst, avg, aux for lnd + public :: med_phases_history_write_ocn ! inst, avg, aux for ocn + public :: med_phases_history_write_rof ! inst, avg, aux for rof + public :: med_phases_history_write_wav ! inst, avg, aux for wav + 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_inst_comp ! write instantaneous file for a given component @@ -485,6 +486,121 @@ subroutine med_phases_history_write_med(gcomp, rc) 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_Clock) :: clock + type(ESMF_Time) :: starttime + type(ESMF_Time) :: currtime + type(ESMF_Time) :: nexttime + 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)' + !--------------------------------------- + + 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 + + ! Get the model clock + call NUOPC_ModelGet(gcomp, modelClock=clock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! 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 + + ! 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 + 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 + + ! 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' + + ! 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.) + + ! 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 + end do ! end of loop over m + + ! Close history file + call med_io_close(hist_file, vm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine med_phases_history_write_lnd2glc + !=============================================================================== subroutine med_phases_history_write_atm(gcomp, rc) @@ -707,7 +823,6 @@ subroutine med_phases_history_write_inst_comp(gcomp, compid, instfile, first_tim 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 ! 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 @@ -1608,9 +1723,8 @@ subroutine med_phases_history_set_timeinfo(gcomp, clock, alarmname, & 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_io_mod , only : med_io_ymd2date use med_constants_mod , only : SecPerDay => med_constants_SecPerDay - use med_io_mod , only : med_io_date2yyyymmdd, med_io_sec2hms + use med_io_mod , only : med_io_ymd2date, med_io_date2yyyymmdd, med_io_sec2hms ! input/output variables type(ESMF_GridComp) , intent(in) :: gcomp diff --git a/mediator/med_phases_post_lnd_mod.F90 b/mediator/med_phases_post_lnd_mod.F90 index 538db9779..0584e8e99 100644 --- a/mediator/med_phases_post_lnd_mod.F90 +++ b/mediator/med_phases_post_lnd_mod.F90 @@ -24,8 +24,9 @@ subroutine med_phases_post_lnd(gcomp, rc) 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 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 @@ -67,10 +68,17 @@ subroutine med_phases_post_lnd(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - ! accumulate lnd input for glc (note that lnd2glc_coupling is determined in med.F90) + ! 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 if (dbug_flag > 20) then @@ -99,7 +107,7 @@ subroutine med_phases_post_lnd_init(gcomp, rc) integer, intent(out) :: rc ! local variables - type(InternalState) :: is_local + type(InternalState) :: is_local character(len=*),parameter :: subname='(med_phases_post_lnd)' !------------------------------------------------------------------------------- diff --git a/mediator/med_phases_prep_glc_mod.F90 b/mediator/med_phases_prep_glc_mod.F90 index 0fabf21ea..3a2f688a7 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 @@ -518,13 +498,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 @@ -546,6 +528,8 @@ subroutine med_phases_prep_glc(gcomp, rc) real(r8), pointer :: data2d(:,:) => null() real(r8), pointer :: data2d_import(:,:) => null() character(len=CS) :: cvalue + logical :: isPresent, isSet + logical :: write_histaux_l2x1yrg character(len=*) , parameter :: subname=' (med_phases_prep_glc) ' !--------------------------------------- @@ -604,20 +588,24 @@ subroutine med_phases_prep_glc(gcomp, 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 (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 + 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 @@ -653,6 +641,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) @@ -717,6 +721,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 !================================================================================================ From bc07453d89f2ea4a1d3a35fc0c3aa5d004c1da43 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 20 Sep 2021 12:31:12 -0600 Subject: [PATCH 51/61] updates to clean up med_phases_prep_glc --- cime_config/buildnml | 2 +- mediator/med_phases_prep_glc_mod.F90 | 28 ++++++++++++---------------- 2 files changed, 13 insertions(+), 17 deletions(-) diff --git a/cime_config/buildnml b/cime_config/buildnml index 6bd9ffb04..f8a43852b 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -287,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/mediator/med_phases_prep_glc_mod.F90 b/mediator/med_phases_prep_glc_mod.F90 index 3a2f688a7..09c5eb8a3 100644 --- a/mediator/med_phases_prep_glc_mod.F90 +++ b/mediator/med_phases_prep_glc_mod.F90 @@ -469,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) @@ -528,6 +523,7 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) 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) ' @@ -546,7 +542,6 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) if (chkErr(rc,__LINE__,u_FILE_u)) return 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 @@ -611,21 +606,24 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) ! 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 @@ -805,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 From 6c54e3e658a4caac0c13a580e1c291db6d91b0c9 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 20 Sep 2021 13:23:26 -0600 Subject: [PATCH 52/61] added fixes for multiple ice sheets --- mediator/med_phases_post_glc_mod.F90 | 31 +++++++++++++++------------- 1 file changed, 17 insertions(+), 14 deletions(-) diff --git a/mediator/med_phases_post_glc_mod.F90 b/mediator/med_phases_post_glc_mod.F90 index 17509970e..49f541a3a 100644 --- a/mediator/med_phases_post_glc_mod.F90 +++ b/mediator/med_phases_post_glc_mod.F90 @@ -2,16 +2,16 @@ module med_phases_post_glc_mod !----------------------------------------------------------------------------- ! Mediator phase for mapping glc->lnd and glc->ocn after the receive of glc + ! ASSUMES that multiple ice sheets do not overlap !----------------------------------------------------------------------------- use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use NUOPC , only : NUOPC_CompAttributeGet - use ESMF , only : operator(/=) use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LOGMSG_ERROR, ESMF_SUCCESS, ESMF_FAILURE use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet use ESMF , only : ESMF_GridComp, ESMF_GridCompGet - use ESMF , only : ESMF_StateGet, ESMF_StateItem_Flag, ESMF_STATEITEM_NOTFOUND - use ESMF , only : ESMF_Mesh, ESMF_MeshLoc, ESMF_MESHLOC_ELEMENT, ESMF_TYPEKIND_R8 + use ESMF , only : ESMF_StateGet, ESMF_StateItem_Flag + use ESMF , only : ESMF_Mesh, ESMF_MESHLOC_ELEMENT, ESMF_TYPEKIND_R8 use ESMF , only : ESMF_Field, ESMF_FieldGet, ESMF_FieldCreate use ESMF , only : ESMF_RouteHandle, ESMF_RouteHandleIsCreated use esmFlds , only : compatm, compice, complnd, comprof, compocn, ncomps, compname @@ -30,10 +30,7 @@ module med_phases_post_glc_mod use med_internalstate_mod , only : InternalState, mastertask, logunit use med_map_mod , only : med_map_rh_is_created, med_map_routehandles_init use med_map_mod , only : med_map_field_packed, med_map_field_normalized, med_map_field - use med_merge_mod , only : med_merge_auto - use glc_elevclass_mod , only : glc_get_num_elevation_classes - use glc_elevclass_mod , only : glc_mean_elevation_virtual - use glc_elevclass_mod , only : glc_get_fractional_icecov + use glc_elevclass_mod , only : glc_mean_elevation_virtual, glc_get_fractional_icecov use perf_mod , only : t_startf, t_stopf implicit none @@ -156,7 +153,7 @@ subroutine med_phases_post_glc(gcomp, rc) end if !--------------------------------------- - ! glc->ocn mapping - + ! glc->ocn mapping ! merging with rof->ocn fields is done in med_phases_prep_ocn !--------------------------------------- if (glc2ocn_coupling) then @@ -227,7 +224,6 @@ subroutine med_phases_post_glc(gcomp, rc) end subroutine med_phases_post_glc !================================================================================================ - subroutine map_glc2lnd_init(gcomp, rc) ! input/output variables @@ -375,6 +371,7 @@ subroutine map_glc2lnd( gcomp, rc) real(r8), pointer :: topo_l_ec_sum(:,:) => null() real(r8), pointer :: dataptr1d_src(:) => null() real(r8), pointer :: dataptr1d_dst(:) => null() + real(r8), pointer :: icemask_l(:) character(len=*), parameter :: subname = 'map_glc2lnd' !----------------------------------------------------------------------- @@ -544,25 +541,31 @@ subroutine map_glc2lnd( gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call field_getdata2d(field_frac_x_icemask_l_ec, frac_x_icemask_l_ec, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + call field_getdata1d(field_icemask_l, icemask_l, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return ! set Sg_topo values in export state to land (in multiple elevation classes) ! also set the topo field for virtual columns, in a given elevation class. ! This is needed because virtual columns (i.e., elevation classes that have no ! contributing glc grid cells) won't have any topographic information mapped onto ! them, so would otherwise end up with an elevation of 0. + ! ASSUME that multiple ice sheets do not overlap do ec = 1,ungriddedCount topo_virtual = glc_mean_elevation_virtual(ec-1) ! glc_mean_elevation_virtual uses 0:glc_nec do l = 1,size(frac_x_icemask_l_ec, dim=2) - if (frac_l_ec_sum(ec,l) <= 0._r8) then - topo_l_ec_sum(ec,l) = topo_l_ec_sum(ec,l) + topo_virtual - else - if (frac_x_icemask_l_ec(ec,l) /= 0.0_r8) then - topo_l_ec_sum(ec,l) = topo_l_ec_sum(ec,l) + topo_l_ec(ec,l) / frac_x_icemask_l_ec(ec,l) + if (icemask_l(l) > 0._r8) then + if (frac_l_ec_sum(ec,l) <= 0._r8) then + topo_l_ec_sum(ec,l) = topo_l_ec_sum(ec,l) + topo_virtual + else + if (frac_x_icemask_l_ec(ec,l) /= 0.0_r8) then + topo_l_ec_sum(ec,l) = topo_l_ec_sum(ec,l) + topo_l_ec(ec,l) / frac_x_icemask_l_ec(ec,l) + end if end if end if end do end do end if + end do if (dbug_flag > 5) then From 320d751016c1168d9b9ef81c766c3501df9ad54f Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 21 Sep 2021 21:50:25 -0600 Subject: [PATCH 53/61] backed out changes to med_phases_post_gcl --- cime_config/config_component.xml | 15 ++++++++++++++ mediator/med_phases_post_glc_mod.F90 | 31 +++++++++++++--------------- 2 files changed, 29 insertions(+), 17 deletions(-) diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index 5753dad3e..49bc7d0d8 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -820,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 diff --git a/mediator/med_phases_post_glc_mod.F90 b/mediator/med_phases_post_glc_mod.F90 index 49f541a3a..17509970e 100644 --- a/mediator/med_phases_post_glc_mod.F90 +++ b/mediator/med_phases_post_glc_mod.F90 @@ -2,16 +2,16 @@ module med_phases_post_glc_mod !----------------------------------------------------------------------------- ! Mediator phase for mapping glc->lnd and glc->ocn after the receive of glc - ! ASSUMES that multiple ice sheets do not overlap !----------------------------------------------------------------------------- use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use NUOPC , only : NUOPC_CompAttributeGet + use ESMF , only : operator(/=) use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LOGMSG_ERROR, ESMF_SUCCESS, ESMF_FAILURE use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet use ESMF , only : ESMF_GridComp, ESMF_GridCompGet - use ESMF , only : ESMF_StateGet, ESMF_StateItem_Flag - use ESMF , only : ESMF_Mesh, ESMF_MESHLOC_ELEMENT, ESMF_TYPEKIND_R8 + use ESMF , only : ESMF_StateGet, ESMF_StateItem_Flag, ESMF_STATEITEM_NOTFOUND + use ESMF , only : ESMF_Mesh, ESMF_MeshLoc, ESMF_MESHLOC_ELEMENT, ESMF_TYPEKIND_R8 use ESMF , only : ESMF_Field, ESMF_FieldGet, ESMF_FieldCreate use ESMF , only : ESMF_RouteHandle, ESMF_RouteHandleIsCreated use esmFlds , only : compatm, compice, complnd, comprof, compocn, ncomps, compname @@ -30,7 +30,10 @@ module med_phases_post_glc_mod use med_internalstate_mod , only : InternalState, mastertask, logunit use med_map_mod , only : med_map_rh_is_created, med_map_routehandles_init use med_map_mod , only : med_map_field_packed, med_map_field_normalized, med_map_field - use glc_elevclass_mod , only : glc_mean_elevation_virtual, glc_get_fractional_icecov + use med_merge_mod , only : med_merge_auto + use glc_elevclass_mod , only : glc_get_num_elevation_classes + use glc_elevclass_mod , only : glc_mean_elevation_virtual + use glc_elevclass_mod , only : glc_get_fractional_icecov use perf_mod , only : t_startf, t_stopf implicit none @@ -153,7 +156,7 @@ subroutine med_phases_post_glc(gcomp, rc) end if !--------------------------------------- - ! glc->ocn mapping + ! glc->ocn mapping - ! merging with rof->ocn fields is done in med_phases_prep_ocn !--------------------------------------- if (glc2ocn_coupling) then @@ -224,6 +227,7 @@ subroutine med_phases_post_glc(gcomp, rc) end subroutine med_phases_post_glc !================================================================================================ + subroutine map_glc2lnd_init(gcomp, rc) ! input/output variables @@ -371,7 +375,6 @@ subroutine map_glc2lnd( gcomp, rc) real(r8), pointer :: topo_l_ec_sum(:,:) => null() real(r8), pointer :: dataptr1d_src(:) => null() real(r8), pointer :: dataptr1d_dst(:) => null() - real(r8), pointer :: icemask_l(:) character(len=*), parameter :: subname = 'map_glc2lnd' !----------------------------------------------------------------------- @@ -541,31 +544,25 @@ subroutine map_glc2lnd( gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call field_getdata2d(field_frac_x_icemask_l_ec, frac_x_icemask_l_ec, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call field_getdata1d(field_icemask_l, icemask_l, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return ! set Sg_topo values in export state to land (in multiple elevation classes) ! also set the topo field for virtual columns, in a given elevation class. ! This is needed because virtual columns (i.e., elevation classes that have no ! contributing glc grid cells) won't have any topographic information mapped onto ! them, so would otherwise end up with an elevation of 0. - ! ASSUME that multiple ice sheets do not overlap do ec = 1,ungriddedCount topo_virtual = glc_mean_elevation_virtual(ec-1) ! glc_mean_elevation_virtual uses 0:glc_nec do l = 1,size(frac_x_icemask_l_ec, dim=2) - if (icemask_l(l) > 0._r8) then - if (frac_l_ec_sum(ec,l) <= 0._r8) then - topo_l_ec_sum(ec,l) = topo_l_ec_sum(ec,l) + topo_virtual - else - if (frac_x_icemask_l_ec(ec,l) /= 0.0_r8) then - topo_l_ec_sum(ec,l) = topo_l_ec_sum(ec,l) + topo_l_ec(ec,l) / frac_x_icemask_l_ec(ec,l) - end if + if (frac_l_ec_sum(ec,l) <= 0._r8) then + topo_l_ec_sum(ec,l) = topo_l_ec_sum(ec,l) + topo_virtual + else + if (frac_x_icemask_l_ec(ec,l) /= 0.0_r8) then + topo_l_ec_sum(ec,l) = topo_l_ec_sum(ec,l) + topo_l_ec(ec,l) / frac_x_icemask_l_ec(ec,l) end if end if end do end do end if - end do if (dbug_flag > 5) then From efb9870f089c9a18d826c4995a348aa9b75e17c3 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 22 Sep 2021 14:27:35 -0600 Subject: [PATCH 54/61] fixed accumulation to rof from lnd restart issue --- mediator/med_phases_restart_mod.F90 | 36 ++++++++++++++++++++++------- 1 file changed, 28 insertions(+), 8 deletions(-) diff --git a/mediator/med_phases_restart_mod.F90 b/mediator/med_phases_restart_mod.F90 index 3c4e0defd..add01cfd5 100644 --- a/mediator/med_phases_restart_mod.F90 +++ b/mediator/med_phases_restart_mod.F90 @@ -4,14 +4,15 @@ module med_phases_restart_mod ! Write/Read mediator restart files !----------------------------------------------------------------------------- - 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_internalstate_mod , only : mastertask, logunit, InternalState - 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 - use med_phases_prep_glc_mod, only : FBocnAccum2glc_o, ocnAccum2glc_cnt + 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_internalstate_mod , only : mastertask, logunit, InternalState + 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 + use med_phases_prep_glc_mod , only : FBocnAccum2glc_o, ocnAccum2glc_cnt + use med_phases_prep_rof_mod , only : FBlndAccum2rof_l, lndAccum2rof_cnt implicit none private @@ -380,6 +381,18 @@ subroutine med_phases_restart_write(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif + ! Write accumulation from lnd to rof if lnd->rof coupling is on + if (ESMF_FieldBundleIsCreated(FBlndAccum2rof_l)) then + nx = is_local%wrap%nx(complnd) + ny = is_local%wrap%ny(complnd) + 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, lndAccum2rof_cnt, 'lndImpAccum2rof_cnt', whead(m), wdata(m), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + ! Write accumulation from lnd to glc if lnd->glc coupling is on if (ESMF_FieldBundleIsCreated(FBlndAccum2glc_l)) then nx = is_local%wrap%nx(complnd) @@ -570,6 +583,13 @@ subroutine med_phases_restart_read(gcomp, 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->rof, read accumulation from lnd to rof (CESM only) + if (ESMF_FieldBundleIsCreated(FBlndAccum2rof_l)) then + 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, 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, FBlndAccum2glc_l, pre='lndImpAccum2glc', rc=rc) From 6d77bc40f34ec3b49b7a953eed1a0eaa8398c685 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 23 Sep 2021 23:17:53 -0600 Subject: [PATCH 55/61] fixed issues with alarms --- mediator/med.F90 | 31 +----- mediator/med_phases_history_mod.F90 | 70 +++++++++----- mediator/med_phases_post_atm_mod.F90 | 9 +- mediator/med_phases_post_glc_mod.F90 | 9 +- mediator/med_phases_post_ice_mod.F90 | 13 ++- mediator/med_phases_post_lnd_mod.F90 | 137 +++++++++++---------------- mediator/med_phases_post_ocn_mod.F90 | 11 ++- mediator/med_phases_post_rof_mod.F90 | 11 ++- mediator/med_phases_post_wav_mod.F90 | 13 ++- 9 files changed, 161 insertions(+), 143 deletions(-) diff --git a/mediator/med.F90 b/mediator/med.F90 index d2b072b98..30513a653 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -289,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 @@ -311,9 +308,6 @@ 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/post routines for lnd @@ -332,9 +326,6 @@ 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/post routines for rof @@ -354,9 +345,6 @@ 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/post routines for wav @@ -375,9 +363,6 @@ 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/post routines for glc @@ -397,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 @@ -411,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 @@ -425,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 @@ -542,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 @@ -1647,7 +1624,7 @@ 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 @@ -2243,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 @@ -2395,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 diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 519e4237e..cb3e8b312 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -1597,8 +1597,9 @@ end subroutine med_phases_history_fldbun_average !=============================================================================== subroutine med_phases_history_init_histclock(gcomp, hclock, alarm, alarmname, hist_option, hist_n, rc) - use ESMF , only : ESMF_ClockCreate, ESMF_ClockGet, ESMF_ClockSet - use med_time_mod , only : med_time_alarmInit + 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 @@ -1610,23 +1611,46 @@ subroutine med_phases_history_init_histclock(gcomp, hclock, alarm, alarmname, hi integer , intent(out) :: rc ! local variables - type(ESMF_Clock):: mclock - type(ESMF_Time) :: StartTime + 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 - ! Create history clock from model clock - THIS CALL DOES NOT COPY ALARMS - call NUOPC_ModelGet(gcomp, modelClock=mclock, rc=rc) + 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 + + ! 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 + ! call ESMF_ClockSet(hclock, currtime=starttime, rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! call ESMF_TimeIntervalSet(htimestep, s=msec, rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! call ESMF_ClockSet(hclock, timeStep=htimestep, 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 ESMF_ClockGet(hclock, startTime=StartTime, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return call med_time_alarmInit(hclock, alarm, option=hist_option, opt_n=hist_n, & reftime=StartTime, alarmname=trim(alarmname), advance_clock=.true., rc=rc) @@ -1641,6 +1665,8 @@ end subroutine med_phases_history_init_histclock !=============================================================================== subroutine med_phases_history_query_ifwrite(gcomp, wclock, alarmname, write_now, rc) + use NUOPC_Mediator, only : NUOPC_MediatorGet + ! input/output variables type(ESMF_GridComp) , intent(in) :: gcomp type(ESMF_Clock) , intent(inout) :: wclock ! write clock @@ -1652,8 +1678,8 @@ subroutine med_phases_history_query_ifwrite(gcomp, wclock, alarmname, write_now, type(ESMF_Clock) :: mclock ! mediator clock type(ESMF_Alarm) :: alarm ! write alarm type(ESMF_Time) :: currtime ! current time - type(ESMF_Time) :: nexttime ! next 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 @@ -1664,16 +1690,8 @@ subroutine med_phases_history_query_ifwrite(gcomp, wclock, alarmname, write_now, rc = ESMF_SUCCESS ! Update wclock to trigger alarm - call NUOPC_ModelGet(gcomp, modelClock=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_ClockSet(wclock, currTime=currtime) - if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_ClockAdvance(wclock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockSet(wclock, currTime=currtime) - if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Get the history file alarm and determine if alarm is ringing call ESMF_ClockGetAlarm(wclock, alarmname=trim(alarmname), alarm=alarm, rc=rc) @@ -1697,6 +1715,8 @@ subroutine med_phases_history_query_ifwrite(gcomp, wclock, alarmname, write_now, 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(wclock, 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 @@ -1717,9 +1737,10 @@ subroutine med_phases_history_query_ifwrite(gcomp, wclock, alarmname, write_now, end subroutine med_phases_history_query_ifwrite !=============================================================================== - subroutine med_phases_history_set_timeinfo(gcomp, clock, alarmname, & + 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 @@ -1728,7 +1749,7 @@ subroutine med_phases_history_set_timeinfo(gcomp, clock, alarmname, & ! input/output variables type(ESMF_GridComp) , intent(in) :: gcomp - type(ESMF_Clock) , intent(in) :: clock + type(ESMF_Clock) , intent(in) :: hclock character(len=*) , intent(in) :: alarmname real(r8) , intent(out) :: time_val real(r8) , intent(out) :: time_bnds(2) @@ -1740,6 +1761,7 @@ subroutine med_phases_history_set_timeinfo(gcomp, clock, alarmname, & integer , intent(out) :: rc ! local variables + type(ESMF_Clock) :: mclock type(ESMF_Alarm) :: alarm type(ESMF_Time) :: starttime type(ESMF_Time) :: currtime @@ -1758,10 +1780,12 @@ subroutine med_phases_history_set_timeinfo(gcomp, clock, alarmname, & rc = ESMF_SUCCESS - ! Determine starttime, currtime and nexttime - call ESMF_ClockGet(clock, currtime=currtime, starttime=starttime, rc=rc) + ! 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_ClockGetNextTime(clock, nextTime=nexttime, rc=rc) + 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 @@ -1773,7 +1797,7 @@ subroutine med_phases_history_set_timeinfo(gcomp, clock, alarmname, & ! Set time bounds and time coord if (doavg) then - call ESMF_ClockGetAlarm(clock, alarmname=trim(alarmname), alarm=alarm, rc=rc) + 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 diff --git a/mediator/med_phases_post_atm_mod.F90 b/mediator/med_phases_post_atm_mod.F90 index 3b668a575..f2a029cd4 100644 --- a/mediator/med_phases_post_atm_mod.F90 +++ b/mediator/med_phases_post_atm_mod.F90 @@ -22,6 +22,8 @@ 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 @@ -39,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)' !------------------------------------------------------------------------------- @@ -95,8 +98,12 @@ subroutine med_phases_post_atm(gcomp, rc) end if ! Write atm inst, avg or aux if requested in mediator attributes - call med_phases_history_write_atm(gcomp, rc=rc) + 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_atm(gcomp, 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) diff --git a/mediator/med_phases_post_glc_mod.F90 b/mediator/med_phases_post_glc_mod.F90 index 17509970e..1150f3939 100644 --- a/mediator/med_phases_post_glc_mod.F90 +++ b/mediator/med_phases_post_glc_mod.F90 @@ -85,6 +85,8 @@ 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_glc ! input/output variables @@ -92,6 +94,7 @@ subroutine med_phases_post_glc(gcomp, rc) integer, intent(out) :: rc ! local variables + type(ESMF_Clock) :: dClock type(ESMF_StateItem_Flag) :: itemType type(InternalState) :: is_local integer :: n1,ncnt,ns @@ -216,8 +219,12 @@ subroutine med_phases_post_glc(gcomp, rc) first_call = .false. ! Write glc inst, avg or aux if requested in mediator attributes - call med_phases_history_write_glc(gcomp, rc=rc) + 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_glc(gcomp, 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) diff --git a/mediator/med_phases_post_ice_mod.F90 b/mediator/med_phases_post_ice_mod.F90 index 0961f9243..865df9108 100644 --- a/mediator/med_phases_post_ice_mod.F90 +++ b/mediator/med_phases_post_ice_mod.F90 @@ -18,9 +18,11 @@ 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 @@ -36,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)' !------------------------------------------------------------------------------- @@ -96,8 +99,12 @@ subroutine med_phases_post_ice(gcomp, rc) end if ! Write ice inst, avg or aux if requested in mediator attributes - call med_phases_history_write_ice(gcomp, rc=rc) + 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_ice(gcomp, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if call t_stopf('MED:'//subname) if (dbug_flag > 20) then diff --git a/mediator/med_phases_post_lnd_mod.F90 b/mediator/med_phases_post_lnd_mod.F90 index 0584e8e99..43697b0bd 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,9 +14,11 @@ 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 @@ -25,6 +26,7 @@ subroutine med_phases_post_lnd(gcomp, rc) 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, med_phases_prep_glc_avg + use med_phases_history_mod , only : med_phases_history_write_lnd use esmFlds , only : complnd, compatm, comprof, compglc, num_icesheets use esmFlds , only : lnd2glc_coupling, accum_lnd2glc use perf_mod , only : t_startf, t_stopf @@ -35,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)' !------------------------------------------------------------------------------- @@ -50,89 +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 + call NUOPC_MediatorGet(gcomp, driverClock=dClock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! accumulate lnd input for rof - if (is_local%wrap%med_coupling_active(complnd,comprof)) then - call med_phases_prep_rof_accum(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_lnd(gcomp, rc=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 + else - 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 + ! 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 - !=============================================================================== - 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)' - !------------------------------------------------------------------------------- - - call t_startf('MED:'//subname) - rc = ESMF_SUCCESS - - 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 @@ -140,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 a29d9e9f4..22e66dc51 100644 --- a/mediator/med_phases_post_ocn_mod.F90 +++ b/mediator/med_phases_post_ocn_mod.F90 @@ -20,9 +20,11 @@ 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 @@ -39,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)' !--------------------------------------- @@ -85,8 +88,12 @@ subroutine med_phases_post_ocn(gcomp, rc) end if ! Write ocn inst, avg or aux if requested in mediator attributes - call med_phases_history_write_ocn(gcomp, rc=rc) + 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_ocn(gcomp, 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) diff --git a/mediator/med_phases_post_rof_mod.F90 b/mediator/med_phases_post_rof_mod.F90 index 16990ce8d..93849ebcc 100644 --- a/mediator/med_phases_post_rof_mod.F90 +++ b/mediator/med_phases_post_rof_mod.F90 @@ -16,9 +16,11 @@ 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 @@ -33,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)' !--------------------------------------- @@ -88,8 +91,12 @@ subroutine med_phases_post_rof(gcomp, rc) end if ! Write rof inst, avg or aux if requested in mediator attributes - call med_phases_history_write_rof(gcomp, rc=rc) + 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_rof(gcomp, 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) diff --git a/mediator/med_phases_post_wav_mod.F90 b/mediator/med_phases_post_wav_mod.F90 index ee9e9d129..df2a67f87 100644 --- a/mediator/med_phases_post_wav_mod.F90 +++ b/mediator/med_phases_post_wav_mod.F90 @@ -14,9 +14,11 @@ 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 @@ -31,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)' !------------------------------------------------------------------------------- @@ -82,8 +85,12 @@ subroutine med_phases_post_wav(gcomp, rc) end if ! Write atm inst, avg or aux if requested in mediator attributes - call med_phases_history_write_wav(gcomp, rc=rc) + 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_wav(gcomp, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if call t_stopf('MED:'//subname) if (dbug_flag > 20) then From f5a319e67830f8d3313821da476a3498796ffc37 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 24 Sep 2021 19:30:36 -0600 Subject: [PATCH 56/61] refatored inst output mode --- mediator/med_phases_history_mod.F90 | 220 +++++---------------------- mediator/med_phases_post_atm_mod.F90 | 4 +- mediator/med_phases_post_glc_mod.F90 | 8 +- mediator/med_phases_post_ice_mod.F90 | 4 +- mediator/med_phases_post_lnd_mod.F90 | 4 +- mediator/med_phases_post_ocn_mod.F90 | 4 +- mediator/med_phases_post_rof_mod.F90 | 4 +- mediator/med_phases_post_wav_mod.F90 | 4 +- 8 files changed, 58 insertions(+), 194 deletions(-) diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index cb3e8b312..052f8ec47 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -32,20 +32,14 @@ module med_phases_history_mod public :: med_phases_history_write ! inst only - for all variables ! Public routines called from post phases - public :: med_phases_history_write_atm ! inst, avg, aux for atm - public :: med_phases_history_write_ice ! inst, avg, aux for ice - public :: med_phases_history_write_glc ! inst, avg, aux for glc - public :: med_phases_history_write_lnd ! inst, avg, aux for lnd - public :: med_phases_history_write_ocn ! inst, avg, aux for ocn - public :: med_phases_history_write_rof ! inst, avg, aux for rof - public :: med_phases_history_write_wav ! inst, avg, aux for wav + 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_inst_comp ! write instantaneous file for a given component - private :: med_phases_history_write_avg_comp ! write averaged file for a given component - private :: med_phases_history_write_aux_comp ! write auxiliary file for a given component + 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 @@ -62,6 +56,8 @@ module med_phases_history_mod 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) @@ -602,180 +598,33 @@ subroutine med_phases_history_write_lnd2glc(gcomp, fldbun, rc) end subroutine med_phases_history_write_lnd2glc !=============================================================================== - subroutine med_phases_history_write_atm(gcomp, rc) + subroutine med_phases_history_write_comp(gcomp, compid, rc) ! Write mediator history file for atm variables - use esmFlds, only : compatm - - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc + type(ESMF_GridComp), intent(inout) :: gcomp + integer , intent(in) :: compid + integer , intent(out) :: rc + ! loal variables logical :: first_time = .true. !--------------------------------------- rc = ESMF_SUCCESS - call med_phases_history_write_inst_comp(gcomp, compatm, instfiles(compatm), & - first_time, 'med_phases_history_write_inst_atm', rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_write_avg_comp(gcomp, compatm, avgfiles(compatm), & - first_time, 'med_phases_history_write_avg_atm', rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_write_aux_comp(gcomp, compatm, auxfiles(:,compatm), & - first_time, 'med_phases_history_write_aux_atm', rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (first_time) first_time = .false. - end subroutine med_phases_history_write_atm - - !=============================================================================== - subroutine med_phases_history_write_ice(gcomp, rc) - ! Write mediator history file for ice variables - - use esmFlds, only : compice - - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - logical :: first_time = .true. - !--------------------------------------- - rc = ESMF_SUCCESS - call med_phases_history_write_inst_comp(gcomp, compice, instfiles(compice), & - first_time, 'med_phases_history_write_inst_ice', rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_write_avg_comp(gcomp, compice, avgfiles(compice), & - first_time, 'med_phases_history_write_avg_ice', rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_write_aux_comp(gcomp, compice, auxfiles(:,compice), & - first_time, 'med_phases_history_write_aux_ice', rc) + call med_phases_history_write_comp_inst(gcomp, compid, instfiles(compid), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (first_time) first_time = .false. - end subroutine med_phases_history_write_ice - - !=============================================================================== - subroutine med_phases_history_write_glc(gcomp, rc) - - ! Write mediator history file for glc variables - - use esmFlds, only : compglc, num_icesheets - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - integer :: ns - character(len=CS) :: cns - logical :: first_time = .true. - !--------------------------------------- - rc = ESMF_SUCCESS - do ns = 1,num_icesheets - write(cns,*) ns - call med_phases_history_write_inst_comp(gcomp, compglc(ns), instfiles(compglc(ns)), & - first_time, 'med_phases_history_write_inst_glc'//trim(cns), rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_write_avg_comp(gcomp, compglc(ns), avgfiles(compglc(ns)), & - first_time, 'med_phases_history_write_avg_glc'//trim(cns), rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_write_aux_comp(gcomp, compglc(ns), auxfiles(:,compglc(ns)), & - first_time, 'med_phases_history_write_aux_glc'//trim(cns), rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end do - if (first_time) first_time = .false. - end subroutine med_phases_history_write_glc - - !=============================================================================== - subroutine med_phases_history_write_lnd(gcomp, rc) - - ! Write mediator history file for lnd variables - - use esmFlds, only : complnd - - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - logical :: first_time = .true. - !--------------------------------------- - rc = ESMF_SUCCESS - call med_phases_history_write_inst_comp(gcomp, complnd, instfiles(complnd), & - first_time, 'med_phases_history_write_inst_lnd', rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_write_avg_comp(gcomp, complnd, avgfiles(complnd), & - first_time, 'med_phases_history_write_avg_lnd', rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_write_aux_comp(gcomp, complnd, auxfiles(:,complnd), & - first_time, 'med_phases_history_write_aux_lnd', rc) + call med_phases_history_write_comp_avg(gcomp, compid, avgfiles(compid), first_time, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (first_time) first_time = .false. - end subroutine med_phases_history_write_lnd - - !=============================================================================== - subroutine med_phases_history_write_ocn(gcomp, rc) - ! Write mediator history file for ocn variables - - use esmFlds, only : compocn - - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - logical :: first_time = .true. - !--------------------------------------- - rc = ESMF_SUCCESS - call med_phases_history_write_inst_comp(gcomp, compocn, instfiles(compocn), & - first_time, 'med_phases_history_write_inst_ocn', rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_write_avg_comp(gcomp, compocn, avgfiles(compocn), & - first_time, 'med_phases_history_write_avg_ocn', rc) + call med_phases_history_write_comp_aux(gcomp, compid, auxfiles(:,compid), first_time, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_write_aux_comp(gcomp, compocn, auxfiles(:,compocn), & - first_time, 'med_phases_history_write_aux_ocn', rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (first_time) first_time = .false. - end subroutine med_phases_history_write_ocn - - !=============================================================================== - subroutine med_phases_history_write_rof(gcomp, rc) - - ! Write mediator history file for rof variables - - use esmFlds, only : comprof - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - logical :: first_time = .true. - !--------------------------------------- - rc = ESMF_SUCCESS - call med_phases_history_write_inst_comp(gcomp, comprof, instfiles(comprof), & - first_time, 'med_phases_history_write_inst_rof', rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_write_avg_comp(gcomp, comprof, avgfiles(comprof), & - first_time, 'med_phases_history_write_avg_rof', rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_write_aux_comp(gcomp, comprof, auxfiles(:,comprof), & - first_time, 'med_phases_history_write_aux_rof', rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return if (first_time) first_time = .false. - end subroutine med_phases_history_write_rof - - !=============================================================================== - subroutine med_phases_history_write_wav(gcomp, rc) - - ! Write mediator history file for wav variables - use esmFlds, only : compwav - - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - logical :: first_time = .true. - !--------------------------------------- - rc = ESMF_SUCCESS - call med_phases_history_write_inst_comp(gcomp, compwav, instfiles(compwav), & - first_time, 'med_phases_history_write_inst_wav', rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_write_avg_comp(gcomp, compwav, avgfiles(compwav), & - first_time, 'med_phases_history_write_avg_wav', rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_history_write_aux_comp(gcomp, compwav, auxfiles(:,compwav), & - first_time, 'med_phases_history_write_aux_wav', rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (first_time) first_time = .false. - end subroutine med_phases_history_write_wav + end subroutine med_phases_history_write_comp !=============================================================================== - subroutine med_phases_history_write_inst_comp(gcomp, compid, instfile, first_time, subname, rc) + subroutine med_phases_history_write_comp_inst(gcomp, compid, instfile, rc) ! Write instantaneous mediator history file for component compid @@ -785,9 +634,7 @@ subroutine med_phases_history_write_inst_comp(gcomp, compid, instfile, first_tim ! input/output variables type(ESMF_GridComp) , intent(inout) :: gcomp integer , intent(in) :: compid - logical , intent(in) :: first_time type(instfile_type) , intent(inout) :: instfile - character(len=*) , intent(in) :: subname integer , intent(out) :: rc ! local variables @@ -809,6 +656,7 @@ subroutine med_phases_history_write_inst_comp(gcomp, compid, instfile, first_tim 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)' !--------------------------------------- rc = ESMF_SUCCESS @@ -818,7 +666,9 @@ subroutine med_phases_history_write_inst_comp(gcomp, compid, instfile, first_tim call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (first_time) then + ! 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' @@ -844,10 +694,22 @@ subroutine med_phases_history_write_inst_comp(gcomp, compid, instfile, first_tim 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 first_time if-block + end if ! end of if-clock set if block + + ! if history file is not active then return + if (.not. instfile%is_active) then + RETURN + end if - if (ESMF_ClockIsCreated(instfile%clock)) then + ! 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) @@ -909,10 +771,10 @@ subroutine med_phases_history_write_inst_comp(gcomp, compid, instfile, first_tim call t_stopf('MED:'//subname) - end subroutine med_phases_history_write_inst_comp + end subroutine med_phases_history_write_comp_inst !=============================================================================== - subroutine med_phases_history_write_avg_comp(gcomp, compid, avgfile, first_time, subname, rc) + subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, first_time, rc) ! Write mediator average history file variables for component compid @@ -926,7 +788,6 @@ subroutine med_phases_history_write_avg_comp(gcomp, compid, avgfile, first_time, integer , intent(in) :: compid type(avgfile_type) , intent(inout) :: avgfile logical , intent(in) :: first_time - character(len=*) , intent(in) :: subname integer , intent(out) :: rc ! local variables @@ -949,6 +810,7 @@ subroutine med_phases_history_write_avg_comp(gcomp, compid, avgfile, first_time, 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)' !--------------------------------------- rc = ESMF_SUCCESS @@ -1095,10 +957,10 @@ subroutine med_phases_history_write_avg_comp(gcomp, compid, avgfile, first_time, call t_stopf('MED:'//subname) - end subroutine med_phases_history_write_avg_comp + end subroutine med_phases_history_write_comp_avg !=============================================================================== - subroutine med_phases_history_write_aux_comp(gcomp, compid, auxfile, first_time, subname, rc) + subroutine med_phases_history_write_comp_aux(gcomp, compid, auxfile, first_time, rc) ! ----------------------------- ! Write mediator auxiliary history file for component compid @@ -1120,7 +982,6 @@ subroutine med_phases_history_write_aux_comp(gcomp, compid, auxfile, first_time, integer , intent(in) :: compid type(auxfile_type) , intent(inout) :: auxfile(:) logical , intent(in) :: first_time - character(len=*) , intent(in) :: subname integer , intent(out) :: rc ! local variables @@ -1149,6 +1010,7 @@ subroutine med_phases_history_write_aux_comp(gcomp, compid, auxfile, first_time, 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 @@ -1474,7 +1336,7 @@ subroutine get_auxflds(str, flds, rc) end do end subroutine get_auxflds - end subroutine med_phases_history_write_aux_comp + end subroutine med_phases_history_write_comp_aux !=============================================================================== subroutine med_phases_history_fldbun_accum(fldbun, fldbun_accum, count, rc) diff --git a/mediator/med_phases_post_atm_mod.F90 b/mediator/med_phases_post_atm_mod.F90 index f2a029cd4..acf1c2298 100644 --- a/mediator/med_phases_post_atm_mod.F90 +++ b/mediator/med_phases_post_atm_mod.F90 @@ -28,7 +28,7 @@ subroutine med_phases_post_atm(gcomp, rc) 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_atm + 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 @@ -101,7 +101,7 @@ subroutine med_phases_post_atm(gcomp, rc) 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_atm(gcomp, rc=rc) + call med_phases_history_write_comp(gcomp, compatm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if diff --git a/mediator/med_phases_post_glc_mod.F90 b/mediator/med_phases_post_glc_mod.F90 index 1150f3939..4dd1e1ef8 100644 --- a/mediator/med_phases_post_glc_mod.F90 +++ b/mediator/med_phases_post_glc_mod.F90 @@ -87,7 +87,7 @@ 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_glc + use med_phases_history_mod, only : med_phases_history_write_comp ! input/output variables type(ESMF_GridComp) :: gcomp @@ -222,8 +222,10 @@ subroutine med_phases_post_glc(gcomp, rc) 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_glc(gcomp, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + 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 diff --git a/mediator/med_phases_post_ice_mod.F90 b/mediator/med_phases_post_ice_mod.F90 index 865df9108..2daa4c358 100644 --- a/mediator/med_phases_post_ice_mod.F90 +++ b/mediator/med_phases_post_ice_mod.F90 @@ -29,7 +29,7 @@ subroutine med_phases_post_ice(gcomp, rc) 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_ice + 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 @@ -102,7 +102,7 @@ subroutine med_phases_post_ice(gcomp, rc) 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_ice(gcomp, rc=rc) + call med_phases_history_write_comp(gcomp, compice, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if diff --git a/mediator/med_phases_post_lnd_mod.F90 b/mediator/med_phases_post_lnd_mod.F90 index 43697b0bd..1bd416c77 100644 --- a/mediator/med_phases_post_lnd_mod.F90 +++ b/mediator/med_phases_post_lnd_mod.F90 @@ -26,7 +26,7 @@ subroutine med_phases_post_lnd(gcomp, rc) 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, med_phases_prep_glc_avg - use med_phases_history_mod , only : med_phases_history_write_lnd + 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 @@ -91,7 +91,7 @@ subroutine med_phases_post_lnd(gcomp, rc) end if ! Write lnd inst, avg or aux if requested in mediator attributes - call med_phases_history_write_lnd(gcomp, rc=rc) + call med_phases_history_write_comp(gcomp, complnd, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else diff --git a/mediator/med_phases_post_ocn_mod.F90 b/mediator/med_phases_post_ocn_mod.F90 index 22e66dc51..c51f9eecf 100644 --- a/mediator/med_phases_post_ocn_mod.F90 +++ b/mediator/med_phases_post_ocn_mod.F90 @@ -29,7 +29,7 @@ subroutine med_phases_post_ocn(gcomp, rc) 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_ocn + 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 @@ -91,7 +91,7 @@ subroutine med_phases_post_ocn(gcomp, rc) 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_ocn(gcomp, rc=rc) + call med_phases_history_write_comp(gcomp, compocn, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if diff --git a/mediator/med_phases_post_rof_mod.F90 b/mediator/med_phases_post_rof_mod.F90 index 93849ebcc..10ca7bfc7 100644 --- a/mediator/med_phases_post_rof_mod.F90 +++ b/mediator/med_phases_post_rof_mod.F90 @@ -25,7 +25,7 @@ subroutine med_phases_post_rof(gcomp, rc) 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_rof + 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 @@ -94,7 +94,7 @@ subroutine med_phases_post_rof(gcomp, rc) 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_rof(gcomp, rc=rc) + call med_phases_history_write_comp(gcomp, comprof, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if diff --git a/mediator/med_phases_post_wav_mod.F90 b/mediator/med_phases_post_wav_mod.F90 index df2a67f87..a1bf805ef 100644 --- a/mediator/med_phases_post_wav_mod.F90 +++ b/mediator/med_phases_post_wav_mod.F90 @@ -24,7 +24,7 @@ subroutine med_phases_post_wav(gcomp, rc) 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_wav + 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 @@ -88,7 +88,7 @@ subroutine med_phases_post_wav(gcomp, rc) 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_wav(gcomp, rc=rc) + call med_phases_history_write_comp(gcomp, compwav, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if From 313f0f3b62023e49aad6374f766c2a2d1bca4dcb Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sat, 25 Sep 2021 14:47:00 -0600 Subject: [PATCH 57/61] refactored aux and avg history files and restart output --- cime_config/namelist_definition_drv.xml | 28 ++++ mediator/med.F90 | 2 +- mediator/med_phases_history_mod.F90 | 189 +++++++++++++----------- mediator/med_phases_restart_mod.F90 | 16 +- 4 files changed, 141 insertions(+), 94 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 5d096e126..e909eaf9b 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -1096,6 +1096,34 @@ + + + + + + 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 + + + diff --git a/mediator/med.F90 b/mediator/med.F90 index 30513a653..01296577b 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -1630,7 +1630,7 @@ subroutine DataInitialize(gcomp, rc) 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 diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 052f8ec47..c0a724a99 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -75,13 +75,14 @@ module med_phases_history_mod 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 ! ---------------------------- - integer, parameter :: max_auxfiles = 10 type, public :: auxfile_type character(CS), allocatable :: flds(:) ! array of aux field names character(CS) :: auxname ! name for history file creation @@ -95,8 +96,16 @@ module med_phases_history_mod type(ESMF_Alarm) :: alarm ! auxfile alarm character(CS) :: alarmname ! name of write alarm end type auxfile_type - integer , public :: num_auxfiles(ncomps) = 0 - type(auxfile_type) , public :: auxfiles(max_auxfiles,ncomps) + + 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 @@ -372,7 +381,6 @@ subroutine med_phases_history_write_med(gcomp, rc) 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(CL) :: cvalue ! attribute string character(CL) :: hist_option ! freq_option setting (ndays, nsteps, etc) integer :: hist_n ! freq_n setting relative to freq_option @@ -380,7 +388,6 @@ subroutine med_phases_history_write_med(gcomp, rc) character(CL) :: hist_n_in logical :: isPresent logical :: isSet - logical :: first_time = .true. character(len=*), parameter :: subname='(med_phases_history_write_med)' !--------------------------------------- rc = ESMF_SUCCESS @@ -390,7 +397,8 @@ subroutine med_phases_history_write_med(gcomp, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (first_time) then + ! 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' @@ -416,11 +424,17 @@ subroutine med_phases_history_write_med(gcomp, rc) 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 - first_time = .false. end if - if (ESMF_ClockIsCreated(instfiles(compmed)%clock)) then + ! 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, & @@ -477,8 +491,8 @@ subroutine med_phases_history_write_med(gcomp, rc) 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 clockiscreated if-block + end if ! end of if-write_now block + end if ! end of if-active block end subroutine med_phases_history_write_med @@ -602,25 +616,20 @@ 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 - ! loal variables - logical :: first_time = .true. !--------------------------------------- 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), first_time, rc=rc) + 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, auxfiles(:,compid), first_time, rc=rc) + call med_phases_history_write_comp_aux(gcomp, compid, auxcomp(compid), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (first_time) first_time = .false. - end subroutine med_phases_history_write_comp !=============================================================================== @@ -703,11 +712,6 @@ subroutine med_phases_history_write_comp_inst(gcomp, compid, instfile, rc) end if end if ! end of if-clock set if block - ! if history file is not active then return - if (.not. instfile%is_active) then - RETURN - end if - ! if history file is active and history clock is initialized - process history file if (instfile%is_active .and. instfile%is_clockset) then @@ -774,7 +778,7 @@ subroutine med_phases_history_write_comp_inst(gcomp, compid, instfile, rc) end subroutine med_phases_history_write_comp_inst !=============================================================================== - subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, first_time, rc) + subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) ! Write mediator average history file variables for component compid @@ -787,7 +791,6 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, first_time, type(ESMF_GridComp) , intent(inout) :: gcomp integer , intent(in) :: compid type(avgfile_type) , intent(inout) :: avgfile - logical , intent(in) :: first_time integer , intent(out) :: rc ! local variables @@ -821,7 +824,8 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, first_time, call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (first_time) then + ! 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' @@ -848,6 +852,9 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, first_time, 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. & @@ -868,11 +875,18 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, first_time, if (chkerr(rc,__LINE__,u_FILE_u)) return avgfile%accumcnt_export = 0 end if - end if - end if ! end of initialization (first_time) if block + else - if (ESMF_ClockIsCreated(avgfile%clock)) then + avgfile%is_active = .false. + ! this is set to true here even if history file is not active + avgfile%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 (avgfile%is_active .and. avgfile%is_clockset) then ! Determine if will write to history file call med_phases_history_query_ifwrite(gcomp, avgfile%clock, avgfile%alarmname, write_now, rc) @@ -960,10 +974,10 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, first_time, end subroutine med_phases_history_write_comp_avg !=============================================================================== - subroutine med_phases_history_write_comp_aux(gcomp, compid, auxfile, first_time, rc) + subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc) ! ----------------------------- - ! Write mediator auxiliary history file for component compid + ! 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 @@ -980,8 +994,7 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxfile, first_time, ! input/output variables type(ESMF_GridComp) , intent(inout) :: gcomp integer , intent(in) :: compid - type(auxfile_type) , intent(inout) :: auxfile(:) - logical , intent(in) :: first_time + type(auxcomp_type) , intent(inout) :: auxcomp integer , intent(out) :: rc ! local variables @@ -1021,7 +1034,7 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxfile, first_time, call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (first_time) then + if (.not. auxcomp%init_auxfiles) then ! Initialize number of aux files for this component to zero nfcnt = 0 @@ -1040,7 +1053,7 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxfile, first_time, enable_auxfile = .false. end if - ! If file will be written - then initialize auxfiles(nfcnt) + ! If file will be written - then initialize auxcomp%files(nfcnt) if (enable_auxfile) then ! Increment nfcnt nfcnt = nfcnt + 1 @@ -1048,13 +1061,13 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxfile, first_time, ! 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,*) auxfile(nfcnt)%ntperfile + 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,*) auxfile(nfcnt)%doavg + 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) @@ -1066,8 +1079,8 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxfile, first_time, ! 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(auxfile(nfcnt)%flds(fieldcount)) - call ESMF_FieldBundleGet(is_local%wrap%FBImp(compid,compid), fieldNameList=auxfile(nfcnt)%flds, rc=rc) + 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 @@ -1089,10 +1102,10 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxfile, first_time, end if end do - ! Create auxfile(nfcnt)%flds array - allocate(auxfile(nfcnt)%flds(fieldcount)) + ! Create auxcomp%files(nfcnt)%flds array + allocate(auxcomp%files(nfcnt)%flds(fieldcount)) do n = 1,fieldcount - auxfile(nfcnt)%flds(n) = trim(fieldnamelist(n)) + auxcomp%files(nfcnt)%flds(n) = trim(fieldnamelist(n)) end do ! Deallocate memory from fieldnamelist @@ -1104,24 +1117,24 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxfile, first_time, 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(auxfile(nfcnt)%flds) - write(logunit,'(8x,a)') trim(auxfile(nfcnt)%flds(nfld)) + 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 (auxfile(nfcnt)%doavg) then + 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(auxfile(nfcnt)%FBaccum)) then - call med_methods_FB_init(auxfile(nfcnt)%FBaccum, is_local%wrap%flds_scalar_name, & + 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(auxfile(nfcnt)%FBaccum, czero, rc=rc) + call med_methods_FB_reset(auxcomp%files(nfcnt)%FBaccum, czero, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - auxfile(nfcnt)%accumcnt = 0 + auxcomp%files(nfcnt)%accumcnt = 0 end if ! Now remove all fields from FBAccum that are not in the input flds list @@ -1132,24 +1145,24 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxfile, first_time, if (chkerr(rc,__LINE__,u_FILE_u)) return do n = 1,size(fieldnamelist) found = .false. - do n1 = 1,size(auxfile(nfcnt)%flds) - if (trim(fieldnamelist(n)) == trim(auxfile(nfcnt)%flds(n1))) then + 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(auxfile(nfcnt)%FBaccum, fieldnamelist(n:n), rc=rc) + 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(auxfile(nfcnt)%FBAccum, fieldCount=nfld, rc=rc) + 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(auxfile(nfcnt)%auxname), & + 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 @@ -1166,38 +1179,41 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxfile, first_time, if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) hist_n - ! Determine auxfile%alarmname - call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_auxname', value=auxfile(nfcnt)%auxname, rc=rc) + ! 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(auxfile(nfcnt)%alarmname,'(a,i0)') 'alarm_'//trim(prefix) + 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, auxfile(nfcnt)%clock, & - auxfile(nfcnt)%alarm, auxfile(nfcnt)%alarmname, hist_option, hist_n, rc) + 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 - num_auxfiles(compid) = nfcnt + auxcomp%num_auxfiles = nfcnt + + ! Set initialization flags to .true. + auxcomp%init_auxfiles = .true. - end if ! end of initialization (first time) block + end if ! end of initialization if-block ! Write auxiliary history files for component compid - do nf = 1,num_auxfiles(compid) + do nf = 1,auxcomp%num_auxfiles ! Determine if will write to history file - call med_phases_history_query_ifwrite(gcomp, auxfile(nf)%clock, auxfile(nf)%alarmname, write_now, rc) + 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 (auxfile(nf)%doavg) then + if (auxcomp%files(nf)%doavg) then call med_phases_history_fldbun_accum(is_local%wrap%FBImp(compid,compid), & - auxfile(nf)%FBaccum, auxfile(nf)%accumcnt, rc=rc) + 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(auxfile(nf)%FBaccum, auxfile(nf)%accumcnt, rc=rc) + 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 @@ -1206,9 +1222,9 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxfile, first_time, 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, auxfile(nf)%clock, auxfile(nf)%alarmname, & - time_val, time_bnds, time_units, auxfile(nf)%histfile, auxfile(nf)%doavg, & - auxname=auxfile(nf)%auxname, rc=rc) + 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 @@ -1216,53 +1232,54 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxfile, first_time, ny = is_local%wrap%ny(compid) ! Increment number of time samples on file - auxfile(nf)%nt = auxfile(nf)%nt + 1 + auxcomp%files(nf)%nt = auxcomp%files(nf)%nt + 1 ! Write header - if (auxfile(nf)%nt == 1) then + 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(auxfile(nf)%histfile, vm, file_ind=nf, clobber=.true.) + call med_io_wopen(auxcomp%files(nf)%histfile, vm, file_ind=nf, clobber=.true.) ! define time variables - call ESMF_ClockGet(auxfile(nf)%clock, calendar=calendar, rc=rc) + 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(auxfile(nf)%histfile, is_local%wrap%FBimp(compid,compid), whead(1), wdata(1), nx, ny, & - nt=auxfile(nf)%nt, pre=trim(compname(compid))//'Imp', flds=auxfile(nf)%flds, & + 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(auxfile(nf)%histfile, file_ind=nf) + call med_io_enddef(auxcomp%files(nf)%histfile, file_ind=nf) end if ! Write time variables for time nt - call med_io_write_time(time_val, time_bnds, nt=auxfile(nf)%nt, file_ind=nf, rc=rc) + 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 (auxfile(nf)%doavg) then - call med_io_write(auxfile(nf)%histfile, auxfile(nf)%FBaccum, whead(2), wdata(2), nx, ny, & - nt=auxfile(nf)%nt, pre=trim(compname(compid))//'Imp', flds=auxfile(nf)%flds, file_ind=nf, rc=rc) + 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(auxfile(nf)%FBaccum, value=czero, rc=rc) + 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(auxfile(nf)%histfile, is_local%wrap%FBimp(compid,compid), whead(2), wdata(2), nx, ny, & - nt=auxfile(nf)%nt, pre=trim(compname(compid))//'Imp', flds=auxfile(nf)%flds, file_ind=nf, rc=rc) + 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 ! Close file - if (auxfile(nf)%nt == auxfile(nf)%ntperfile) then - call med_io_close(auxfile(nf)%histfile, vm, file_ind=nf, rc=rc) + 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 - auxfile(nf)%nt = 0 + auxcomp%files(nf)%nt = 0 end if end if ! end of write_now if-block diff --git a/mediator/med_phases_restart_mod.F90 b/mediator/med_phases_restart_mod.F90 index add01cfd5..1618e2f86 100644 --- a/mediator/med_phases_restart_mod.F90 +++ b/mediator/med_phases_restart_mod.F90 @@ -137,7 +137,7 @@ subroutine med_phases_restart_write(gcomp, rc) 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 : num_auxfiles, auxfiles + use med_phases_history_mod, only : auxcomp use med_constants_mod , only : SecPerDay => med_constants_SecPerDay ! Input/output variables @@ -428,15 +428,17 @@ subroutine med_phases_restart_write(gcomp, rc) ! 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,num_auxfiles(nc) - if (auxfiles(nc,nf)%doavg .and. auxfiles(nc,nf)%accumcnt > 0) then + 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, auxfiles(nc,nf)%FBaccum, whead(m), wdata(m), nx, ny, & - nt=1, pre=trim(compname(nc))//trim(auxfiles(nc,nf)%auxname), rc=rc) + 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, auxfiles(nc,nf)%accumcnt, & - trim(compname(nc))//trim(auxfiles(nc,nf)%auxname)//'_accumcnt', whead(m), wdata(m), rc=rc) + 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 From 21a1276f2efd7d6c50373047603429510c4fbffa Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 26 Sep 2021 11:56:15 -0600 Subject: [PATCH 58/61] added more debugging info --- mediator/med_phases_history_mod.F90 | 50 ++++++++++++++++++++--------- 1 file changed, 34 insertions(+), 16 deletions(-) diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index c0a724a99..e47fbf606 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -264,7 +264,8 @@ subroutine med_phases_history_write(gcomp, rc) write(logunit,*) write(logunit,'(a,i8)') trim(subname)//" : history alarmname "//trim(alarmname)//& ' is ringing, interval length is ', ringInterval_length - write(logunit,'(a)') trim(subname)//" : currtime = "//trim(currtimestr)//" nexttime = "//trim(nexttimestr) + write(logunit,'(a)') trim(subname)//" : mclock currtime = "//trim(currtimestr)//& + " mclock nexttime = "//trim(nexttimestr) end if end if end if @@ -1521,12 +1522,6 @@ subroutine med_phases_history_init_histclock(gcomp, hclock, alarm, alarmname, hi ! 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 - ! call ESMF_ClockSet(hclock, currtime=starttime, rc=rc) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! call ESMF_TimeIntervalSet(htimestep, s=msec, rc=rc) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! call ESMF_ClockSet(hclock, timeStep=htimestep, 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 @@ -1542,13 +1537,13 @@ subroutine med_phases_history_init_histclock(gcomp, hclock, alarm, alarmname, hi end subroutine med_phases_history_init_histclock !=============================================================================== - subroutine med_phases_history_query_ifwrite(gcomp, wclock, alarmname, write_now, rc) + 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) :: wclock ! write clock + 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 @@ -1568,12 +1563,12 @@ subroutine med_phases_history_query_ifwrite(gcomp, wclock, alarmname, write_now, rc = ESMF_SUCCESS - ! Update wclock to trigger alarm - call ESMF_ClockAdvance(wclock, rc=rc) + ! 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(wclock, alarmname=trim(alarmname), alarm=alarm, rc=rc) + 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 @@ -1594,22 +1589,45 @@ subroutine med_phases_history_query_ifwrite(gcomp, wclock, alarmname, write_now, 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(wclock, currtime=currtime, rc=rc) + + 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(wclock, nextTime=nexttime, rc=rc) + 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 + if (mastertask) then - write(nexttimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec write(logunit,*) write(logunit,'(a,i8)') trim(subname)//" : history alarmname "//trim(alarmname)//& ' is ringing, interval length is ', ringInterval_length - write(logunit,'(a)') trim(subname)//" : currtime = "//trim(currtimestr)//" nexttime = "//trim(nexttimestr) + write(logunit,'(a)') trim(subname)//" : hclock currtime = "//trim(currtimestr)//& + " hclock nexttime = "//trim(nexttimestr) end if + + 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 + + if (mastertask) then + write(logunit,'(a)') trim(subname)//" : mclock currtime = "//trim(currtimestr)//& + " mclock nexttime = "//trim(nexttimestr) + end if + end if end if From 3c5a7848911a8abaee42d99d6459567457429719 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 26 Sep 2021 22:49:11 -0600 Subject: [PATCH 59/61] made the F2000 test nuopc rather than mct --- cime_config/testdefs/testlist_drv.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cime_config/testdefs/testlist_drv.xml b/cime_config/testdefs/testlist_drv.xml index 730f4d3a8..a742f77b1 100644 --- a/cime_config/testdefs/testlist_drv.xml +++ b/cime_config/testdefs/testlist_drv.xml @@ -1,4 +1,4 @@ - +0;95;0c @@ -179,7 +179,7 @@ - + From 4ed6e9ce6317e05f0f42ca66e383fc959dde1db7 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 27 Sep 2021 11:17:59 -0600 Subject: [PATCH 60/61] refactored testlist --- cime_config/testdefs/testlist_drv.xml | 13 ++----------- 1 file changed, 2 insertions(+), 11 deletions(-) diff --git a/cime_config/testdefs/testlist_drv.xml b/cime_config/testdefs/testlist_drv.xml index a742f77b1..bd4a689a4 100644 --- a/cime_config/testdefs/testlist_drv.xml +++ b/cime_config/testdefs/testlist_drv.xml @@ -1,19 +1,10 @@ -0;95;0c + - - - - - - - - - @@ -23,7 +14,7 @@ - + From ef01040680dea74bd9bcfd1a0d1688e8b29ad6d5 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 13 Oct 2021 10:44:08 -0600 Subject: [PATCH 61/61] updates required in code review for PR --- cime_config/runseq/runseq_TG.py | 1 - cime_config/testdefs/testlist_drv.xml | 2 +- mediator/med_io_mod.F90 | 2 +- 3 files changed, 2 insertions(+), 3 deletions(-) diff --git a/cime_config/runseq/runseq_TG.py b/cime_config/runseq/runseq_TG.py index 71afd50b2..c0bb4ab92 100644 --- a/cime_config/runseq/runseq_TG.py +++ b/cime_config/runseq/runseq_TG.py @@ -23,7 +23,6 @@ def gen_runseq(case, coupling_times): run_lnd, _ , lnd_cpl_time = driver_config['lnd'] if lnd_cpl_time != glc_cpl_time: - print ("lnd_cpl_time, glc_cpl_time are {} and {}".format(lnd_cpl_time,glc_cpl_time)) expect(False,"for TG compset require that lnd_cpl_time equal glc_cpl_time") with RunSeq(os.path.join(caseroot, "CaseDocs", "nuopc.runseq")) as runseq: diff --git a/cime_config/testdefs/testlist_drv.xml b/cime_config/testdefs/testlist_drv.xml index bd4a689a4..7368a1fd2 100644 --- a/cime_config/testdefs/testlist_drv.xml +++ b/cime_config/testdefs/testlist_drv.xml @@ -187,7 +187,7 @@ - + diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index 77b1acb53..e26748b8f 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -144,7 +144,7 @@ subroutine med_io_init(gcomp, rc) #endif ! input/output arguments - type(ESMF_GridComp), intent(inout) :: gcomp + type(ESMF_GridComp), intent(in) :: gcomp integer , intent(out) :: rc #ifndef CESMCOUPLED