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/buildexe b/cime_config/buildexe index 52640d30b..e76fc7344 100755 --- a/cime_config/buildexe +++ b/cime_config/buildexe @@ -84,7 +84,7 @@ def _main_func(): if not os.path.isdir(bld_root): os.makedirs(bld_root) - with open(os.path.join(bld_root,'Filepath'), 'w') as out: + with open(os.path.join(bld_root,'Filepath'), 'w', encoding="utf-8") as out: cmeps_dir = os.path.join(os.path.dirname(__file__), os.pardir) # SourceMods dir needs to be first listed out.write(os.path.join(caseroot, "SourceMods", "src.drv") + "\n") diff --git a/cime_config/buildnml b/cime_config/buildnml index 28e83bbd9..f8a43852b 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')) @@ -84,11 +103,6 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): #---------------------------------------------------- nmlgen.init_defaults(infile, config) - if case.get_value('MEDIATOR_READ_RESTART'): - nmlgen.set_value('mediator_read_restart', value='.true.') - else: - nmlgen.set_value('mediator_read_restart', value='.false.') - #-------------------------------- # Overwrite: set brnch_retain_casename #-------------------------------- @@ -273,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) @@ -282,7 +296,7 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): #-------------------------------- # Read nuopc.runconfig - with open(nuopc_config_file, 'r') as f: + with open(nuopc_config_file, 'r', encoding="utf-8") as f: lines_cpl = f.readlines() # Look for only active components except CPL @@ -294,7 +308,7 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): comp_config_file = os.path.join(caseroot,"Buildconf","{}conf".format(case.get_value("COMP_{}".format(comp))), "{}.configure".format(case.get_value("COMP_{}".format(comp)))) if os.path.isfile(comp_config_file): - with open(comp_config_file, 'r') as f: + with open(comp_config_file, 'r', encoding="utf-8") as f: lines_comp = f.readlines() if lines_comp: @@ -312,7 +326,7 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): lines_cpl_new.append(line_comp) # Write to a file - with open(nuopc_config_file, 'w') as f: + with open(nuopc_config_file, 'w', encoding="utf-8") as f: for line in lines_cpl_new: f.write(line) @@ -344,7 +358,7 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): dicts = {} for infile in infiles: dict_ = {} - with open(infile) as myfile: + with open(infile, "r", encoding="utf-8") as myfile: for line in myfile: if "=" in line and '!' not in line: name, var = line.partition("=")[::2] @@ -386,7 +400,7 @@ def _create_runseq(case, coupling_times, valid_comps): if len(valid_comps) == 1: # Create run sequence with no mediator - outfile = open(os.path.join(caseroot, "CaseDocs", "nuopc.runseq"), "w") + outfile = open(os.path.join(caseroot, "CaseDocs", "nuopc.runseq"), "w", encoding="utf-8") dtime = coupling_times[valid_comps[0].lower() + '_cpl_dt'] outfile.write ("runSeq:: \n") outfile.write ("@" + str(dtime) + " \n") @@ -469,11 +483,12 @@ def _create_component_modelio_namelists(confdir, case, files): for entry in entries: nmlgen.add_default(entry) - if model == "cpl": - modelio_file = "med_modelio.nml" + inst_string - else: - modelio_file = model + "_modelio.nml" + inst_string - nmlgen.write_nuopc_modelio_file(os.path.join(confdir, modelio_file)) + if inst_index == 1: + if model == "cpl": + modelio_file = "med_modelio.nml" + else: + modelio_file = model + "_modelio.nml" + nmlgen.write_nuopc_modelio_file(os.path.join(confdir, modelio_file)) # Output the following to nuopc.runconfig moddiro = case.get_value('RUNDIR') @@ -482,7 +497,7 @@ def _create_component_modelio_namelists(confdir, case, files): else: logfile = model + inst_string + ".log." + str(lid) - with open(nuopc_config_file, 'a') as outfile: + with open(nuopc_config_file, 'a', encoding="utf-8") as outfile: if model == 'cpl': name = "MED" else: @@ -516,11 +531,11 @@ def buildnml(case, caseroot, component): if component != "drv": raise AttributeError -# Do a check here of ESMF VERSION, requires 8.1.0 or newer (8.2.0 or newer for esmf_aware_threading) + # Do a check here of ESMF VERSION, requires 8.1.0 or newer (8.2.0 or newer for esmf_aware_threading) esmf_aware_threading = case.get_value("ESMF_AWARE_THREADING") esmfmkfile = os.getenv("ESMFMKFILE") expect(esmfmkfile and os.path.isfile(esmfmkfile),"ESMFMKFILE not found {}".format(esmfmkfile)) - with open(esmfmkfile, 'r') as f: + with open(esmfmkfile, 'r', encoding="utf-8") as f: major = None minor = None for line in f.readlines(): diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index ba73c96d6..49bc7d0d8 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -435,27 +435,6 @@ - - char - 1 - run_begin_stop_restart - env_run.xml - - Sets periodic model barriers with BARRIER_OPTION and BARRIER_DATE for synchronization - - - - - char - -999 - run_begin_stop_restart - env_run.xml - - Alternative date in yyyymmdd format - sets periodic model barriers with BARRIER_OPTION and BARRIER_N for synchronization - - - logical TRUE,FALSE @@ -841,6 +820,21 @@ machines. + + logical + TRUE,FALSE + FALSE + build_component_clm + env_build.xml + TRUE implies CLM is built with support for the PETSc + library. The Variably Saturated Flow Model (VSFM) solver in CLM + uses the PETSc library. In order to use the VSFM solver, CLM + must be built with PETSc support and linking to PETSc must occur + when building the ACME executable. This occurs if this variable + is set to TRUE. Note that is only available on a limited set of + machines/compilers. + + logical TRUE,FALSE @@ -2294,10 +2288,6 @@ standard full pathname of the cprnc executable - - - - logical TRUE,FALSE @@ -2307,38 +2297,6 @@ determine if per ice thickness category fields are passed from ice to ocean - DO NOT EDIT (set by POP build-namelist) - - - - - - char - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,nmonths,nmonth,nyears,nyear,end - never - run_drv_history - env_run.xml - Sets driver snapshot history file frequency (like REST_OPTION) - - - - integer - - -999 - run_drv_history - env_run.xml - Sets driver snapshot history file frequency (like REST_N) - - - - - integer - - -999 - run_drv_history - env_run.xml - yyyymmdd format, sets coupler snapshot history date (like REST_DATE) - - integer 0,1,2,3,4,5,6,7,8,9 @@ -2348,22 +2306,6 @@ level of debug output, 0=minimum, 1=normal, 2=more, 3=too much - - logical - TRUE,FALSE - FALSE - build_component_clm - env_build.xml - TRUE implies CLM is built with support for the PETSc - library. The Variably Saturated Flow Model (VSFM) solver in CLM - uses the PETSc library. In order to use the VSFM solver, CLM - must be built with PETSc support and linking to PETSc must occur - when building the ACME executable. This occurs if this variable - is set to TRUE. Note that is only available on a limited set of - machines/compilers. - - - @@ -2541,6 +2483,21 @@ add aoflux calculation to runseq + + + + + + + logical + TRUE,FALSE + FALSE + run_flags + env_run.xml + turns on coupler bit-for-bit reproducibility with varying pe counts + + + ========================================= Notes: diff --git a/cime_config/config_component_cesm.xml b/cime_config/config_component_cesm.xml index 49ed73ed7..ba4bb69c0 100644 --- a/cime_config/config_component_cesm.xml +++ b/cime_config/config_component_cesm.xml @@ -18,10 +18,14 @@ Historic transient Twentieth century transient - CMIP5 rcp 2.6 forcing - CMIP5 rcp 4.5 forcing - CMIP5 rcp 6.0 forcing - CMIP5 rcp 8.5 forcing + CMIP6 SSP1-1.9 forcing + CMIP6 SSP1-2.6 forcing + CMIP6 SSP2-4.5 forcing + CMIP6 SSP3-7.0 forcing + CMIP6 SSP4-3.4 forcing + CMIP6 SSP4-6.0 forcing + CMIP6 SSP5-3.4 forcing + CMIP6 SSP5-8.5 forcing Biogeochemistry intercomponent with diagnostic CO2 with prognostic CO2 @@ -96,29 +100,6 @@ We will not document this further in this guide. - - logical - TRUE,FALSE - FALSE - run_flags - env_run.xml - turns on coupler bit-for-bit reproducibility with varying pe counts - - - - char - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,nmonths,nmonth,nyears,nyear,date,ifdays0,end - never - - ndays - - run_begin_stop_restart - env_run.xml - - sets frequency of full model barrier (same options as STOP_OPTION) for synchronization with BARRIER_N and BARRIER_DATE - - - char none,CO2A,CO2B,CO2C @@ -191,23 +172,39 @@ 144 288 288 - 72 - 48 - - - 24 - 24 - 24 - 24 - - - - - 24 - 24 - 48 - 48 - 1 + + + + 48 + 48 + 48 + 24 + 24 + + 72 + + + + 24 + 24 + + + + + + 24 + 144 + 24 + 24 + + + + 24 + 48 + 48 + + + 96 96 96 @@ -230,13 +227,11 @@ 72 144 288 - 48 - 48 - 24 - 24 - 1 - - + + + + + 1 run_coupling env_run.xml @@ -275,16 +270,14 @@ integer $ATM_NCPL - 24 24 - 4 + 1 24 24 - - - - + 48 + 48 1 + 24 run_coupling env_run.xml @@ -332,16 +325,16 @@ integer 8 - $ATM_NCPL - $ATM_NCPL - $ATM_NCPL - $ATM_NCPL - 1 - 8 - 8 - $ATM_NCPL - 1 - $ATM_NCPL + 1 + $ATM_NCPL + $ATM_NCPL + $ATM_NCPL + 1 + 8 + 8 + $ATM_NCPL + 1 + $ATM_NCPL run_coupling env_run.xml @@ -414,28 +407,65 @@ 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 + + + + + + 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 @@ -443,11 +473,10 @@ nmonths - run_drv_history + med_history env_run.xml - Sets driver average history file frequency (like REST_OPTION) + Sets mediator average history file frequency (like REST_OPTION) - char @@ -455,18 +484,17 @@ 1 - run_drv_history + med_history env_run.xml - Sets driver average history file frequency (like REST_N) + Sets mediator average history file frequency (like REST_N) - integer -999 - run_drv_history + med_history env_run.xml - yyyymmdd format, sets driver average history date (like REST_DATE) + yyyymmdd format, sets mediator average history date (like REST_DATE) diff --git a/cime_config/config_component_ufs.xml b/cime_config/config_component_ufs.xml index 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 71eca18ec..e909eaf9b 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 @@ -359,6 +220,16 @@ + + logical + nuopc + ALLCOMP_attributes + + .false. + .true. + + + char nuopc @@ -461,7 +332,7 @@ - + @@ -472,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 @@ -653,29 +536,6 @@ - - logical - expdef - ATM_attributes - - Perpetual flag - - - .false. - - - - integer - expdef - ATM_attributes - - Perpetual date - - - -999 - - - real single_column @@ -717,18 +577,6 @@ - - logical - expdef - ATM_attributes - - true => turn on aquaplanet mode in cam - - - .false. - - - logical flds @@ -778,7 +626,7 @@ - + @@ -794,7 +642,6 @@ 0.0 - integer control @@ -806,7 +653,6 @@ 5 - logical control @@ -825,6 +671,15 @@ + + char + nuopc + MED_attributes + off,low,high,max + + $ESMF_VERBOSITY_LEVEL + + integer control @@ -957,7 +812,6 @@ $WAV_NY - char control @@ -969,7 +823,6 @@ $COUPLING_MODE - char control @@ -1016,154 +869,50 @@ - - 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 - - - $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 - ocn,atm,exch - - Grid for atm ocn flux calc (untested) - default: ocn - - - ocn - - - - - real - control - MED_attributes - - wind gustiness factor - - - 0.0D0 - - - - - logical - budget - MED_attributes - - logical that turns on diagnostic budgets, false means budgets will never be written + logical that turns on diagnostic budgets, false means budgets will never be written $BUDGETS @@ -1286,657 +1035,1032 @@ - - - + + + - - logical - history - MED_attributes + + + + + + char + time + ALLCOMP_attributes + none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end - logical to write an extra initial coupler history file + mediator history snapshot option (used with history_n and history_ymd) + set by HIST_OPTION in env_run.xml. + history_option alarms are: + [none/never], turns option off + [nstep/s] , history snapshot every history_n nsteps , relative to current run start time + [nsecond/s] , history snapshot every history_n nseconds, relative to current run start time + [nminute/s] , history snapshot every history_n nminutes, relative to current run start time + [nhour/s] , history snapshot every history_n nhours , relative to current run start time + [nday/s] , history snapshot every history_n ndays , relative to current run start time + [monthly/s] , history snapshot every month , relative to current run start time + [nmonth/s] , history snapshot every history_n nmonths , relative to current run start time + [nyear/s] , history snapshot every history_n nyears , relative to current run start time + [date] , history snapshot at history_ymd value + [ifdays0] , history snapshot at history_n calendar day value and seconds equal 0 + [end] , history snapshot at end - .false. + $HIST_OPTION - - - - - - - - - - - - - - - - - - - - - - - - - + + integer + time + ALLCOMP_attributes + + sets mediator snapshot history file frequency (like restart_n) + set by HIST_N in env_run.xml. + + + $HIST_N + + - - - - - - - - - - - - + + integer + time + CLOCK_attributes + + date associated with history_option date. yyyymmdd format. + set by HIST_DATE in env_run.xml. + + + $HIST_DATE + + - - - - - - - - - - - - + + + - - - - - - - - - - - - + + char + time + MED_attributes + none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + + mediator history for mediator aoflux and oceean albedoes (used with history_n and history_ymd) + + + never + + + + integer + time + MED_attributes + + sets mediator aoflux and ocean albedoes snapshot history file frequency for atm import/export fields (like restart_n) + + + -999 + + - - - - - - - - - - - - + + + - - - - - - - - - - - - + + char + time + MED_attributes + none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + + mediator history for atm import/export/fields snapshot option (used with history_n and history_ymd) + + + never + + + + integer + time + MED_attributes + + sets mediator snapshot history file frequency for atm import/export fields (like restart_n) + + + -999 + + + + char + time + MED_attributes + none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + + mediator time average history option (used with histavg_n and histavg_ymd) + + + never + + + + integer + time + MED_attributes + + Sets mediator time-average history file frequency (like restart_option) + + + -999 + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + logical + aux_hist + MED_attributes + Auxiliary mediator atm2med instantaneous history output every hour. + + .false. + + + + char + aux_hist + MED_attributes + Auxiliary mediator atm2med instantaneous history output every hour. + + Faxa_swndr:Faxa_swvdr:Faxa_swndf:Faxa_swvdf + + + + char + aux_hist + MED_attributes + history option type + + nhours + + + + char + aux_hist + MED_attributes + history option type + + 1 + + + + logical + aux_hist + MED_attributes + If true, use time average for aux file output. + + .false. + + + + char + aux_hist + MED_attributes + Auxiliary name identifier in history name + + atm.1h.inst + + + + integer + aux_hist + MED_attributes + Number of time sames per file. + + 24 + + - - - - - - - - - - - - + + + logical + aux_hist + MED_attributes + Auxiliary atm2med history output averaged over 1 hour. + + .false. + + + + char + aux_hist + MED_attributes + Auxiliary atm2med history output averaged over 1 hour. + + Sa_u:Sa_v + + + + char + aux_hist + MED_attributes + history option type + + nhours + + + + char + aux_hist + MED_attributes + history option type + + 1 + + + + logical + aux_hist + MED_attributes + If true, use time average for aux file output. + + .true. + + + + char + aux_hist + MED_attributes + Number of time sames per file. + + 24 + + + + char + aux_hist + MED_attributes + Auxiliary name identifier in history name + + atm.1h.avrg + + - - - - - - - - - - - - + + + logical + aux_hist + MED_attributes + + Auxiliary mediator atm2med precipitation history output every 3 hours + + + .false. + + + + char + aux_hist + MED_attributes + Auxiliary mediator atm2med precipitation history output every 3 hours + + Faxa_rainc:Faxa_rainl:Faxa_snowc:Faxa_snowl + + + + char + aux_hist + MED_attributes + history option type + + nhours + + + + char + aux_hist + MED_attributes + history option type + + 3 + + + + logical + aux_hist + MED_attributes + If true, use time average for aux file output. + + .true. + + + + char + aux_hist + MED_attributes + Number of time sames per file. + + 8 + + + + char + aux_hist + MED_attributes + Auxiliary name identifier in history name. + + atm.3hprec.avrg + + - - - - - - - - - - - - + + + logical + aux_hist + MED_attributes + + Auxiliary mediator a2x precipitation history output every 3 hours + + + .false. + + + + char + aux_hist + MED_attributes + + Auxiliary mediator a2x precipitation history output every 3 hours + + + Sa_z:Sa_topo:Sa_u:Sa_v:Sa_tbot:Sa_ptem:Sa_shum:Sa_dens:Sa_pbot:Sa_pslv:Faxa_lwdn:Faxa_rainc:Faxa_rainl:Faxa_snowc:Faxa_snowl:Faxa_swndr:Faxa_swvdr:Faxa_swndf:Faxa_swvdf:Sa_co2diag:Sa_co2prog + + + + char + aux_hist + MED_attributes + history option type + + nhours + + + + char + aux_hist + MED_attributes + history option type + + 3 + + + + logical + aux_hist + MED_attributes + If true, use time average for aux file output. + + .true. + + + + char + aux_hist + MED_attributes + Number of time sames per file. + + 8 + + + + char + aux_hist + MED_attributes + Auxiliary name identifier in history name. + + atm.3h.avrg + + - - - - - - - - - - - - + + + logical + aux_hist + MED_attributes + Auxiliary mediator a2x precipitation history output every 3 hours + + .false. + + + + char + aux_hist + MED_attributes + Auxiliary mediator a2x precipitation history output every 3 hours + + Faxa_bcph:Faxa_ocph:Faxa_dstwet:Faxa_dstdry:Sa_co2prog:Sa_co2diag + + + + char + aux_hist + MED_attributes + history option type + + ndays + + + + char + aux_hist + MED_attributes + history option type + + 1 + + + + logical + aux_hist + MED_attributes + If true, use time average for aux file output. + + .true. + + + + char + aux_hist + MED_attributes + Number of time sames per file. + + 1 + + + + char + aux_hist + MED_attributes + Auxiliary name identifier in history name + + atm.24h.avrg + + - - - - - - - - - - - - + + + - - - - - - - - - - - - + + char + time + MED_attributes + none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + + mediator history for ice import/export/fields snapshot option (used with history_n and history_ymd) + + + never + + + + integer + time + MED_attributes + + sets mediator snapshot history file frequency for ice import/export fields (like restart_n) + + + -999 + + + + char + time + MED_attributes + none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + + mediator time average history option (used with histavg_n and histavg_ymd) + + + never + + + + integer + time + MED_attributes + + Sets mediator time-average history file frequency (like restart_option) + + + -999 + + - - - - - - - - - - - + + + - - - - - - - - - - - + + char + time + MED_attributes + none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + + mediator history for glc import/export/fields snapshot option (used with history_n and history_ymd) + + + never + + + + integer + time + MED_attributes + + sets mediator snapshot history file frequency for glc import/export fields (like restart_n) + + + -999 + + + + char + time + MED_attributes + none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + + mediator time average history option (used with histavg_n and histavg_ymd) + + + never + + + + integer + time + MED_attributes + + Sets mediator time-average history file frequency (like restart_option) + + + -999 + + - - - - - - - - - - - + + + - - - - - - - - - - - + + char + time + MED_attributes + none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + + mediator history for lnd import/export/fields snapshot option (used with history_n and history_ymd) + + + never + + + + integer + time + MED_attributes + + sets mediator snapshot history file frequency for lnd import/export fields (like restart_n) + + + -999 + + + + char + time + MED_attributes + none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + + mediator time average history option (used with histavg_n and histavg_ymd) + + + never + + + + integer + time + MED_attributes + + Sets mediator time-average history file frequency (like restart_option) + + + -999 + + - - - - - - - - - - - + + + logical + aux_hist + MED_attributes + Auxiliary mediator l2x fields every lnd coupling interval + + .false. + + + + char + aux_hist + MED_attributes + Auxiliary mediator lnd2med output every lnd coupling interval + + all + + + + char + aux_hist + MED_attributes + history option type + + nsteps + + + + char + aux_hist + MED_attributes + history option type + + 1 + + + + logical + aux_hist + MED_attributes + If true, use time average for aux file output. + + .false. + + + + char + aux_hist + MED_attributes + Number of time sames per file. + + 1 + + + + char + aux_hist + MED_attributes + Auxiliary name identifier in history name + + lnd.ncpl.inst + + - - - - - - - - - - - + + + + + logical + aux_hist + ALLCOMP_attributes + Auxiliary mediator lnd2med fields every year + + .false. + + - - - + + + - + char - expdef - ALLCOMP_attributes + time + MED_attributes + none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end - name of the coupling field with scalar information + mediator history for ocn import/export/fields snapshot option (used with history_n and history_ymd) - cpl_scalars + never - - + integer - expdef - ALLCOMP_attributes + time + MED_attributes - total number of scalars in the scalar coupling field + sets mediator snapshot history file frequency for ocn import/export fields (like restart_n) - 4 + -999 - - - integer - expdef - ALLCOMP_attributes + + char + time + MED_attributes + none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end - index of scalar containing global grid cell count in X dimension + mediator time average history option (used with histavg_n and histavg_ymd) - 1 + never - - + integer - expdef - ALLCOMP_attributes + time + MED_attributes - index of scalar containing global grid cell count in Y dimension + Sets mediator time-average history file frequency (like restart_option) - 2 + -999 - - integer - expdef - ALLCOMP_attributes + + + + + + char + time + MED_attributes + none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end - index of scalar containing calendar day of nextsw computation from atm + mediator history for rof import/export/fields snapshot option (used with history_n and history_ymd) - 3 + never - - + 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 for rof import/export fields (like restart_n) - 4 - 0 + -999 - - + + char + time + MED_attributes + none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + + mediator time average history option (used with histavg_n and histavg_ymd) + + + never + + + integer - expdef - ALLCOMP_attributes + time + MED_attributes - number of glc ice sheets + Sets mediator time-average history file frequency (like restart_option) - 1 + -999 - + + logical - mapping + aux_hist 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 + Auxiliary mediator rof2med precipitation history output every 3 hours - .true. + .false. - - + char - mapping - abs + aux_hist MED_attributes - atm to ocn flux mapping file for fluxes + Auxiliary mediator rof2med precipitation history output. - $ATM2OCN_FMAPNAME + all - - + char - mapping - abs + aux_hist MED_attributes - - atm to ocn state mapping file for states - + history option type - $ATM2OCN_SMAPNAME + ndays - - + char - mapping - abs + aux_hist MED_attributes - - atm to ocn state mapping file for velocity - + history option type - $ATM2OCN_VMAPNAME + 1 - - + char - mapping - abs + aux_hist MED_attributes - - ocn to atm mapping file for fluxes - + If true, use time average for aux file output. - $OCN2ATM_FMAPNAME + .true. - - + char - mapping - abs + aux_hist MED_attributes - - ocn to atm mapping file for states - + Number of time sames per file. + + 1 + + + + char + aux_hist + MED_attributes + Auxiliary name identifier in history name - $OCN2ATM_SMAPNAME + rof.24h.avrg - + + + + + char - mapping - abs + time MED_attributes + none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end - atm to ice flux mapping file for fluxes + mediator history for wav import/export/fields snapshot option (used with history_n and history_ymd) - $ATM2OCN_FMAPNAME + never - - - char - mapping - abs + + integer + time MED_attributes - atm to ice state mapping file for states + sets mediator snapshot history file frequency for wav import/export fields (like restart_n) - $ATM2OCN_SMAPNAME + -999 - - + char - mapping - abs + time MED_attributes + none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end - atm to ice state mapping file for velocity + mediator time average history option (used with histavg_n and histavg_ymd) - $ATM2OCN_VMAPNAME + never - - - char - mapping - abs + + integer + time MED_attributes - ice to atm mapping file for fluxes + Sets mediator time-average history file frequency (like restart_option) - $OCN2ATM_FMAPNAME + -999 - - char + + + + + + logical mapping - abs MED_attributes - - ice to atm mapping file for states - + 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 - $OCN2ATM_SMAPNAME + .true. + .false. - + 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 @@ -1952,7 +2076,6 @@ $GLC2OCN_LIQ_RMAPNAME - char mapping @@ -1965,7 +2088,6 @@ $GLC2ICE_RMAPNAME - char mapping @@ -1978,21 +2100,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 @@ -2001,36 +2121,21 @@ runoff to ocn nearest neighbor plus smoothing conservative mapping file - $ROF2OCN_ICE_RMAPNAME - - - - - 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 @@ -2043,7 +2148,6 @@ $OCN2WAV_SMAPNAME - char mapping @@ -2056,7 +2160,6 @@ $ICE2WAV_SMAPNAME - char mapping @@ -2070,6 +2173,95 @@ + + + + + + char + expdef + ALLCOMP_attributes + + name of the coupling field with scalar information + + + cpl_scalars + + + + + integer + expdef + ALLCOMP_attributes + + total number of scalars in the scalar coupling field + + + 4 + + + + + integer + expdef + ALLCOMP_attributes + + index of scalar containing global grid cell count in X dimension + + + 1 + + + + + integer + expdef + ALLCOMP_attributes + + index of scalar containing global grid cell count in Y dimension + + + 2 + + + + + integer + expdef + ALLCOMP_attributes + + index of scalar containing calendar day of nextsw computation from atm + + + 3 + + + + + integer + expdef + ALLCOMP_attributes + + index of scalar containing epbal precipitation factor from ocn (only for POP) + + + 4 + 0 + + + + + integer + expdef + ALLCOMP_attributes + + number of glc ice sheets + + + 1 + + + logical flds @@ -2505,152 +2697,6 @@ - - char - time - CLOCK_attributes - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end - - coupler history snapshot option (used with history_n and history_ymd) - set by HIST_OPTION in env_run.xml. - history_option alarms are: - [none/never], turns option off - [nstep/s] , history snapshot every history_n nsteps , relative to current run start time - [nsecond/s] , history snapshot every history_n nseconds, relative to current run start time - [nminute/s] , history snapshot every history_n nminutes, relative to current run start time - [nhour/s] , history snapshot every history_n nhours , relative to current run start time - [nday/s] , history snapshot every history_n ndays , relative to current run start time - [monthly/s] , history snapshot every month , relative to current run start time - [nmonth/s] , history snapshot every history_n nmonths , relative to current run start time - [nyear/s] , history snapshot every history_n nyears , relative to current run start time - [date] , history snapshot at history_ymd value - [ifdays0] , history snapshot at history_n calendar day value and seconds equal 0 - [end] , history snapshot at end - - - $HIST_OPTION - - - - - integer - time - CLOCK_attributes - - sets coupler snapshot history file frequency (like restart_n) - set by HIST_N in env_run.xml. - - - $HIST_N - - - - - integer - time - CLOCK_attributes - - date associated with history_option date. yyyymmdd format. - set by HIST_DATE in env_run.xml. - - - $HIST_DATE - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - char - time - CLOCK_attributes - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,nmonths,monthly,nmonth,nyears,nyear,date,ifdays0,end - - sets the driver barrier frequency to sync models across all tasks with barrier_n and barrier_ymd - barrier_option alarms are like restart_option - default: never - - - $BARRIER_OPTION - - - - - integer - time - CLOCK_attributes - - Sets model barriers with barrier_option and barrier_ymd (same options as stop_n) - default: 1 - - - $BARRIER_N - - - - - integer - time - CLOCK_attributes - - Date in yyyymmdd format, sets model barriers date with barrier_option and barrier_n - - - $BARRIER_DATE - - - char time @@ -2833,7 +2879,7 @@ - + @@ -2847,7 +2893,6 @@ $NINST - integer cime_pes @@ -2860,7 +2905,6 @@ $NTASKS_ATM - integer cime_pes @@ -2873,7 +2917,6 @@ $NTHRDS_ATM - integer cime_pes @@ -2886,7 +2929,6 @@ $ROOTPE_ATM - integer cime_pes @@ -2899,7 +2941,6 @@ $PSTRID_ATM - integer cime_pes @@ -2912,7 +2953,6 @@ $NTASKS_LND - integer cime_pes @@ -2925,7 +2965,6 @@ $NTHRDS_LND - integer cime_pes @@ -2938,7 +2977,6 @@ $ROOTPE_LND - integer cime_pes @@ -2951,7 +2989,6 @@ $PSTRID_LND - integer cime_pes @@ -2964,7 +3001,6 @@ $NTASKS_ICE - integer cime_pes @@ -2977,7 +3013,6 @@ $NTHRDS_ICE - integer cime_pes @@ -2990,7 +3025,6 @@ $ROOTPE_ICE - integer cime_pes @@ -3003,7 +3037,6 @@ $PSTRID_ICE - integer cime_pes @@ -3016,7 +3049,6 @@ $NTASKS_OCN - integer cime_pes @@ -3029,7 +3061,6 @@ $NTHRDS_OCN - integer cime_pes @@ -3042,7 +3073,6 @@ $ROOTPE_OCN - integer cime_pes @@ -3055,7 +3085,6 @@ $PSTRID_OCN - integer cime_pes @@ -3068,7 +3097,6 @@ $NTASKS_GLC - integer cime_pes @@ -3081,7 +3109,6 @@ $NTHRDS_GLC - integer cime_pes @@ -3094,7 +3121,6 @@ $ROOTPE_GLC - integer cime_pes @@ -3107,7 +3133,6 @@ $PSTRID_GLC - integer cime_pes @@ -3120,7 +3145,6 @@ $NTASKS_WAV - integer cime_pes @@ -3133,7 +3157,6 @@ $NTHRDS_WAV - integer cime_pes @@ -3146,7 +3169,6 @@ $ROOTPE_WAV - integer cime_pes @@ -3159,7 +3181,6 @@ $PSTRID_WAV - integer cime_pes @@ -3172,7 +3193,6 @@ $NTASKS_ROF - integer cime_pes @@ -3185,7 +3205,6 @@ $NTHRDS_ROF - integer cime_pes @@ -3198,7 +3217,6 @@ $ROOTPE_ROF - integer cime_pes @@ -3211,7 +3229,6 @@ $PSTRID_ROF - integer cime_pes @@ -3224,7 +3241,6 @@ $NTASKS_ESP - integer cime_pes @@ -3237,7 +3253,6 @@ $NTHRDS_ESP - integer cime_pes @@ -3250,7 +3265,6 @@ $ROOTPE_ESP - integer cime_pes @@ -3263,7 +3277,6 @@ $PSTRID_ESP - integer cime_pes @@ -3276,7 +3289,6 @@ $NTASKS_CPL - integer cime_pes @@ -3289,7 +3301,6 @@ $NTHRDS_CPL - integer cime_pes @@ -3302,7 +3313,6 @@ $ROOTPE_CPL - integer cime_pes @@ -3316,28 +3326,10 @@ - - char - cime_pes - PELAYOUT_attributes - - Determines what ESMF log files (if any) are generated when - USE_ESMF_LIB is TRUE. - ESMF_LOGKIND_SINGLE: Use a single log file, combining messages from - all of the PETs. Not supported on some platforms. - ESMF_LOGKIND_MULTI: Use multiple log files — one per PET. - ESMF_LOGKIND_NONE: Do not issue messages to a log file. - By default, no ESMF log files are generated. - - - $ESMF_LOGFILE_KIND - - - - - - - + + + + logical @@ -3365,7 +3357,6 @@ .true. - logical performance @@ -3376,7 +3367,6 @@ .false. - logical performance @@ -3388,7 +3378,6 @@ .true. - logical performance @@ -3399,7 +3388,6 @@ .false. - integer performance @@ -3410,7 +3398,6 @@ $TIMER_LEVEL - integer performance @@ -3421,7 +3408,6 @@ 0 - integer performance @@ -3432,7 +3418,6 @@ $TIMER_DETAIL - integer performance @@ -3446,7 +3431,6 @@ 3 - logical performance @@ -3458,7 +3442,6 @@ .false. - logical performance @@ -3470,7 +3453,6 @@ .false. - integer performance @@ -3482,7 +3464,6 @@ 1 - logical performance @@ -3495,10 +3476,10 @@ - - - - + + + + char @@ -3511,7 +3492,6 @@ PAPI_FP_OPS - char performance @@ -3523,7 +3503,6 @@ PAPI_NO_CTR - char performance @@ -3535,7 +3514,6 @@ PAPI_NO_CTR - char performance @@ -3548,9 +3526,9 @@ - - - + + + logical @@ -3816,4 +3794,219 @@ + + + + + + char + nuopc + ATM_attributes + off,low,high,max + + $ESMF_VERBOSITY_LEVEL + + + + char + mapping + ATM_attributes + + MESH description of atm grid + + + $ATM_DOMAIN_MESH + null + + + + logical + expdef + ATM_attributes + + Perpetual flag + + + .false. + + + + integer + expdef + ATM_attributes + + Perpetual date + + + -999 + + + + logical + expdef + ATM_attributes + + true => turn on aquaplanet mode in cam + + + .false. + + + + + + + + + char + nuopc + ICE_attributes + off,low,high,max + + $ESMF_VERBOSITY_LEVEL + + + + char + mapping + ICE_attributes + + MESH description of ice grid + + + $ICE_DOMAIN_MESH + null + + + + + + + + + char + nuopc + GLC_attributes + off,low,high,max + + $ESMF_VERBOSITY_LEVEL + + + + char + mapping + GLC_attributes + + MESH description of glc grid + + + $GLC_DOMAIN_MESH + null + + + + + + + + + char + nuopc + LND_attributes + off,low,high,max + + $ESMF_VERBOSITY_LEVEL + + + + char + mapping + LND_attributes + + MESH description of lnd grid + + + $LND_DOMAIN_MESH + null + + + + + + + + + char + nuopc + OCN_attributes + off,low,high,max + + $ESMF_VERBOSITY_LEVEL + + + + char + mapping + OCN_attributes + + MESH description of ocn grid + + + $OCN_DOMAIN_MESH + null + + + + + + + + + char + nuopc + ROF_attributes + off,low,high,max + + $ESMF_VERBOSITY_LEVEL + + + + char + mapping + ROF_attributes + + MESH description of rof grid + + + $ROF_DOMAIN_MESH + null + + + + + + + + + char + nuopc + off,low,high,max + WAV_attributes + + $ESMF_VERBOSITY_LEVEL + + + + char + mapping + WAV_attributes + + MESH description of wav grid + + + $WAV_DOMAIN_MESH + null + + + diff --git a/cime_config/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/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/gen_runseq.py b/cime_config/runseq/gen_runseq.py index 3caa4feb9..12edace1f 100644 --- a/cime_config/runseq/gen_runseq.py +++ b/cime_config/runseq/gen_runseq.py @@ -7,7 +7,7 @@ def __init__(self, outfile): self.__outfile = None def __enter__(self): - self.__outfile = open(self.__outfile_name, "w") + self.__outfile = open(self.__outfile_name, "w", encoding="utf-8") self.__outfile.write("runSeq:: \n") return self @@ -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,17 @@ 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: 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" ) + if addextra_atsign: + self.__outfile.write ("@@ \n" ) + else: + self.__outfile.write ("@ \n" ) 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 f565f8fdf..7bfa3aaa6 100644 --- a/cime_config/runseq/runseq_general.py +++ b/cime_config/runseq/runseq_general.py @@ -81,20 +81,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..7368a1fd2 100644 --- a/cime_config/testdefs/testlist_drv.xml +++ b/cime_config/testdefs/testlist_drv.xml @@ -5,51 +5,19 @@ - - - - - - - - - - - - - - - - - - - - - - - + + - + - - - - - - - - - - - - - + + @@ -57,19 +25,8 @@ - - - - - - - - - - - - - + + @@ -77,19 +34,8 @@ - - - - - - - - - - - - - + + @@ -102,19 +48,8 @@ - - - - - - - - - - - - - + + @@ -122,55 +57,31 @@ - - - + + - - - - - - - - - - - - - - - - - - - - - + - - - + + - - + - - - + + @@ -183,9 +94,8 @@ - - - + + @@ -193,9 +103,8 @@ - - - + + @@ -203,34 +112,13 @@ - - - + + - - - - - - - - - - - - - - - - - - - - @@ -238,9 +126,8 @@ - - - + + @@ -248,19 +135,8 @@ - - - - - - - - - - - - - + + @@ -268,45 +144,22 @@ - - - + + - - - - - - - - - - - - - - - - - - - - - - - - + + @@ -314,52 +167,32 @@ - + - + - - - + - + - - - - - - - - - - - - - - - - - - + + - + - - - + - + @@ -369,9 +202,8 @@ - - - + + @@ -379,9 +211,8 @@ - - - + + @@ -389,9 +220,8 @@ - - - + + @@ -399,8 +229,8 @@ - - + + @@ -413,7 +243,7 @@ - + @@ -422,7 +252,7 @@ - + diff --git a/cime_config/testdefs/testmods_dirs/drv/y100k/README b/cime_config/testdefs/testmods_dirs/drv/y100k/README new file mode 100644 index 000000000..4b028c206 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/drv/y100k/README @@ -0,0 +1,5 @@ +This tests the ability to use 6-digit years. + +As of the time this test was created, the max year is about 214747 - +otherwise we exceed the limit of 4-byte integers when storing dates as +integers (yyyyyymmdd). diff --git a/cime_config/testdefs/testmods_dirs/drv/y100k/shell_commands b/cime_config/testdefs/testmods_dirs/drv/y100k/shell_commands new file mode 100644 index 000000000..1f1324a74 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/drv/y100k/shell_commands @@ -0,0 +1 @@ +./xmlchange RUN_STARTDATE=99999-12-28 diff --git a/doc/source/CMEPS-grid1.png b/doc/source/CMEPS-grid1.png new file mode 100644 index 000000000..fab0ab0a8 Binary files /dev/null and b/doc/source/CMEPS-grid1.png differ diff --git a/doc/source/CMEPS-grid2.png b/doc/source/CMEPS-grid2.png new file mode 100644 index 000000000..bc6699427 Binary files /dev/null and b/doc/source/CMEPS-grid2.png differ diff --git a/doc/source/CMEPS-grid3.png b/doc/source/CMEPS-grid3.png new file mode 100644 index 000000000..c170cf712 Binary files /dev/null and b/doc/source/CMEPS-grid3.png differ diff --git a/doc/source/addendum/fieldnames.rst b/doc/source/addendum/fieldnames.rst new file mode 100644 index 000000000..471d52e7a --- /dev/null +++ b/doc/source/addendum/fieldnames.rst @@ -0,0 +1,171 @@ +.. _field_naming_convention: + +CMEPS field names +================= + +The following state names are currently supported. Note that each application might only use a subset of these fields. + +.. csv-table:: "Atmospheric State Names (import to mediator)" + :header: "stat name", "description" + :widths: 20, 60 + + "Sa_co2diag", "diagnostic CO2 at the lowest model level" + "Sa_co2prog", "prognostic CO2 at the lowest model level" + "Sa_dens", "air density at lowest model layer" + "Sa_pbot", "air pressure at lowest model layer" + "Sa_pslv", "air pressure at land and sea surface" + "Sa_ptem", "potential temperature at lowest model layer" + "Sa_shum", "air specific humidity at lowest model layer" + "Sa_tbot", "air temperature at lowest model layer" + "Sa_topo", "surface topographic height" + "Sa_u", "air zonal wind at lowest model layer" + "Sa_v", "air meridional wind at lowest model layer" + "Sa_z", "air height wind at lowest model layer" + +.. csv-table:: "Sea Ice State Names (import to mediator)" + :header: "name", "description" + :widths: 20, 60 + + "Si_anidf", "sea ice near infrared diffuse albedo" + "Si_anidr", "sea ice near infrared direct albedo" + "Si_avsdf", "sea ice visible diffuse albedo" + "Si_avsdr", "sea ice visible direct albedo" + "Si_ifrac", "sea ice fraction" + "Si_imask", "sea ice land mask" + "Si_ifrac_n", "ice fraction by thickness category" + "Si_qref", "reference height specific humidity" + "Si_qref_wiso", "reference specific water isotope humidity at 2 meters" + "Si_t", "sea ice surface temperature" + "Si_tref", "reference height temperature" + "Si_u10", "10m wind speed" + "Si_vice", "volume of sea ice per unit area" + "Si_snowh", "surface snow water equivalent" + "Si_vsno", "volume of snow per unit area" + +.. csv-table:: "Land State Names (import to mediator)" + :header: "name", "description" + :widths: 20, 60 + + "Sl_anidf", "" + "Sl_anidr", "" + "Sl_avsdf", "" + "Sl_avsdr", "" + "Sl_ddvel", "" + "Sl_fv", "" + "Sl_fztop", "" + "Sl_lfrac", "" + "Sl_lfrin", "" + "Sl_qref", "" + "Sl_qref_wiso", "" + "Sl_ram1", "" + "Sl_snowh", "" + "Sl_snowh_wiso", "" + "Sl_t", "" + "Sl_topo_elev", "" + "Sl_topo", "" + "Sl_tsrf_elev", "" + "Sl_tsrf", "" + "Sl_tref", "" + "Sl_u10", "" + +.. csv-table:: "Ocean State Names (import to mediator)" + :header: "name", "description" + :widths: 20, 60 + + "So_blddepth", "ocean boundary layer depth" + "So_anidf", "ocean near infrared diffuse albedo" + "So_anidr", "ocean near infrared direct albedo" + "So_avsdf", "ocean visible diffuse albedo" + "So_avsdr", "ocean visible direct albedo" + "So_bldepth", "ocean mixed layer depth" + "So_dhdx", "sea surface slope in meridional direction" + "So_dhdy", "sea surface slope in zonal direction" + "So_duu10n", "10m wind speed" + "So_fswpen", "shortwave penetration through sea ice (all bands)" + "So_ofrac", "ocean fraction" + "So_omask", "ocean land mask" + "So_qref", "reference specific humidity at 2 meters" + "So_re", "square of exchange coefficient for tracers (mediator aoflux)" + "So_s", "sea surface salinity" + "So_ssq", "surface saturation specific humidity in ocean (mediator aoflux)" + "So_t", "sea surface temperature" + "So_tref", "reference temperature at 2 meters" + "So_u", "ocean current in zonal direction" + "So_u10", "10m wind speed" + "So_ustar", "friction velocity (mediator aoflux)" + "So_v", "ocean current in meridional direction" + +.. csv-table:: "Land Ice State Names (import to mediator)" + :header: "name", "description" + :widths: 20, 60 + + "Sg_ice_covered", "" + "Sg_ice_covered_elev", "" + "Sg_icemask", "" + "Sg_icemask_coupled_fluxes", "" + "Sg_topo", "" + "Sg_topo_elev", "" + +.. csv-table:: "Wave State Names (import to mediator) " + :header: "name", "description" + :widths: 20, 60 + + "Sw_hstokes", "Stokes drift depth" + "Sw_lamult", "Langmuir multiplier" + "Sw_ustokes", "Stokes drift u-component" + "Sw_vstokes", "Stokes drift v-component" + +.. csv-table:: "Mediator State Names (export from mediator)" + :header: "name", "description" + :widths: 20, 60 + + "Sx_anidf", "" + "Sx_anidr", "" + "Sx_avsdf", "" + "Sx_avsdr", "" + "Sx_qref", "merged reference specific humidity at 2 meters" + "Sx_t", "merged ice and ocean surface temperature" + "Sx_tref", "merged reference temperature at 2 meters" + "Sx_u10", "merged 10m wind speed" + +State Variables +~~~~~~~~~~~~~~~ + +The following flux prefixes are used: + +.. csv-table:: + :header: "flux prefix", "description" + :widths: 20, 60 + + "Faxa\_", "atm flux computed by atm" + "Fall\_", "lnd-atm flux computed by lnd" + "Fioi\_", "ice-ocn flux computed by ice" + "Faii\_", "ice_atm flux computed by ice" + "Flrr\_", "lnd-rof flux computed by rof" + "Firr\_", "rof-ice flux computed by rof" + "Faxx\_", "mediator merged fluxes sent to the atm" + "Foxx\_", "mediator merged fluxes sent to the ocn" + "Fixx\_", "mediator merged fluxes sent to the ice" + +The following flux-names are used: + +.. csv-table:: + :header: "flux name", "description" + :widths: 20, 60 + + "_evap", "air-ice evaporative water flux, positive downwards" + "_lat", "air-ice latent heat, positive downwards" + "_lwup", "air-ice surface longwave flux, positive downwards" + "_sen", "air-ice sensible heat, positive downwards" + "_swnet", "net short wave, positive downwards" + "_melth", "net heat flux to ocean from ice" + "_meltw", "fresh water flux to ocean from ice" + "_salt", "salt to ocean from ice" + "_swpen", "flux of shortwave through ice to ocean" + "_swpen_vdr", "flux of visible direct shortwave through ice to ocean" + "_swpen_vdf", "flux of visible diffuse shortwave through ice to ocean" + "_swpen_idr", "flux of near infrared direct through ice to ocean" + "_swpen_idf", "flux of near infrared diffuse through ice to ocean" + "_taux", "zonal stress, positive downwards" + "_tauy", "air-ice meridional stress, positive downwards" + "_q", "ice-ocn freezing melting potential" diff --git a/doc/source/addendum/index.rst b/doc/source/addendum/index.rst new file mode 100644 index 000000000..18f94418c --- /dev/null +++ b/doc/source/addendum/index.rst @@ -0,0 +1,11 @@ +.. _addendum: + +Addendum +======== + +.. toctree:: + :maxdepth: 1 + + req_attributes.rst + req_attributes_cesm.rst + fieldnames.rst diff --git a/doc/source/addendum/req_attributes.rst b/doc/source/addendum/req_attributes.rst new file mode 100644 index 000000000..d6b844282 --- /dev/null +++ b/doc/source/addendum/req_attributes.rst @@ -0,0 +1,68 @@ +.. _attributes: + +========================================== + CMEPS Application Independent Attributes +========================================== + +The following attributes are obtained from the respective driver and +available to all components that the driver uses. In the case of +NEMS, the NEMS driver ingests these attributes from the +``nems.configure`` file. In the case of CESM, the CESM driver ingests +these attributes from the ``nuopc.runconfig`` file. The list of +attributes below are separated into application independent attributes +and at this time additional attributes required by CESM. There are no +NEMS-specific attributes required by the NEMS application. + + +General +------- + +**coupling_mode** (required) + + The coupling_mode attribute determines which + ``esmFlds_exchange_xxx_mod.F90`` and ``fd_xxx.yaml`` is used by + CMEPS and is also leveraged in some of the custom calculations in + the ``prep`` modules. + + The currently supported values for ``coupling_mode`` are ``cesm``, ``nems_orig``, ``nems_frac`` and ``hafs``. + +Scalar attributes +----------------- + +**ScalarFieldCount** + The maximum number of scalars that are going to be communicated + between the mediator and a component. Currently scalar values are + put into a field bundle that only contains an undistributed + dimension equal to the size of ``ScalarFieldCount`` and communicated + between the component and the mediator on the `master task` of each + component. + +**ScalarFieldName** (required) + This is the name of the scalar field bundle. By default it is ``cpl_scalars``. + +**ScalarFieldIdxGridNX**, **ScalarFieldIdxGridNY** (required) + The global number of longitude and latitude points. For unstructured grids:: + + ScalarFieldIdxGridNY = 1 + ScalarFieldIdxGridNX = global size of mesh + + For cases where ``ScalarFieldIdxGridNY`` is not 1, this scalar data + is needed by the mediator for the history output. + +**ScalarFieldIdxNextSwCday** (optional) + Send by the atmosphere component to specify the calendar day of its + next short wave computation. This is subsequently used by other + components (e.g. cesm-land and sea-ice) in determining the zenith + angle for its albedo calculation. It is also used in the mediator + routine ``med_phases_ocnalb_mod.F90`` to determine the zenith angle + in the ocean albedo calculation. + +Mediator history and restart attributes +--------------------------------------- + +**history_option**, **history_n** (required) + Determines the write frequency for a mediator history file (see :ref:`mediator history writes`). +**restart_option**, **restart_n** (required) + Determines the write frequency for a mediator restart file (see :ref:`mediator restart writes`). +**read_restart** (required) + Determines if a mediator restart file is read in. diff --git a/doc/source/addendum/req_attributes_cesm.rst b/doc/source/addendum/req_attributes_cesm.rst new file mode 100644 index 000000000..c8d6ff7fa --- /dev/null +++ b/doc/source/addendum/req_attributes_cesm.rst @@ -0,0 +1,134 @@ +.. _cesm-attributes: + +======================= + CMEPS CESM attributes +======================= + +The following *additional* attributes are required for CESM model applications. + +General +-------------- + +**diro**, **logfile** + Specifies the full pathname of the directory and filename of the directory and file name for mediator log output. + For CESM this is determine in the attribute group ``MED_modelio`` that is generated by the CIME case control system. + +**flds_i2o_per_cat** + if true, select per ice thickness category fields are passed to the ocean. + +Toggle for active compoenents +----------------------------- + +**ATM_model**, **GLC_model**, **ICE_model**, **LND_model**, **ROF_model**, **OCN_model**, **WAV_model** + In CESM, stub components are still used. These attributes determine if the component is a stub component and sets the + mediator present flag for that component to ``false``. + +Mediator Mapping file attributes +-------------------------------- + + If a mapping file value is set to ``unset``, then CMEPS will create an online route handle instead. + +**ice2atm_fmapname**, **ice2atm_smapname** + ice -> atm fluxes and state mapping files +**lnd2atm_fmapname**, **lnd2atm_smapname** + land -> atm fluxes and state mapping files +**ocn2atm_smapname**, **ocn2atm_fmapname** + ocean -> atm fluxes and state mapping files +**atm2lnd_fmapname**, **atm2lnd_smapname** + atm -> land fluxes and state mapping files +**atm2ice_fmapname**, **atm2ice_smapname**, **atm2ice_vmapname** + atmosphere -> sea-ice fluxes, state, and velocities +**atm2ocn_fmapname**, **atm2ocn_smapname**, **atm2ocn_vmapname** + atmosphere -> ocean fluxes, state, and velocities +**rof2lnd_fmapname** + river -> land flux mapping file +**glc2lnd_fmapname**, **glc2lnd_smapname** + land-ice -> land fluxes and state mapping files +**glc2ice_rmapname** + "smoothed" land-ice -> sea-ice liquid mapping file +**glc2ocn_liq_rmapname**, **glc2ocn_ice_rmapname** + "smoothed" land-ice -> ocean liquid and ice mapping files +**rof2ocn_liq_rmapname**, **rof2ocn_ice_rmapname** + "smoothed" river -> ocean liquid and ice mapping file +**wav2ocn_smapname** + wave -> ocean state mapping file +**lnd2rof_fmapname** + land -> river flux mapping file +**lnd2glc_fmapname**, **lnd2glc_smapname** + land -> land-ice flux and state mapping file +**atm2wav_smapname**, **ice2wav_smapname**, **ocn2wav_smapname** + atmosphere -> wave, ice -> wave and ocean -> wave state mapping files + +**mapuv_with_cart3d** + used for atm->ocn and atm-ice mapping of u and v + if true, rotate u,v to 3d cartesian space, map from src->dest, then rotate back + +Mediator ocean albedo attributes +-------------------------------- + + The following are used by CMEPS to calculate ocean albedoes in used in ``med_phases_ocnalb_mod.F90`` + +**start_type** + Determines if start type of the run. The currently supported values are ``startup``, ``continue`` and ``branch``. +**orb_mode** + orbital model setting configured. The supported values are:: + + 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 + +**orb_iyear** + year of orbit, used when orb_mode is fixed_year or variable_year +**orb_iyear_align** + model year associated with orb_iyear when orb_mode is variable_year +**orb_obliq** + obliquity of orbit in degrees, used when orb_mode is fixed_parameters +**orb_eccen** + eccentricity of orbit, used when orb_mode is fixed_parameters. +**orb_mvelp** + location of vernal equinox in longitude degrees, used when orb_mode is fixed_parameters + +Mediator land-ice component attribtes +------------------------------------- + +**glc_renormalize_smb** + 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. + +**glc_avg_period** + Period at which coupler averages fields sent to GLC (the land-ice component). + 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). + +**glc_cpl_dt** + glc coupling interval in seconds diff --git a/doc/source/conf.py b/doc/source/conf.py index 521cbb6ef..80334e199 100644 --- a/doc/source/conf.py +++ b/doc/source/conf.py @@ -39,7 +39,6 @@ 'sphinx.ext.autosummary', 'sphinx.ext.viewcode', 'sphinx.ext.todo', - 'sphinxcontrib.programoutput' ] todo_include_todos=True diff --git a/doc/source/esmflds.rst b/doc/source/esmflds.rst new file mode 100644 index 000000000..960789491 --- /dev/null +++ b/doc/source/esmflds.rst @@ -0,0 +1,247 @@ +.. _api-for-esmflds: + +================================ + CMEPS application specific code +================================ + +For each supported application, CMEPS contains two specific files that determine: + +* the allowed field names in the mediator and aliases for those names that the components might have +* the fields that are exchanged between components +* how source fields are mapped to destination fields +* how source fields are merged after mapping to destination fields + +Three application specific versions are currently contained within CMEPS: + +* for CESM: **esmFldsExchange_cesm_mod.F90** and **fd_cesm.yaml** +* for UFS-S2S: **esmFldsExchange_nems_mod.F90** and **fd_nems.yaml** +* for UFS-HAFS: **esmFldsExchange_hafs_mod.F90** and **fd_hafs.yaml** + +CMEPS advertises **all possible fields** that can be imported to and +exported by the mediator for the target coupled system. Not all of +these fields will be connected to the various components. The +connections will be determined by what the components advertise in +their respective advertise phase. + +Across applications, component-specific names for the same fields may vary. The field +dictionary is used to define how the application or component-specific name relates +to the name that the CMEPS mediator uses for that field. The mediator variable +names and their application specific aliases are found in the YAML field dictionary. + +Details of the naming conventions and API's of this file can be found +in the description of the :ref:`exchange of fields in +CMEPS`. + +Field Naming Convention +----------------------- + +The CMEPS field name convention in the YAML files is independent of the model components. +The convention differentiates between variables that are state fields versus flux fields. +The naming convention assumes the following one letter designation for the various components as +well as the mediator. + +**import to mediator**:: + + a => atmosphere + i => sea-ice + l => land + g => land-ice + o => ocean + r => river + w => wave + +**export from mediator (after mapping and merging)**:: + + x => mediator + +**State Variables**: + + State variables have a 3 character prefix followed by the state + name. The prefix has the form ``S[a,i,l,g,o,r,w,x]_`` and is followed by + the field name. + + As an example, ``Sx_t`` is the merged surface + temperature from land, ice and ocean sent to the atmosphere for CESM. + +**Flux variables**: + + Flux variables specify both source and destination components and have a + 5 character prefix followed by an identifier name of the flux. The first 5 + characters of the flux prefix ``Flmn_`` indicate a flux between + components l and m, computed by component n. The flux-prefix is followed + by the relevant flux-name. + + **mediator import flux prefixes**:: + + Faxa_, atm flux computed by atm + Fall_, lnd-atm flux computed by lnd + Fioi_, ice-ocn flux computed by ice + Faii_, ice_atm flux computed by ice + Flrr_, lnd-rof flux computed by rof + Firr_, rof-ice flux computed by rof + + **mediator export flux prefixes**:: + + Faxx_, mediator merged fluxes sent to the atm + Foxx_, mediator merged fluxes sent to the ocn + Fixx_, mediator merged fluxes sent to the ice + +Exchange of fields +------------------ + +The application specific module, ``esmFldsExchange_xxx.F90`` contains +all of the information to determine how the mediator performs the +exchange of fields between components. In particular, this module uses the subroutines +``addfld``, ``addmap`` and ``addmrg`` to do the following: + +* ``addfld`` advertises all possible fields that the mediator can send + to and receive from each component that is part of the target + application + +* ``addmap`` determines how each source field is mapped from its + source mesh to a target destinations mesh. Note that a given source + field may be mapped to more than one destination meshes and so there + can be more than one call to ``addmap`` for that source field. + +* ``addmrg`` determines how a collection of mapped source fields + is merged to the target destination field. + +.. note:: In all these functions, specific components are accessed using a comp_index, where comp_index can be any of [compatm, compice, compglc, complnd, compocn, comprof, compwav]. + +This section describes the API for the calls that determine the above +information. All of the API's discussed below use the code in the +generic module ``esmFlds.F90``. + +.. _addfld: + +`addfld` +~~~~~~~~~~ +CMEPS advertises all possible fields that it can receive from a component or send to any component via a call to ``addfld``. +The API for this call is: + +.. code-block:: Fortran + + call addfld(fldListFr(comp_index)%flds, 'field_name') + call addfld(fldListTo(comp_index)%flds, 'field_name') + +where: + +* ``comp_index`` is the component index + +* ``'field_name'`` is the field name that will be advertised + +.. _addmap: + +`addmap` +~~~~~~~~~~ +CMEPS determines how to map each source field from its source mesh to a target destination mesh via a call to ``addmap``. +The API for this call is: + +.. code-block:: Fortran + + call addmap(FldListFr(comp_index_src)%flds, 'field_name', comp_index_dst, maptype, mapnorm, mapfile) + +where + +* ``comp_index_src`` is the source component index + +* ``comp_index_dst`` is the destination component index + +* **maptype** determines the mapping type and can have values of: + + * ``mapbilnr``: bilinear mapping + + * ``mapconsf``: first order conservative mapping with normalization type of conservative fraction. + + * ``mapconsd``: first order conservative mapping with normalization type of conservative fraction. + + * ``mappatch``: patch mapping + + * ``mapfcopy``: redist mapping + + * ``mapnstod``: nearest source to destination mapping + + * ``mapnstod_consd``: nearest source to destination followed by conservative destination + + * ``mapnstod_consf``: nearest source to destination followed by conservative fraction + +.. _normalization: + +* **mapnorm** determines the mapping normalization and can have values of: + + * ``unset`` : no normalization is set, should only be used if maptype is 'mapfcopy' + + * ``none`` : no normalization is done, should only be used if maptype is not 'mapfcopy' + + * ``one`` : normalize by 1. (see description below for normalization) + + * ``lfrin`` : normalize by the ``lfrin`` field in FBFrac(complnd). Used to map lnd->atm (see description of :ref:`fractions`). + + * ``ifrac`` : normalize by the 'ifrac' field in FBFrac(compice). Used to map ice->atm (see description of :ref:`fractions`). + + * ``ofrac`` : normalize by the 'ofrac' field in FBFrac(compocn). Used to map ice->atm (see description of :ref:`fractions`). + + * ``custom`` : custom mapping and normalization will be done in the prep phase for the corresponding field (used to map glc->lnd). + + .. note:: When **mapnorm** is used, the field will first be scaled by the relevant ``FBfrac`` before mapping and then unscaled by the same ``FBfrac`` after mapping. For example, when ``ifrac`` is the normalization, the field will be scaled by ``FBfrac(compice)[ifrac]`` before mapping and unscaled by the mapped ``FBFrac(compice)[ifrac]`` after mapping. + +* **mapfile** determines if a mapping file will be read in or the route handle will be generated at run time: + + * ``unset`` : online route handles will be generated + + * ``mapfile``: read in corresponding full pathname. The ```` is obtained as an attribute from the driver + +**Normalization** : +Fractional normalization is needed to improve the accuracy field exchanges between ice and ocean and atmosphere. Consider the case where one cell has an ice +fraction of 0.3 and the other has a fraction of 0.5. Mapping the ice fraction to the atmospheric cell results in a value of 0.4. If the same temperatures are +mapped in the same way, a temperature of -1.5 results which is reasonable, but not entirely accurate. Because of the relative ice fractions, the weight of the +second cell should be greater than the weight of the first cell. Taking this into account properly results in a fraction weighted ice temperature of -1.625 in +this example. This is the fraction correction that is carried out whenever ocean and ice fields are mapped to the atmosphere grid. Note that time varying +fraction corrections are not required in other mappings to improve accuracy because their relative fractions remain static. + +**Example** : + +.. code-block:: Fortran + + call addmap(fldListFr(compice)%flds, 'Si_snowh', compatm, mapconsf, 'ifrac', 'unset') + +This will create an entry in ``fldListFr(compatm)`` specifying that the ``Si_snowh`` field from the ice should be mapped conservatively to the atmosphere using +fractional normalization where the ice fraction is obtained from ``FBFrac(compice)[snowh]``. The route handle for this mapping will be created at run time. + +.. _addmrg: + +`addmrg` +~~~~~~~~~~ +CMEPS determines how to map a set of one or more mapped source fields to create the target destination field in the export state. +The API for this call is: + +.. code-block:: Fortran + + call addmrg(fldListTo(comp_index_dst)%flds, dst_fieldname, & + mrg_from1, mrg_fld1, mrg_type1, mrg_fracname1, & + mrg_from2, mrg_fld2, mrg_type2, mrg_fracname2, & + mrg_from3, mrg_fld3, mrg_type3, mrg_fracname3, & + mrg_from4, mrg_fld4, mrg_type4, mrg_fracname4) + +where + +* ``mrg_fromN``, ``mrgfldN``, ``mrgtypeN`` and ``mrg_fracnameN``, where ``N=[1,2,3,4]``, are optional arguments. + ``mrgfrom1`` is corresponds to the first source component index (e.g. ``compatm``). + +* **mrg_fromN**: is an integer corresponding to the source component index + +* **mrg_fldN** : is a character string corresponding to the field name in the mapped field bundle of the source component with index ``mrg_fromN`` + +* **mrg_typeN**: the type of merging that will be carried out for component with index ``mrg_fromN``. The allowed values are: + + * ``copy``: simply copy the source mapped field into the destination field bundle + + * ``copy_with_weights``: weight the mapped source field by its fraction on the destination mesh. + + * ``sum_with_weights``: do a cumulative sum of all the mapped source fields where each field is weighed by by its fraction on the destination mesh. + + * ``sum_with_weights``: do a cumulative sum of all the mapped source fields. + +For ``copy_with_weights`` and ``sum_with_weights``, the mapped source field is weighted by ``mrg_fracnameN`` in ``FBFrac(comp_index_dst)``. If +copy_with_weights is chose as the ``mrg_typeN`` value then ``mrg_fracnameN`` is also required as an argument. If sum_with_weights is chose as the ``mrg_typeN`` +value then ``mrg_fracnameN`` is also required as an argument. diff --git a/doc/source/field_naming_convention.rst b/doc/source/field_naming_convention.rst deleted file mode 100644 index 66eae269d..000000000 --- a/doc/source/field_naming_convention.rst +++ /dev/null @@ -1,53 +0,0 @@ -.. _field_naming_convention: - -Application Specific Field Exchange Specification -================================================= - -CMEPS contains two component specific files that determine: - - the fields that are exchanged between components - - how source fields are mapped to destination fields - - how source fields are merged after mapping to destination fields - - -Field Naming Convention -======================= - -The mediator variable names can be seen in the application specific YAML field dictionary. Currently, three -field dictionaries are supported:: - - fd_cesm.yaml - fd_nems.yaml - -The CMEPS field name convention in these YAML files is independent of the model components. -The convention differentiates between variables that are state fields versus flux fields. - -State variables have a prefix that always start with an ``S`` followned by a two character string:: - - state-prefix - first 3 characters: Sx_, Sa_, Si_, Sl_, So_ - one letter indices: x,a,l,i,o,g,r - x => mediator (mapping, merging) - a => atmosphere - l => land - i => sea-ice - o => ocean - g => land-ice - r => river - w => wave - - state-name - what follows state prefix - -As an example, ``Sx_t`` is the merged surface temperature from land, ice and ocean sent to the atmopshere for CESM. - -Flux variables that specifies both source and destination components and have a 5 character prefix:: - - flux-prefix - first 5 characters: Flmn_ - lm => between components l and m - n => computed by component n - example: Fioi => ice-ocn flux computed by ice - example: Fall => atm-lnd flux computed by lnd - - flux-name - what follows flux-prefix diff --git a/doc/source/fractions.rst b/doc/source/fractions.rst new file mode 100644 index 000000000..77d712e80 --- /dev/null +++ b/doc/source/fractions.rst @@ -0,0 +1,117 @@ +.. _fractions: + +========================== + CMEPS `fractions` module +========================== + +The component fractions on their corresponding meshes are defined and +updated in ``med_fractions_mod.F90.`` + +CMEPS component fractions are defined as follows: + +* An array of field bundles, ``Frac(:)`` is created, where the size of + ``Frac`` corresponds to the number of active components. + +* For each active component, a fraction field bundle is created, ``Frac(comp_index)``, where the fields in the field bundle are unique. + Below, ``Frac(comp_index)[fieldname]`` refers to the field in the ``Frac(comp_index)`` field bundle that has the name ``fieldname``. + +.. note:: comp_index can be any of [compatm, compice, compglc, complnd, compocn, comprof, compwav]. + +* The following are the field names for each component of FBFrac:: + + Frac(compatm) = afrac,ifrac,ofrac,lfrac,lfrin + Frac(compocn) = afrac,ifrac,ofrac,ifrad,ofrad + Frac(compice) = afrac,ifrac,ofrac + Frac(complnd) = afrac,lfrac,lfrin + Frac(compglc) = gfrac,lfrac + Frac(comprof) = lfrac,rfrac + Frac(compwav) = wfrac + +where:: + + afrac = fraction of atm on a grid + lfrac = fraction of lnd on a grid + ifrac = fraction of ice on a grid + ofrac = fraction of ocn on a grid + lfrin = land fraction defined by the land model + rfrac = fraction of rof on a grid + wfrac = fraction of wav on a grid + ifrad = fraction of ocn on a grid at last radiation time + ofrad = fraction of ice on a grid at last radiation time + + As an example, ``Frac(compatm)[lfrac]`` is the land fraction on + the atmosphere mesh. + +* ``lfrin`` and ``lfrac`` can be different from ``lfrac`` when the + atmosphere and land meshes are different. ``lfrac`` is the land + fraction consistent with the ocean mask where ``lfrin`` is the land + fraction in the land component. + +* ``ifrad`` and ``ofrad`` are fractions at the last radiation + timestep. These fractions preserve conservation of heat in the net + shortwave calculation because the net shortwave calculation is one + timestep behind the ice fraction evolution in the system. + +The following assumptions are made regarding fractions: + +* The ocean and ice are on the same meshes with same masks +* The ice fraction can evolve in time +* The land fraction does not evolve in time +* the ocean fraction is just the complement of the ice fraction over the region + of the ocean/ice mask. +* The component fractions are always the relative fraction covered. + For example, if an ice cell can be up to 50% covered in + ice and 50% land, then the ice domain should have a fraction + value of 0.5 at that grid cell. At run time though, the ice + fraction will be between 0.0 and 1.0 meaning that grid cells + is covered with between 0.0 and 0.5 by ice. The "relative" fractions + sent at run-time are corrected by the model to be total fractions + such that in general, on every mesh cell: + + * ``Frac(:)[afrac]`` = 1.0 + * ``Frac(:)[ifrac]`` + ``Frac(:)[ofrac]`` + ``Frac(:)[lfrac]`` = 1.0 + +Initialization of the fractions occurs as follows (note that all mapping is first order conservative): + +* ``Frac(compatm)[afrac]`` = 1.0 + +* ``Frac(compocn)[afrac]`` = map atm -> ocn ``Frac(compatm)[afrac]`` + +* ``Frac(compice)[afrac]`` = map atm -> ice ``Frac(compatm)[afrac]`` + +* ``Frac(complnd)[afrac]`` = map atm -> lnd ``Frac(compatm)[afrac]`` + +* ``FBfrac(:)[ifrac]`` = 0.0 + +* ``Frac(compocn)[ofrac]`` = ocean mask provided by ocean + +* ``Frac(complnd)[lfrin]`` = land fraction provided by land + +* ``Frac(compatm)[ofrac]`` = map ocn -> atm ``Frac(compocn)[ofrac]`` + +* ``Frac(compatm)[lfrin]`` = map lnd -> atm ``Frac(complnd)[lfrin]`` + +* ``Frac(compatm)[lfrac]`` = 1.0 - ``Frac(compatm)[ofrac]`` + (this is truncated to zero for very small values (< 0.001) to attempt to preserve non-land gridcells.) + +* ``Frac(complnd)[lfrac]`` = map atm -> lnd ``Frac(compatm)[lfrac]`` + +* ``Frac(comprof)[lfrac]`` = map lnd -> rof ``Frac(complnd)[lfrac]`` + +* ``Frac(compglc)[lfrac]`` = map lnd -> glc ``Frac(complnd)[lfrac]`` + +Run time calculation of fractions is as follows: + +* ``Frac(compice)[ofrac]`` = 1.0 - ``Frac(compice)[ifrac]`` + (Note: the relative fractions are corrected to total fractions) + +* ``Frac(compocn)[ifrac]`` = map ice -> ocn ``Frac(compice)[ifrac]`` + +* ``Frac(compocn)[ofrac]`` = map ice -> ocn ``Frac(compice)[ofrac]`` + +* ``Frac(compatm)[ifrac]`` = map ice -> atm ``Frac(compice)[ifrac]`` + +* ``Frac(compatm)[ofrac]`` = map ice -> atm ``Frac(compice)[ofrac]`` + +* ``Frac(compatm)[lfrac]`` + ``Frac(compatm)[ofrac]`` + ``Frac(compatm)[ifrac]`` ~ 1.0 + (0.0-eps < Frac(:)[*] < 1.0+eps) diff --git a/doc/source/generic.rst b/doc/source/generic.rst new file mode 100644 index 000000000..62055af1c --- /dev/null +++ b/doc/source/generic.rst @@ -0,0 +1,145 @@ +.. _generic_modules: + +========================= + CMEPS `generic` modules +========================= + +The following describes in some detail the CMEPS modules that are not +application specific and provide general functionality. + +**med.F90** + + This module is initializes the CMEPS mediator functionality by performing the following functions: + + * adding a namespace (i.e. nested state) for each import and export + component state in the mediator's InternalState + + * initializing the mediator component specific fields via a call to + ``esmFldsExchange_xxx_`` (where currently xxx can be ``cesm``, ``nems`` or ``hafs``). + + * determining which components are present + + * advertising the import and export mediator fields + + * creating import (``FBImp``), export (``FBExp``) and accumulation (``FBExpAccum``) field bundles + + * initializing the mediatory route handles and field bundles needed for normalization + + * initializing component ``FBFrac`` field bundles + + * reading mediator restarts + + * optionally carrying out initializations for atmosphere/ocean flux + calculations and ocean albedo calculations (these are needed by CESM) + + * carrying out the NUOPC data initialization via the ``DataInitialize`` routine. + + .. note:: After the first DataInitialize() of CMEPS returns, + NUOPC will note that its InitializeDataComplete is not yet true. The + NUOPC Driver will then execute the Run() phase of all of the Connectors that + fit the xxx-TO-MED pattern. After that, it will call CMEPS + DataInitialize() again. Note that the time stamps are only set + when the Run() phase of all the connectors are run and the + Connectors Run() phase is called before the second call of the + CMEPS DataInitialize phase. As a result, CMEPS will see the + correct timestamps, which also indicates that the actual data has + been transferred reliably, and CMEPS can safely use it. + +**med_map_mod.F90** + + This module creates the required route handles that are needed for + the model run. The route handles are stored in the multi-dimensional array + ``RH(ncomps,ncomps,nmappers)`` in the module ``med_internal_state_mod.F90``. + + ``nmappers`` is the total number of mapping types that CMEPS supports (currently 8). + These are described in :ref:`mapping types`. + + ``ncomps,ncomps`` corresponds to the source and destination component indices. + + As an example ``RH(compatm,compocn,mapbilnr)`` is the atm->ocn bilinear route handle. + + **med_map_mod.F90** also initializes additional field bundles that + are needed for mapping fractional normalization (see the + :ref:`mapping normalization `). Normalization is + normally done using the relevant field from ``FBFrac(:)``. + + The default call to carry out mediator mapping is done in the + :ref:`prep_modules` by calling + ``med_map_FB_Regrid_Norm``. Mapping is done by using the + ``fldListFr(:)`` data that was initialized in the + ``esmFldsExchange_xxxx_mod.F90`` calls to ``addmap``. + +**med_merge_mod.F90** + + This module carries out merging of one or more mapped source fields + to the target destination field (see :ref:`merging + types`). The :ref:`prep_modules` carry out + merging via the call to ``med_merge_auto`` Merging is done by using + the ``fldListTo(:)`` data that was initialized in the + ``esmFldsExchange_xxx_mod.F90`` calls to ``addmrg``. + +**med_io_mod.F90** + + CMEPS uses the PIO2 parallel library to carry out all IO. PIO + provides a netCDF-like API, and allows users to designate some + subset of processors to perform IO. Computational code calls + netCDF-like functions to read and write data, and PIO uses the IO + processors to perform all necessary IO. This module contains + wrapper layers to PIO for writing and reading mediator restart + files and for writing mediator history files. + +.. _history_writes: + +**med_phases_history_mod.F90** + + This module writes mediator history files. The freqency of CMEPS + history writes is controlled via the NUOPC attributes + ``history_option`` and ``history_n``. These attributes control + instantaneous mediator history output as follows: + + ============== ============================================================= + history_option description + ============== ============================================================= + none do not write any history files + never do not write any history files + nsteps write files every ``history_n`` mediator coupling intervals + nseconds write files every ``history_n`` seconds + nminutes write files every ``history_n`` minutes + nhours write files every ``history_n`` hours + ndays write files every ``history_n`` days + nmonths write files every ``history_n`` months + nyears write files every ``history_n`` years + monthly write files on the month boundary + yearly write files on the year boundary + ============== ============================================================= + + .. note:: It is assumed that the NUOPC attributes ``history_option`` and ``history_n`` + are obtained by the model driver and passed down to the mediator. + +.. _restart_writes: + +**med_phases_restart_mod.F90** + + This module reads and writes mediator restart files. The freqency of CMEPS + restart writes is controlled via the NUOPC attributes + ``restart_option`` and ``restart_n``. These attributes control + instantaneous mediator history output as follows: + + ============== ============================================================= + restart_option description + ============== ============================================================= + none do not write any restart files + never do not write any restart files + nsteps write files every ``restart_n`` mediator coupling intervals + nseconds write files every ``restart_n`` seconds + nminutes write files every ``restart_n`` minutes + nhours write files every ``restart_n`` hours + ndays write files every ``restart_n`` days + nmonths write files every ``restart_n`` months + nyears write files every ``restart_n`` years + monthly write files on the month boundary + yearly write files on the year boundary + ============== ============================================================= + + .. note:: It is assumed that the NUOPC attributes ``restart_option`` and ``restart_n`` + are obtained by the model driver and passed down to the mediator. diff --git a/doc/source/index.rst b/doc/source/index.rst index e316fa48e..c03f6276e 100644 --- a/doc/source/index.rst +++ b/doc/source/index.rst @@ -15,6 +15,11 @@ Table of contents ----------------- .. toctree:: :maxdepth: 2 + :numbered: introduction.rst - field_naming_convention.rst + esmflds.rst + fractions.rst + prep.rst + generic.rst + addendum/index.rst diff --git a/doc/source/introduction.rst b/doc/source/introduction.rst index 8507d8ccb..3b79e1ed0 100644 --- a/doc/source/introduction.rst +++ b/doc/source/introduction.rst @@ -1,4 +1,631 @@ Introduction ============ -Content to go here: +CMEPS is a NUOPC-compliant mediator which uses ESMF to couple earth grid components in a hub and spoke system. + +As a mediator, CMEPS is responsible for transferring field information from one +model component to another. This transfer can require one or more operations on +the transferred fields, including mapping of fields between component grids, +merging of fields between different components and time-averaging of fields +over varying coupling periods. + + + +Components share information via import and export states, which are containers +for ESMF data types that wrap native model data. The states also contain +metadata, which includes physical field names, the underlying grid structure +and coordinates, and information on the parallel decomposition of the fields. +Note that while CMEPS itself is a mesh based mediator, component models coupled +by the CMEPS mediator can be either grid or mesh based. + +Each component model using the CMEPS mediator is serviced by a NUOPC-compliant +cap. The NUOPC cap is a small software layer between the underlying model code +and the mediator. Fields for which the mediator has created a connection +between model components are placed in either the import or export state of the +component within the NUOPC cap. The information contained within these states +is then passed into native model arrays or structures for use by the component +model. + +Field connections made by the CMEPS mediator between components rely on +matching of standard field names. These standard names are defined in a field +dictionary. Since CMEPS is a community mediator, these standard names are +specific to each application. + + +Organization of the CMEPS mediator code +####################################### + + +When you check out the code you will files, which can be organized into three +groups: + +* totally generic components that carry out the mediator functionality such as mapping, + merging, restarts and history writes. Included here is a a "fraction" module that + determines the fractions of different source model components on every source + destination mesh. + +* application specific code that determines what fields are exchanged between + components and how they are merged and mapped. + +* prep phase modules that carry out the mapping and merging from one or more + source components to the destination component. + +=========================== ============================ =========================== + Generic Code Application Specific Code Prep Phase Code +=========================== ============================ =========================== +med.F90 esmFldsExchange_cesm_mod.F90 med_phases_prep_atm_mod.F90 +esmFlds.F90 esmFldsExchange_nems_mod.F90 med_phases_prep_ice_mod.F90 +med_map_mod.F90 esmFldsExchange_hafs_mod.F90 med_phases_prep_ocn_mod.F90 +med_merge_mod.F90 fd_cesm.yaml med_phases_prep_glc_mod.F90 +med_frac_mod.F90 fd_nems.yaml med_phases_prep_lnd_mod.F90 +med_internalstate_mod.F90 fd_hafs.yaml med_phases_prep_rof_mod.F90 +med_methods_mod.F90. +med_phases_aofluxes_mod.F90 +med_phases_ocnalb_mod.F90 +med_phases_history_mod.F90 +med_phases_restart_mod.F90 +med_phases_profile_mod.F90 +med_io_mod.F90 +med_constants_mod.F90 +med_kind_mod.F90 +med_time_mod.F90 +med_utils_mod.F90 +=========================== ============================ =========================== + +.. note:: Some modules, such as med_phases_prep_ocn.F90 and med_frac_mod.F90 also contain application specific-code blocks. + +Mapping and Merging Primer +####################################### + +This section provides a primer on mapping (interpolation) and merging of gridded +coupled fields. Masks, support for partial fractions on grids, weights generation, +and fraction +weighted mapping and merging all play roles in the conservation and quality of the +coupled fields. + +A pair of atmosphere and ocean/ice grids can be used to highlight the analysis. + +.. image:: CMEPS-grid1.png + :width: 400 + :alt: Sample CMEPS grids + +The most general CMEPS mediator assumes the ocean and sea ice surface grids are +identical while the atmosphere and land grids are also identical. The ocean/ice +grid defines the mask which means each ocean/ice gridcell is either a fully +active ocean/ice gridcell or not (i.e. land). Other configurations have been +and can be implemented and analyzed as well. + +The ocean/ice mask interpolated to the atmosphere/land grid +determines the complementary ocean/ice and land masks on the atmosphere grid. +The land model supports partially active gridcells such that each atmosphere +gridcell may contain a fraction of land, ocean, and sea ice. + +Focusing on a single atmosphere grid cell. + +.. image:: CMEPS-grid2.png + :width: 400 + :alt: Sample CMEPS gridcell overlap + +The gridcells can be labeled as follows. + +.. image:: CMEPS-grid3.png + :width: 300 + :alt: Sample CMEPS gridcell naming convention + +The atmosphere gridcell is labeled "a". On the atmosphere gridcell (the red box), +in general, +there is a land fraction (fal), an ocean fraction (fao), and a sea ice fraction +(fai). The sum of the surface fractions should always be 1.0 in these +conventions. There is also a gridbox average field on the atmosphere grid (Fa). +This could be a flux or a state that is +derived from the equivalent land (Fal), ocean (Fao), and sea ice (Fai) fields. +The gridbox average field is computed by merging the various surfaces:: + + Fa = fal*Fal + fao*Fao + fai*Fai + +This is a standard merge where:: + + fal + fao + fai = 1.0 + +and each surface field, Fal, Fao, and Fai are the values of the surface fields +on the atmosphere grid. + +The ocean gridcells (blue boxes) are labeled 1, 2, 3, and 4 in this example. +In general, +each ocean/ice gridcell partially overlaps multiple atmosphere gridcells. +Each ocean/ice gridcell has an overlapping Area (A) and a Mask (M) associated with it. +In this example, land is colored green, ocean blue, and sea ice white so just for +the figure depicted:: + + M1 = 0 + M2 = M3 = M4 = 1 + +Again, the ocean/ice areas (A) are overlapping areas so the sum of the overlapping +areas is equal to the atmophere area:: + + Aa = A1 + A2 + A3 + A4 + +The mapping weight (w) defined in this example allows a field on the ocean/ice +grid to be interpolated to the atmosphere/land grid. The mapping weights can +be constructed to be conservative, bilinear, bicubic, or with many other +approaches. The main point is that the weights represent a linear sparse matrix +such that in general:: + + Xa = [W] * Xo + +where Xa and Xo represent the vector of atmophere and ocean gridcells respectively, +and W is the sparse matrix weights linking each ocean gridcell to a set of atmosphere +gridcells. Nonlinear interpolation is not yet supported in most coupled systems. + +Mapping weights can be defined in a number of ways even beyond conservative +or bilinear. They can be masked or normalized using multiple approaches. The +weights generation is intricately tied to other aspects of the coupling method. +In CMEPS, area-overlap conservative weights are defined as follows:: + + w1 = A1/Aa + w2 = A2/Aa + w3 = A3/Aa + w4 = A4/Aa + +This simple approach which does not include any masking or normalization provides a +number of useful attributes. The weights always add up to 1.0:: + + w1 + w2 + w3 + w4 = 1.0 + +and a general area weighted average of fields on the ocean/ice grid mapped to +the atmosphere grid would be:: + + Fa = w1*F1 + w2*F2 + w3*F3 + w4*F4 + +These weights conserve area:: + + w1*Aa + w2*Aa + w3*Aa + w4*Aa = Aa + +and can be used to interpolate the ocean/ice mask to the atmosphere grid to compute +the land fraction:: + + f_ocean = w1*M1 + w2*M2 + w3*M3 + w4*M4 + f_land = (1-f_ocean) + +These weights also can be used to interpolate surface fractions:: + + fal = w1*fl1 + w2*fl2 + w3*fl3 + w4*fl4 + fao = w1*fo1 + w2*fo2 + w3*fo3 + w4*fo4 + fai = w1*fi1 + w2*fi2 + w3*fi3 + w4*fi4 + +Checking sums:: + + fal + fao + fai = w1*(fl1+fo1+fi1) + w2*(fl2+fo2+fi2) + w3*(fl3+fo3+fi3) + w4*(fl4+fo4+fi4) + fal + fao + fai = w1 + w2 + w3 + w4 = 1.0 + +And the equation for f_land and fal above are consistent if fl1=1-M1:: + + f_land = 1 - f_ocean + f_land = 1 - (w1*M1 + w2*M2 + w3*M3 + w4*M4) + + fal = w1*(1-M1) + w2*(1-M2) + w3*(1-M3) + w4*(1-M4) + fal = w1 + w2 + w3 + w4 - (w1*M1 + w2*M2 + w3*M3 + w4*M4) + fal = 1 - (w1*M1 + w2*M2 + w3*M3 + w4*M4) + +Clearly defined and consistent weights, areas, fractions, and masks is critical +to generating conservation in the system. + +When mapping masked or fraction weighted fields, these weights require that the +mapped field be normalized by the mapped fraction. Consider a case where sea +surface temperature (SST) is to be mapped to the atmosphere grid with:: + + M1 = 0; M2 = M3 = M4 = 1 + w1, w2, w3, w4 are defined as above (ie. A1/Aa, A2/Aa, A3/Aa, A4/Aa) + +There are a number of ways to compute the mapped field. The direct weighted +average equation, **Fa = w1*Fo1 + w2*Fo2 + w3*Fo3 + w4*Fo4, is ill-defined** +because w1 is non-zero and Fo1 is underfined since it's a land gridcell +on the ocean grid. A masked weighted average, +**Fa = M1*w1*Fo1 + M2*w2*Fo2 + M3*w3*Fo3 + M4*w4*Fo4 is also problematic** +because M1 is zero, so the contribution of the first term is zero. But the sum +of the remaining weights (M2*w2 + M3*w3 + M4*w4) is now not identically 1 +which means the weighted average is incorrect. (To test this, assume all the +weights are each 0.25 and all the Fo values are 10 degC, Fa would then be 7.5 degC). +Next consider a masked weighted normalized average, +**f_ocean = (w1*M1 + w2*M2 + w3*M3 + w4*M4) combined with +Fa = (M1*w1*Fo1 + M2*w2*Fo2 + M3*w3*Fo3 + M4*w4*Fo4) / (f_ocean) which produces a reasonable but incorrect result** +because the weighted average uses the mask instead of the fraction. The +mask only produces a correct result +in cases where there is no sea ice because sea ice impacts the surface fractions. +Finally, consider +a fraction weighted normalized average using the dynamically varying +ocean fraction that is exposed to the atmosphere:: + + fo1 = 1 - fi1 + fo2 = 1 - fi2 + fo3 = 1 - fi3 + fo4 = 1 - fi4 + fao = w1*fo1 + w2*fo2 + w3*fo3 + w4*fo4 + Fao = (fo1*w1*Fo1 + fo2*w2*Fo2 + fo3*w3*Fo3 + fo4*w4*Fo4) / (fao) + +where fo1, fo2, fo3, and fo4 are the ocean fractions on the ocean gridcells +and depend on the sea ice fraction, +fao is the mapped ocean fraction on the atmosphere gridcell, and Fa +is the mapped SST. The ocean fractions are only defined where the ocean +mask is 1, otherwise the ocean and sea ice fractions are zero. +Now, the SST in each ocean gridcell is weighted by the fraction of the ocean +box exposed to the atmosphere and that weighted average is normalized by +the mapped dynamically varying fraction. This produces a reasonable result +as well as a conservative result. + +The conservation check involves thinking of Fo and Fa as a flux. On the +ocean grid, the quantity associated with the flux is:: + + Qo = (Fo1*fo1*A1 + Fo2*fo2*A2 + Fo3*fo3*A3 + Fo4*fo4*A4) * dt + +on the atmosphere grid, that quantity is the ocean fraction times the mapped +flux times the area times the timestep:: + + Qa = foa * Fao * Aa * dt + +Via some simple math, it can be shown that Qo = Qa if:: + + fao = w1*fo1 + w2*fo2 + w3*fo3 + w4*fo4 + Fao = (fo1*w1*Fo1 + fo2*w2*Fo2 + fo3*w3*Fo3 + fo4*w4*Fo4) / (fao) + +In practice, the fraction weighted normlized mapping field is computed +by mapping the ocean fraction and the fraction +weighted field from the ocean to the atmosphere grid separately and then +using the mapped fraction to normalize the field as a four step process:: + + Fo' = fo*Fo (a) + fao = w1*fo1 + w2*fo2 + w3*fo3 + w4*fo4 (b) + Fao' = w1*Fo1' + w2*Fo2' + w3*Fo3' + w4*Fo4' (c) + Fao = Fao'/fao (d) + +Steps (b) and (c) above are the sparse matrix multiply by the standard +conservative weights. +Step (a) fraction weighs the field and step (d) normalizes the mapped field. + +Another way to think of this is that the mapped flux (Fao') is normalized by the +same fraction (fao) that is used in the merge, so they actually cancel. +Both the normalization at the end of the mapping and the fraction weighting +in the merge can be skipped and the results should be identical. But then the mediator +will carry around Fao' instead of Fao and that field is far less intuitive +as it no longer represents the gridcell average value, but some subarea average +value. +In addition, that approach is only valid when carrying out full surface merges. If, +for instance, the SST is to be interpolated and not merged with anything, the field +must be normalized after mapping to be useful. + +The same mapping and merging process is valid for the sea ice:: + + fai = w1*fi1 + w2*fi2 + w3*fi3 + w4*fi4 + Fai = (fi1*w1*Fi1 + fi2*w2*Fi2 + fi3*w3*Fi3 + fi4*w4*Fi4) / (fai) + +Putting this together with the original merge equation:: + + Fa = fal*Fal + fao*Fao + fai*Fai + +where now:: + + fal = 1 - (fao+fai) + fao = w1*fo1 + w2*fo2 + w3*fo3 + w4*fo4 + fai = w1*fi1 + w2*fi2 + w3*fi3 + w4*fi4 + Fal = Fl1 = Fl2 = Fl3 = Fl4 as defined by the land model on the atmosphere grid + Fao = (fo1*w1*Fo1 + fo2*w2*Fo2 + fo3*w3*Fo3 + fo4*w4*Fo4) / (fao) + Fai = (fi1*w1*Fi1 + fi2*w2*Fi2 + fi3*w3*Fi3 + fi4*w4*Fi4) / (fai) + +will simplify to an equation that contains twelve distinct terms for each of the +four ocean gridboxes and the three different surfaces:: + + Fa = (w1*fl1*Fl1 + w2*fl2*Fl2 + w3*fl3*Fl3 + w4*fl4*Fl4) + + (w1*fo1*Fo1 + w2*fo2*Fo2 + w3*fo3*Fo3 + w4*fo4*Fo4) + + (w1*fi1*Fi1 + w2*fi2*Fi2 + w3*fi3*Fi3 + w4*fi4*Fi4) + +and this further simplifies to something that looks like a mapping +of the field merged on the ocean grid:: + + Fa = w1*(fl1*Fl1+fo1*Fo1+fi1*Fi1) + + w2*(fl2*Fl2+fo2*Fo2+fi2*Fi2) + + w3*(fl3*Fl3+fo3*Fo3+fi3*Fi3) + + w4*(fl4*Fl4+fo4*Fo4+fi4*Fi4) + +Like the exercise with Fao above, these equations can be shown to be +fully conservative. + +To summarize, multiple features such as area calculations, +weights, masking, normalization, fraction weighting, and merging approaches +have to be considered together to ensure conservation. The CMEPS mediator +uses unmasked and unnormalized weights and then generally +maps using the fraction weighted normalized approach. Merges are carried +out with fraction weights. +This is applied to both state and flux fields, with conservative, bilinear, +and other mapping approaches, and for both merged and unmerged fields. +This ensures that the fields are always useful gridcell average values +when being coupled or analyzed throughout the coupling implementation. + + +Area Corrections +####################################### + +Area corrections are generally necessary when coupling fluxes between different +component models if conservation is important. The area corrections adjust +the fluxes such that the quantity is conserved between different models. The +area corrections are necessary because different model usually compute gridcell +areas using different approaches. These approaches are inherently part of the +model discretization, they are NOT ad-hoc. + +If the previous section, areas and weights were introduced. Those areas +were assumed to consist of the area overlaps between gridcells and were computed +using a consistent approach such that the areas conserve. ESMF is able to compute +these area overlaps and the corresponding mapping weights such that fluxes can +be mapped and quantities are conserved. + +However, the ESMF areas don't necessarily agree with the model areas that are inherently +computed in the individual component models. As a result, the fluxes need to +be corrected by the ratio of the model areas and the ESMF areas. Consider a +simple configuration where two grids are identical, the areas computed by +ESMF are identical, and all the weights are 1.0. So:: + + A1 = A2 (from ESMF) + w1 = 1.0 (from ESMF) + F2 = w1*F1 (mapping) + F2*A2 = F1*A1 (conservation) + +Now lets assume that the two models have fundamentally different discretizations, +different area algorithms (i.e. great circle vs simpler lon/lat approximations), +or even different +assumptions about the size and shape of the earth. The grids can be identical in +terms of the longitude and latitude of the +gridcell corners and centers, but the areas can also +be different because of the underlying model implementation. When a flux is passed +to or from each component, the quantity associated with that flux is proportional to +the model area, so:: + + A1 = A2 (ESMF areas) + w1 = 1.0 + F2 = w1*F1 (mapping) + F2 = F1 + A1m != A2m (model areas) + F1*A1m != F2*A2m (loss of conservation) + +This can be corrected by multiplying the fluxes +by an area correction. For each model, outgoing fluxes should be multiplied +by the model area divided by the ESMF area. Incoming fluxes should be multiplied +by the ESMF area divided by the model area. So:: + + F1' = A1m/A1*F1 + F2' = w1*F1' + F2 = F2'*A2/A2m + + Q2 = F2*A2m + = (F2'*A2/A2m)*A2m + = F2'*A2 + = (w1*F1')*A2 + = w1*(A1m/A1*F1)*A2 + = A1m*F1 + = Q1 + +and now the mapped flux conserves in the component models. The area corrections +should only be applied to fluxes. These area corrections +can actually be applied a number of ways. + +* The model areas can be passed into ESMF as extra arguments and then the weights will be adjusted. In this case, weights will no longer sum to 1 and different weights will need to be generated for mapping fluxes and states. +* Models can pass quantities instead of fluxes, multiplying the flux in the component by the model area. But this has a significant impact on the overall coupling strategy. +* Models can pass the areas to the mediator and the mediator can multiple fluxes by the source model area before mapping and divide by the destination model area area after mapping. +* Models can pass the areas to the mediator and implement an area correction term on the incoming and outgoing fluxes that is the ratio of the model and ESMF areas. This is the approach shown above and is how CMEPS traditionally implements this feature. + +Model areas should be passed to the mediator at initialization so the area corrections +can be computed and applied. These area corrections do not vary in time. + + +Lags, Accumulation and Averaging +####################################### + +In a coupled model, the component model sequencing and coupling frequency tend to introduce +some lags as well as a requirement to accumulate and average. This occurs when +component models are running sequentially or concurrently. In general, the component +models advance in time separately and the "current time" in each model becomes out of +sync during the sequencing loop. This is not unlike how component models take a timestep. +It's generally more important that the coupling be conservative than synchronous. + +At any rate, a major concern is conservation and consistency. As a general rule, when +multiple timesteps are taken between coupling periods in a component model, the fluxes and +states should be averaged over those timesteps before being passed back out to the +coupler. In the same way, the fluxes and states passed into the coupler should be +averaged over shorter coupling periods for models that are coupled at longer coupling +periods. + +For conservation of mass and energy, the field that is accumluated should be consistent +with the field that would be passed if there were no averaging required. Take for +example a case where the ocean model is running at a longer coupling period. The ocean +model receives a fraction weighted merged atmosphere/ocean and ice/ocean flux written as:: + + Fo = fao*Fao + fio*Fio + +The averaged flux over multiple time periods, n, would then be:: + + Fo = 1/n * sum_n(fao*Fao + fio*Fio) + +where sum_n represents the sum over n time periods. This can also be written as:: + + Fo = 1/n * (sum_n(fao*Fao) + sum_n(fio*Fio)) + +So multiple terms can be summed and accumulated or the individual terms fao*Fao +and fio*Fio can be accumulated and later summed and averaged in either order. +Both approaches produce identical results. +Finally, **it's important to note that sum_n(fao)*sum_n(Fao) does not produce the same +results as the sum_n(fao*Fao)**. In other words, the fraction weighted flux has to be +accumulated and NOT the fraction and flux separately. This is important for conservation +in flux coupling. The same approach should be taken with merged states to compute the +most accurate representation of the average state over the slow coupling period. +An analysis and review of each coupling field should be carried out to determine +the most conservative and accurate representation of averaged fields. This is particularly +important for models like the sea ice model where fields may be undefined at gridcells +and timesteps where the ice fraction is zero. + +Next, consider how mapping interacts with averaging. A coupled field +can be accumulated on the grid where that field is used. As in the example above, +the field that would be passed to the ocean model can be accumulated on the ocean grid +over fast coupling periods as if the ocean model were called each fast coupling period. +If the flux is computed on another grid, it would save computational efforts if the +flux were accumulated and averaged on the flux computation grid over fast coupling +periods and only mapped to the destination grid on slow coupling periods. Consider +just the atmosphere/ocean term above:: + + 1/n * sum_n(fao_o*Fao_o) + +which is accumulated and averaged on the ocean grid before being passed to the ocean +model. The _o notation has been added to denote the field on on the ocean grid. +However, if Fao is computed on the atmosphere grid, then each fast coupling period +the following operations would need to be carried out + +* Fao_a is computed on the atmosphere grid +* fao_a, the ocean fraction on the atmosphere grid is known +* fao_o = map(fao_a), the fraction is mapped from atmosphere to ocean +* Fao_o = map(Fao_a), the flux is mapped from atmosphere to ocean +* fao_o*Fao_o is accumulated over fast coupling periods +* 1/n * sum_n(fao_o*Fao_o), the accumulation is averaged every slow coupling period + +Writing this in equation form:: + + Fo = 1/n * sum_n(mapa2o(fao_a) * mapa2o(fao_a*Fao_a)/mapa2o(fao_a)) + +where Fao_o is a fraction weighted normalized mapping as required for conservation +and fao_o is the mapped ocean fraction on the atmosphere grid. +Simplifying the above equation:: + + Fo = 1/n * sum_n(mapa2o(fao_a*Fao_a) + +Accumulation (sum_n) and mapping (mapa2o) are both linear operations so this can +be written as:: + + Fo = 1/n * mapa2o(sum_n(fao_a*Fao_a)) + Fo = mapa2o(1/n*sum_n(fao_a*Fao_a)) + +which suggests that the accumulation can be done on the source side (i.e. atmosphere) +and only mapped on the slow coupling period. But again, fao_a*Fao_a has to be +accumulated and then when mapped, NO fraction would be applied to the merge as this +is already included in the mapped field. In equation form, the full merged ocean +field would be implemented as:: + + Fao'_o = mapa2o(1/n*sum_n(fao_a*Fao_a)) + Fo = Fao'_o + fio_o*Fio_o + +where a single accumulated field is only mapped once each slow coupling period +and an asymmetry is introduced in the merge in terms of the use of the fraction +weight. In the standard approach:: + + fao_o = mapa2o(fao_a) + Fao_o = mapa2o(fao_a*Fao_a)/mapa2o(fao_a) + Fo = fao_o*Fao_o + fio_o*Fio_o + +two atmosphere fields are mapped every fast coupling period, the merge is now +fraction weighted for all terms, and the mapped fields, fao_o and Fao_o, have +physically meaningful values. Fao'_o above does not. This implementation +has a parallel with the normalization step. As suggested above, there are two +implementations for conservative mapping and merging in general. The one outlined +above with fraction weighted normalized mapping and fraction weighted +merging:: + + fao_o = mapa2o(fao_a) + Fao_o = mapa2o(fao_a*Fao_a)/mapa2o(fao_a) + Fo = fao_o*Fao_o + +or an option where the fraction weighted mapped field is NOT normalized and the +fraction is NOT applied during the merge:: + + Fao'_o = mapa2o(fao_a*Fao_a) + Fo = Fao'_o + +These will produce identical results in the same way that their accumulated averages +do. + + + +Flux Calculation Grid +####################################### + +The grid that fluxes are computed on is another critical issue to consider. Consider +the atmosphere/ocean flux again. Generally, the atmosphere/ice flux is computed +in the ice model due to subgrid scale processes that need to be resolved. In addition, +the ice model is normally run at a fast coupling period and advances +one sea ice timestep per coupling period. On the other hand, the ocean model is often coupled +at a slower coupling period and atmosphere/ocean fluxes are computed outside the +ocean model at the faster atmopshere coupling period. In some models, the atmosphere/ocean +fluxes are computed in the mediator, on the ocean grid, from ocean and mapped +atmosphere states, and those atmosphere/ocean fluxes are mapped conservatively to +the atmosphere grid. In other models, the atmosphere/ocean fluxes are computed +on the atmosphere grid in the atmosphere model, from atmosphere and mapped ocean states, +and then those atmosphere/ocean fluxes are mapped conservatively to the ocean +grid. Those implementations are different in many respects, but they share basic +equations:: + + fo_o = 1 - fi_o + fl_a = 1 - mapo2a(Mo) + fo_a = mapo2a(fo_o) + fi_a = mapo2a(fi_o) + Fa = fl_a*Fal_a + fo_a*Fao_a + fi_a*Fai_a + Fo = fo_o*Fao_o + fi_o*Fio_o + +The above equations indicate that the land fraction on the atmosphere grid is the +complement of the mapped ocean mask and is static. The ice and ocean fractions are +determined from the ice model and are dynamic. Both can be mapped to the atmosphere +grid. Finally, the atmosphere flux is a three-way merge of the land, ocean, and +ice terms on the atmosphere grid while the ocean flux is a two-way merge of the +atmosphere and ice terms on the ocean grid. + +When the atmosphere/ocean and atmosphere/ice fluxes are both computed on the same +grid, at the same frequency, and both are mapped to the atmosphere grid, conservative +mapping and merging is relatively straight-forward:: + + fo_a = mapo2a(fo_o) + Fao_a = mapo2a(fo_o*Fao_o)/fo_a + fi_a = mapo2a(fi_o) + Fai_a = mapo2a(fi_o*Fai_o)/fi_a + +and everything conserves relatively directly:: + + fo_o + fi_o = Mo + fl_a + fo_a + fi_a = 1.0 + fo_a*Fao_a = fo_o*Fao_o + fi_a*Fai_a = fi_o*Fai_o + +When the atmosphere/ice fluxes are computed on the ocean grid while +the atmosphere/ocean fluxes are computed on the atmosphere grid, +extra care is needed with regard to fractions and conservation. In this case:: + + fo_a = mapo2a(fo_o) + Fao_o = mapa2o(fo_a*Fao_a)/mapa2o(fo_a) + fi_a = mapo2a(fi_o) + Fai_a = mapo2a(fi_o*Fai_o)/fi_a + +fo_o, fi_o, Fai_o, and Fao_a are specified and Fao_o has to be computed. The most +important point here is that during the ocean merge, the mapped ocean fraction on the +atmosphere grid is used so:: + + Fo = mapa2o(fo_a)*(mapa2o(fo_a*Fao_a)/mapa2o(fo_a)) + fi_o*Fio_o + +This is conservative because from basic mapping/merging principles:: + + fo_a * Fao_a = mapa2o(fo_a)*(mapa2o(fo_a*Fao_a)/mapa2o(fo_a)) + +fo_a is the mapped ocean fraction while Fao_a is the computed flux on the atmosphere +grid. Note that **mapa2o(fo_a) != fo_o** which also means that fi_o + mapa2o(fo_a) != 1. +Since the ocean fraction is computed on the ocean grid while the atmosphere/ocean +flux is computed on the atmosphere grid, an extra mapping is introduced which results in +extra diffusion. As a result, the atmosphere/ocean +and ice/ocean fluxes are computed and applied differently to the different grids. And +while the fraction weights in the two-way merge don't sum to 1 at each gridcell, the +fluxes still conserve. Again, the normalized fraction weighted mapped atmosphere/ocean +flux from the atmosphere grid should NOT be merged with the original ocean fraction on the +ocean grid. They must be merged with the atmosphere ocean fraction mapped to the ocean +grid which is two mappings removed from the original ocean fraction on the ocean grid. + +An open question exists whether there is atmosphere/ocean flux (Fao"_o) that conserves and +allows the two-way ocean merge equation to use the original fo_o fraction weight +such that:: + + fo_o * Fao"_o = mapa2o(fo_a)*(mapa2o(fo_a*Fao_a)/mapa2o(fo_a) + +It has been suggested that if Fao"_o is mapo2a(Fao_a), the system conserves:: + + fo_o * mapa2o(Fao_a) =? mapa2o(fo_a)*mapa2o(fo_a*Fao_a)/mapa2o(fo_a) + +But this still needs to be verified. diff --git a/doc/source/prep.rst b/doc/source/prep.rst new file mode 100644 index 000000000..07595cb45 --- /dev/null +++ b/doc/source/prep.rst @@ -0,0 +1,85 @@ +.. _prep_modules: + +====================== + CMEPS `prep` modules +====================== + +The following modules comprise the "prep phase" CMEPS code: + +**med_phases_prep_atm_mod.F90**: prepares the mediator export state to the atmosphere component + +**med_phases_prep_ice_mod.F90**: prepares the mediator export state to the sea-ice component + +**med_phases_prep_glc_mod.F90**: prepares the mediator export state to the land-ice component + +**med_phases_prep_lnd_mod.F90**: prepares the mediator export state to the land component + +**med_phases_prep_ocn_mod.F90**: prepares the mediator export state to the ocean component + +**med_phases_prep_rof_mod.F90**: prepares the mediator export state to the river component + +**med_phases_prep_wav_mod.F90**: prepares the mediator export state to the wave component + + +Each prep phase module has several sections: + +1. Mapping each source field that needs to be mapped to the destination mesh. + This is obtained from the ``addmap`` calls in the application specific ``esmFldsExchange_xxxx_mod.F90``. + Each `prep` module will call the generic routine ``med_map_FB_Regrid_Norm`` to do this mapping. + +2. Merging the set of source fields that have been mapped to the destination mesh. + This is obtained from the ``addmrg`` calls in the application specific ``esmFldsExchange_xxxx_mod.F90``. + +3. Carrying out optional custom calculations that cannot be specified + via ``addmap`` or ``addmrg`` calls. Custom calculations are the + only part of the CMEPS prep phases that can be can be application + specific. The attribute ``coupling_mode`` is utilized to by the + prep phases to determine if a particular customization is targeted + for only one application. Currently prep phase customization + encompasses the following: + + * ``med_phases_prep_atm``: + + * Calculation of ocean albedos and atmosphere/ocean fluxes (for CESM). + * Calculation of land, ice and ocean fractions to send to the atmosphere if those components are present. + * ``med_phases_prep_ice``: + + * Update the scalar data for the time of the next short wave calculation carried out by the atmosphere, used by the + ice component to determine the zenith angle (for CESM) + * applicate of precipitation factor received from the ocean component (for CESM) + + * ``med_phases_prep_glc``: + + * the land-ice component prep phase `ONLY` uses custom code. Land + import fields that are destined for the land-ice component are + in elevation classes, whereas the land-ice components requires + import data that is not in elevation classes. In addition, the + land-ice component couples at a much longer time scale than the + land component. The custom code in this module carries out the + mapping and merged to take data from the land component, + accumulate it and map the data both in resolution and in the + compression of elevation class input to non-elevation class + output. (for CESM) + + * ``med_phases_prep_lnd``: + + * carry out land-ice to land mapping if land-ice is present (for CESM) + * update the scalar data for the time of the next short + wave calculation caried out by the atmosphere (this is needed to the + land component to determine the zenith angle) (for CESM) + + * ``med_phases_prep_ocn``: + + * computation of net shortwave that is sent to the ocean. + * apply precipitation fractor to scale rain and snow sent to ocean (for CESM) + * carry out custom merges for NEMS coupling modes (for NEMS) + + * ``med_phases_prep_rof``: + + * reset the irrigation flux to the river model by pulling in + irrigation out of the rof cells that are proportial to the + river volume in each cell (for CESM). + + * ``med_phases_prep_wav``: + + * currently there are no custom calculations. 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/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..c2bc91c5b 100644 --- a/mediator/esmFlds.F90 +++ b/mediator/esmFlds.F90 @@ -35,6 +35,8 @@ 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 :: accum_lnd2glc ! obtained in med.F90 (this can be true even if lnd2glc_coupling is false) logical, public :: dststatus_print = .false. @@ -188,7 +190,7 @@ subroutine med_fldList_AddFld(flds, stdname, shortname) ! local variables integer :: n,oldsize,id logical :: found - type(med_fldList_entry_type), pointer :: newflds(:) => null() + type(med_fldList_entry_type), pointer :: newflds(:) character(len=*), parameter :: subname='(med_fldList_AddFld)' ! ---------------------------------------------- @@ -386,10 +388,10 @@ subroutine med_fldList_Realize(state, fldList, flds_scalar_name, flds_scalar_num character(ESMF_MAXSTR) :: transferActionAttr type(ESMF_StateIntent_Flag) :: stateIntent character(ESMF_MAXSTR) :: transferAction - character(ESMF_MAXSTR), pointer :: StandardNameList(:) => null() - character(ESMF_MAXSTR), pointer :: ConnectedList(:) => null() - character(ESMF_MAXSTR), pointer :: NameSpaceList(:) => null() - character(ESMF_MAXSTR), pointer :: itemNameList(:) => null() + character(ESMF_MAXSTR), pointer :: StandardNameList(:) + character(ESMF_MAXSTR), pointer :: ConnectedList(:) + character(ESMF_MAXSTR), pointer :: NameSpaceList(:) + character(ESMF_MAXSTR), pointer :: itemNameList(:) character(len=*),parameter :: subname='(med_fldList_Realize)' ! ---------------------------------------------- diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 3b84c7223..e853d7073 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,148 @@ 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 + ! to lnd: tributary water depth + ! to lnd: tributary channel depth ! --------------------------------------------------------------------- - 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 + if (phase == 'advertise') then + call addfld(fldListFr(comprof)%flds, 'Sr_tdepth') + call addfld(fldListTo(complnd)%flds, 'Sr_tdepth') + else + if ( fldchk(is_local%wrap%FBExp(complnd) , 'Sr_tdepth', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(comprof, comprof), 'Sr_tdepth', rc=rc)) then + call addmap(fldListFr(comprof)%flds, 'Sr_tdepth', complnd, mapconsf, 'one', rof2lnd_map) + call addmrg(fldListTo(complnd)%flds, 'Sr_tdepth', mrg_from=comprof, mrg_fld='Sr_tdepth', mrg_type='copy') + end if + end if + if (phase == 'advertise') then + call addfld(fldListFr(comprof)%flds, 'Sr_tdepth_max') + call addfld(fldListTo(complnd)%flds, 'Sr_tdepth_max') + else + if ( fldchk(is_local%wrap%FBExp(complnd) , 'Sr_tdepth_max', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(comprof, comprof), 'Sr_tdepth_max', rc=rc)) then + call addmap(fldListFr(comprof)%flds, 'Sr_tdepth_max', complnd, mapconsf, 'one', rof2lnd_map) + call addmrg(fldListTo(complnd)%flds, 'Sr_tdepth_max', mrg_from=comprof, mrg_fld='Sr_tdepth_max', 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 +769,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,41 +883,232 @@ 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') - 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') + 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%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_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 do - deallocate(suffix) + 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) ! 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 @@ -619,43 +1118,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 - do n = 1,size(suffix) + 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 + + 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 +1320,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 +1345,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 +1543,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 +1612,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 +1624,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 +1640,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 +1694,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 +1743,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 +1840,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 +1892,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 +1912,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) - - ! --------------------------------------------------------------------- - ! to ocn: water flux due to melting ice from ice - ! --------------------------------------------------------------------- - do n = 1,size(iso) + 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 + ! --------------------------------------------------------------------- + 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 +2095,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 - call addfld(fldListFr(compglc(ns))%flds, 'Fogg_rofl'//iso(n)) + 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 - 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 + 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_rofi'//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_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 + end if + end if + + if (flds_wiso) then + if (phase == 'advertise') then + do ns = 1, num_icesheets + call addfld(fldListFr(compglc(ns))%flds, 'Fogg_rofl_wiso') + end do + 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 +2278,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 +2406,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 +2691,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 +2773,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 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 do - deallocate(flds) + 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 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 do - deallocate(flds) + end if !===================================================================== ! FIELDS TO RIVER (comprof) @@ -1723,35 +2877,78 @@ 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 (ice surface) + ! --------------------------------------------------------------------- + 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 + + ! --------------------------------------------------------------------- ! to rof: water flux from land (liquid glacier, wetland, and lake) - ! 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_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 - allocate(flds(6)) - flds = (/'Flrl_rofsur', 'Flrl_rofgwl', 'Flrl_rofsub', 'Flrl_rofdto', 'Flrl_rofi ', 'Flrl_irrig '/) + ! --------------------------------------------------------------------- + ! to rof: water flux from land (liquid subsurface) + ! --------------------------------------------------------------------- + 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 - 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 +3041,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 +3058,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 +3076,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 +3088,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 +3100,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 +3115,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 +3132,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 +3148,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 +3160,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 +3168,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/esmFldsExchange_hafs_mod.F90 b/mediator/esmFldsExchange_hafs_mod.F90 index e88da9261..5f8537221 100644 --- a/mediator/esmFldsExchange_hafs_mod.F90 +++ b/mediator/esmFldsExchange_hafs_mod.F90 @@ -230,7 +230,7 @@ subroutine esmFldsExchange_hafs_advt(gcomp, phase, rc) !===================================================================== ! --------------------------------------------------------------------- - ! to wav: 10-m wind components + ! to wav: 10-m wind components ! --------------------------------------------------------------------- if (hafs_attr%atm_present .and. hafs_attr%wav_present) then allocate(S_flds(2)) @@ -510,7 +510,7 @@ subroutine esmFldsExchange_hafs_attr(gcomp, hafs_attr, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return !---------------------------------------------------------- - ! Component active or not? + ! Component active or not? !---------------------------------------------------------- call NUOPC_CompAttributeGet(gcomp, name='ATM_model', & diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index 1a4889bc0..b4a407a06 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 @@ -948,6 +952,14 @@ canonical_units: m description: river export to land - river channel main channel water volume from 16O, 18O, HDO # + - standard_name: Sr_tdepth + canonical_units: m + description: river export to land - tributary channel water depth + # + - standard_name: Sr_tdepth_max + canonical_units: m + description: river export to land - tributary channel bankfull depth + # - standard_name: Forr_rofi canonical_units: kg m-2 s-1 description: river export to ocean - water flux due to runoff (frozen) diff --git a/mediator/med.F90 b/mediator/med.F90 index 00cada949..7f2b323af 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -1,8 +1,23 @@ module MED !----------------------------------------------------------------------------- - ! Mediator Component. + ! Mediator Initialization + ! + ! Note on time management: + ! Each time loop has its own associated clock object. NUOPC manages + ! these clock objects, i.e. their creation and destruction, as well as + ! startTime, endTime, timeStep adjustments during the execution. The + ! outer most time loop of the run sequence is a special case. It uses + ! the driver clock itself. If a single outer most loop is defined in + ! the run sequence provided by freeFormat, this loop becomes the driver + ! loop level directly. Therefore, setting the timeStep or runDuration + ! for the outer most time loop results in modifying the driver clock + ! itself. However, for cases with cocnatenated loops on the upper level + ! of the run sequence in freeFormat, a single outer loop is added + ! automatically during ingestion, and the driver clock is used for this + ! loop instead. !----------------------------------------------------------------------------- + use ESMF , only : ESMF_VMLogMemInfo use NUOPC_Model , only : SetVM use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 @@ -24,8 +39,8 @@ module MED use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose use med_methods_mod , only : FB_getFieldN => med_methods_FB_getFieldN use med_methods_mod , only : clock_timeprint => med_methods_clock_timeprint - use med_time_mod , only : alarmInit => med_time_alarmInit use med_utils_mod , only : memcheck => med_memcheck + use med_time_mod , only : med_time_alarmInit use med_internalstate_mod , only : InternalState use med_internalstate_mod , only : med_coupling_allowed, logunit, mastertask use med_phases_profile_mod , only : med_phases_profile_finalize @@ -33,8 +48,9 @@ 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 ! 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 use esmFlds , only : coupling_mode @@ -122,7 +138,7 @@ subroutine SetServices(gcomp, rc) integer, intent(out) :: rc ! local variables - character(len=*),parameter :: subname=' (module_MED:SetServices) ' + character(len=*),parameter :: subname=' (SetServices) ' !----------------------------------------------------------- rc = ESMF_SUCCESS @@ -190,7 +206,7 @@ subroutine SetServices(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ - ! setup mediator history phase + ! setup mediator history phases for all output variables !------------------ call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & @@ -199,9 +215,6 @@ subroutine SetServices(gcomp, rc) call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & specPhaseLabel="med_phases_history_write", specRoutine=med_phases_history_write, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_TimestampExport, & - specPhaselabel="med_phases_history_write", specRoutine=NUOPC_NoOp, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ ! setup mediator restart phase @@ -276,9 +289,6 @@ subroutine SetServices(gcomp, rc) call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & specPhaseLabel="med_phases_post_ocn", specRoutine=med_phases_post_ocn, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_TimestampExport, & - specPhaselabel="med_phases_post_ocn", specRoutine=NUOPC_NoOp, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ ! prep and post routines for ice @@ -298,12 +308,9 @@ subroutine SetServices(gcomp, rc) call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & specPhaseLabel="med_phases_post_ice", specRoutine=med_phases_post_ice, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_TimestampExport, & - specPhaselabel="med_phases_post_ice", specRoutine=NUOPC_NoOp, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ - ! prep routines for lnd + ! prep/post routines for lnd !------------------ call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & @@ -319,12 +326,9 @@ subroutine SetServices(gcomp, rc) call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & specPhaseLabel="med_phases_post_lnd", specRoutine=med_phases_post_lnd, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_TimestampExport, & - specPhaselabel="med_phases_post_lnd", specRoutine=NUOPC_NoOp, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ - ! prep and post routines for rof + ! prep/post routines for rof !------------------ call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & @@ -341,12 +345,9 @@ subroutine SetServices(gcomp, rc) call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & specPhaseLabel="med_phases_post_rof", specRoutine=med_phases_post_rof, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_TimestampExport, & - specPhaselabel="med_phases_post_rof", specRoutine=NUOPC_NoOp, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ - ! prep and post routines for wav + ! prep/post routines for wav !------------------ call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & @@ -362,12 +363,9 @@ subroutine SetServices(gcomp, rc) call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & specPhaseLabel="med_phases_post_wav", specRoutine=med_phases_post_wav, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_TimestampExport, & - specPhaselabel="med_phases_post_wav", specRoutine=NUOPC_NoOp, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ - ! prep and post routines for glc + ! prep/post routines for glc !------------------ call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & @@ -384,9 +382,6 @@ subroutine SetServices(gcomp, rc) call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & specPhaseLabel="med_phases_post_glc", specRoutine=med_phases_post_glc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_TimestampExport, & - specPhaselabel="med_phases_post_glc", specRoutine=NUOPC_NoOp, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ ! phase routine for ocean albedo computation @@ -398,9 +393,6 @@ subroutine SetServices(gcomp, rc) call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & specPhaseLabel="med_phases_ocnalb_run", specRoutine=med_phases_ocnalb_run, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_TimestampExport, & - specPhaselabel="med_phases_ocnalb_run", specRoutine=NUOPC_NoOp, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ ! phase routine for ocn/atm flux computation @@ -412,9 +404,6 @@ subroutine SetServices(gcomp, rc) call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & specPhaseLabel="med_phases_aofluxes_run", specRoutine=med_phases_aofluxes_run, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_TimestampExport, & - specPhaselabel="med_phases_aofluxes_run", specRoutine=NUOPC_NoOp, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ ! phase routine for updating fractions @@ -529,6 +518,7 @@ subroutine SetServices(gcomp, rc) ! attach specializing method(s) ! -> NUOPC specializes by default --->>> first need to remove the default !------------------ + ! This is called every time you enter a mediator phase call ESMF_MethodRemove(gcomp, mediator_label_SetRunClock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -575,7 +565,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) character(len=CX) :: logfile character(len=CX) :: diagfile character(len=CX) :: do_budgets - character(len=*),parameter :: subname=' (module_MED:InitializeP0) ' + character(len=*),parameter :: subname=' (InitializeP0) ' !----------------------------------------------------------- rc = ESMF_SUCCESS @@ -686,7 +676,7 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) type(InternalState) :: is_local integer :: stat character(len=CS) :: attrList(8) - character(len=*),parameter :: subname=' (module_MED:InitializeIPDv03p1) ' + character(len=*),parameter :: subname=' (InitializeIPDv03p1) ' !----------------------------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -763,6 +753,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 !------------------ @@ -954,7 +952,8 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) else transferOffer = 'cannot provide' end if - call NUOPC_Advertise(is_local%wrap%NStateImp(ncomp), standardName=stdname, shortname=shortname, name=shortname, & + call NUOPC_Advertise(is_local%wrap%NStateImp(ncomp), & + standardName=stdname, shortname=shortname, name=shortname, & TransferOfferGeomObject=transferOffer, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(subname//':Fr_'//trim(compname(ncomp))//': '//trim(shortname), ESMF_LOGMSG_INFO) @@ -972,7 +971,8 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) else transferOffer = 'cannot provide' end if - call NUOPC_Advertise(is_local%wrap%NStateExp(ncomp), standardName=stdname, shortname=shortname, name=shortname, & + call NUOPC_Advertise(is_local%wrap%NStateExp(ncomp), & + standardName=stdname, shortname=shortname, name=shortname, & TransferOfferGeomObject=transferOffer, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(subname//':To_'//trim(compname(ncomp))//': '//trim(shortname), ESMF_LOGMSG_INFO) @@ -1008,7 +1008,7 @@ subroutine InitializeIPDv03p3(gcomp, importState, exportState, clock, rc) type(InternalState) :: is_local type(ESMF_VM) :: vm integer :: n - character(len=*),parameter :: subname=' (module_MED:InitializeIPDv03p3) ' + character(len=*),parameter :: subname=' (InitializeIPDv03p3) ' !----------------------------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -1069,7 +1069,7 @@ subroutine InitializeIPDv03p4(gcomp, importState, exportState, clock, rc) ! local variables type(InternalState) :: is_local integer :: n1,n2 - character(len=*),parameter :: subname=' (module_MED:InitalizeIPDv03p4) ' + character(len=*),parameter :: subname=' (InitalizeIPDv03p4) ' !----------------------------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -1114,57 +1114,49 @@ subroutine realizeConnectedGrid(State,string,rc) use ESMF , only : ESMF_FieldStatus_Empty, ESMF_FieldStatus_Complete, ESMF_FieldStatus_GridSet use ESMF , only : ESMF_GeomType_Mesh, ESMF_MeshGet, ESMF_Mesh, ESMF_MeshEmptyCreate + ! input/output variables type(ESMF_State) , intent(inout) :: State character(len=*) , intent(in) :: string integer , intent(out) :: rc ! local variables type(ESMF_Field) :: field - type(ESMF_Grid) :: grid + type(ESMF_Grid) :: grid, newgrid type(ESMF_Mesh) :: mesh, newmesh - integer :: localDeCount - type(ESMF_DistGrid) :: distgrid - type(ESMF_DistGrid) :: nodaldistgrid, newnodaldistgrid type(ESMF_DistGrid) :: elemdistgrid, newelemdistgrid - type(ESMF_DistGridConnection), allocatable :: connectionList(:) integer :: arbDimCount - integer :: dimCount, tileCount, petCount + integer :: dimCount, tileCount integer :: connectionCount - integer :: deCountPTile, extraDEs - integer, allocatable :: minIndexPTile(:,:), maxIndexPTile(:,:) - integer, allocatable :: regDecompPTile(:,:) - integer :: i, j, n, n1, fieldCount, nxg, i1, i2 + integer :: fieldCount + integer :: i, j, n, n1, i1, i2 type(ESMF_GeomType_Flag) :: geomtype - character(ESMF_MAXSTR),allocatable :: fieldNameList(:) type(ESMF_FieldStatus_Flag) :: fieldStatus character(len=CX) :: msgString - character(len=*),parameter :: subname=' (module_MED:realizeConnectedGrid) ' + integer , allocatable :: minIndexPTile(:,:), maxIndexPTile(:,:) + character(ESMF_MAXSTR) , allocatable :: fieldNameList(:) + type(ESMF_DistGridConnection) , allocatable :: connectionList(:) + character(len=*),parameter :: subname=' (realizeConnectedGrid) ' !----------------------------------------------------------- - !NOTE: All of the Fields that set their TransferOfferGeomObject Attribute - !NOTE: to "cannot provide" should now have the accepted Grid available. - !NOTE: Go and pull out this Grid for one of a representative Field and - !NOTE: modify the decomposition and distribution of the Grid to match the - !NOTE: Mediator PETs. - - !TODO: quick implementation, do it for each field one by one - !TODO: commented out below are application to other fields + ! All of the Fields that set their TransferOfferGeomObject Attribute + ! to "cannot provide" should now have the accepted Grid available. + ! Go and pull out this Grid for one of a representative Field and + ! modify the decomposition and distribution of the Grid to match the Mediator PETs. + ! On exit from this phase, the connector will transfer the full Grid/Mesh/LocStream + ! objects (with coordinates) for Field pairs that have a provider and an acceptor side. call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) rc = ESMF_Success - if (profile_memory) call ESMF_VMLogMemInfo("Entering "//trim(subname)) - + if (profile_memory) then + call ESMF_VMLogMemInfo("Entering "//trim(subname)) + end if call ESMF_StateGet(State, itemCount=fieldCount, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - allocate(fieldNameList(fieldCount)) call ESMF_StateGet(State, itemNameList=fieldNameList, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_GridCompGet(gcomp, petCount=petCount, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! do not loop here, assuming that all fields share the ! same grid/mesh and because it is more efficient - if ! a component has fields on multiple grids/meshes, this @@ -1173,34 +1165,22 @@ subroutine realizeConnectedGrid(State,string,rc) call ESMF_StateGet(State, field=field, itemName=fieldNameList(n), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, status=fieldStatus, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - !call NUOPC_GetAttribute(field, name="TransferActionGeomObject", & - ! value=transferAction, rc=rc) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (fieldStatus==ESMF_FIELDSTATUS_GRIDSET) then ! The Mediator is accepting a Grid/Mesh passed to it ! through the Connector - ! While this is still an empty field, it does now hold a Grid/Mesh with DistGrid call ESMF_FieldGet(field, geomtype=geomtype, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (geomtype == ESMF_GEOMTYPE_GRID) then - !if (dbug_flag > 1) then - ! call Field_GeomPrint(field,trim(fieldNameList(n))//'_orig',rc) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - !end if - call ESMF_AttributeGet(field, name="ArbDimCount", value=arbDimCount, & convention="NUOPC", purpose="Instance", rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(trim(subname)//": geomtype is ESMF_GEOMTYPE_GRID for "//trim(fieldnameList(n)), & ESMF_LOGMSG_INFO) write(msgString,'(A,i8)') trim(subname)//':arbdimcount =',arbdimcount @@ -1208,171 +1188,85 @@ subroutine realizeConnectedGrid(State,string,rc) ! make decision on whether the incoming Grid is arbDistr or not if (arbDimCount>0) then - ! The provider defined an arbDistr grid - ! - ! Need to make a choice here to either represent the grid as a - ! regDecomp grid on the acceptor side, or to stay with arbDistr grid: - ! - ! Setting the PRECIP_REGDECOMP macro will set up a regDecomp grid on the - ! acceptor side. - ! - ! Not setting the PRECIP_REGDECOMP macro will default into keeping the - ! original arbDistr Grid. - - if (grid_arbopt == "grid_reg") then - - call ESMF_LogWrite(trim(subname)//trim(string)//": accept arb2reg grid for "//trim(fieldNameList(n)), & - ESMF_LOGMSG_INFO) - - ! Use a regDecomp representation for the grid - ! first get tile min/max, only single tile supported for arbDistr Grid - allocate(minIndexPTile(arbDimCount,1),maxIndexPTile(arbDimCount,1)) - call ESMF_AttributeGet(field, name="MinIndex", & - valueList=minIndexPTile(:,1), & - convention="NUOPC", purpose="Instance", rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_AttributeGet(field, name="MaxIndex", & - valueList=maxIndexPTile(:,1), & - convention="NUOPC", purpose="Instance", rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! create default regDecomp DistGrid - distgrid = ESMF_DistGridCreate(minIndexPTile=minIndexPTile, & - maxIndexPTile=maxIndexPTile, connectionList=connectionList, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! Create default regDecomp Grid - grid = ESMF_GridCreate(distgrid, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! swap out the transferred grid for the newly created one - call ESMF_FieldEmptySet(field, grid=grid, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - do i1 = 1,arbDimCount - write(msgString,'(A,3i8)') trim(subname)//':PTile =',i1,minIndexPTile(i1,1),maxIndexPTile(i1,1) - call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO) - enddo - deallocate(minIndexPTile,maxIndexPTile) - - elseif (grid_arbopt == "grid_arb") then - - ! Stick with the arbDistr representation of the grid: - ! There is nothing to do here if the same number of DEs is kept on the - ! acceptor side. Alternatively, the acceptor side could set up a more - ! natural number of DEs (maybe same number as acceptor PETs), and then - ! redistribute the arbSeqIndexList. Here simply keep the DEs of the - ! provider Grid. - call ESMF_LogWrite(trim(subname)//trim(string)//": accept arb2arb grid for "//trim(fieldNameList(n)), & - ESMF_LOGMSG_INFO) - - else ! grid_arbopt - - call ESMF_LogWrite(trim(subname)//trim(string)//": ERROR grid_arbopt setting = "//trim(grid_arbopt), & - ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - endif ! grid_arbopt + ! The provider defined an arbDistr grid + ! - use a regDecomp representation for the grid + ! - first get tile min/max, only single tile supported for arbDistr Grid + ! - create default regDecomp DistGrid + ! - create default regDecomp Grid with just a distgrid + call ESMF_LogWrite(trim(subname)//trim(string)//": accept arb2reg grid for "//trim(fieldNameList(n)), & + ESMF_LOGMSG_INFO) + allocate(minIndexPTile(arbDimCount,1),maxIndexPTile(arbDimCount,1)) + call ESMF_AttributeGet(field, name="MinIndex", & + valueList=minIndexPTile(:,1), & + convention="NUOPC", purpose="Instance", rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_AttributeGet(field, name="MaxIndex", & + valueList=maxIndexPTile(:,1), convention="NUOPC", purpose="Instance", rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + distgrid = ESMF_DistGridCreate(minIndexPTile=minIndexPTile, maxIndexPTile=maxIndexPTile, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + newgrid = ESMF_GridCreate(distgrid, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + do i1 = 1,arbDimCount + write(msgString,'(A,3i8)') trim(subname)//':PTile =',i1,minIndexPTile(i1,1),maxIndexPTile(i1,1) + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO) + enddo else ! arbdimcount <= 0 - ! The provider defined as non arb grid + ! The provider sends a non arb grid + ! Create a custom DistGrid, based on the minIndex, maxIndex of the accepted DistGrid, + ! but with a default regDecomp for the current VM that leads to 1DE/PET. + ! - get dimCount and tileCount + ! - allocate minIndexPTile and maxIndexPTile according to dimCount and tileCount + ! - get minIndex and maxIndex arrays and connectionList + ! - create the new DistGrid with the same minIndexPTile and maxIndexPTile + ! - create a new Grid on the new DistGrid - ! access localDeCount to show this is a real Grid call ESMF_LogWrite(trim(subname)//trim(string)//": accept reg2reg grid for "//& trim(fieldNameList(n)), ESMF_LOGMSG_INFO) - call ESMF_FieldGet(field, grid=grid, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_GridGet(grid, localDeCount=localDeCount, distgrid=distgrid, rc=rc) + call ESMF_GridGet(grid, distgrid=distgrid, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! Create a custom DistGrid, based on the minIndex, maxIndex of the - ! accepted DistGrid, but with a default regDecomp for the current VM - ! that leads to 1DE/PET. - - ! get dimCount and tileCount - call ESMF_DistGridGet(distgrid, dimCount=dimCount, tileCount=tileCount, & - connectionCount=connectionCount, rc=rc) + call ESMF_DistGridGet(distgrid, dimCount=dimCount, tileCount=tileCount, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! allocate minIndexPTile and maxIndexPTile accord. to dimCount and tileCount - allocate(minIndexPTile(dimCount, tileCount), maxIndexPTile(dimCount, tileCount)) - allocate(connectionList(connectionCount)) - - ! get minIndex and maxIndex arrays, and connectionList + allocate(minIndexPTile(dimCount, tileCount)) + allocate(maxIndexPTile(dimCount, tileCount)) call ESMF_DistGridGet(distgrid, minIndexPTile=minIndexPTile, & - maxIndexPTile=maxIndexPTile, connectionList=connectionList, rc=rc) + maxIndexPTile=maxIndexPTile, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! construct a default regDecompPTile -> TODO: move this into ESMF as default - - allocate(regDecompPTile(dimCount, tileCount)) - deCountPTile = petCount/tileCount - extraDEs = max(0, petCount-deCountPTile) - do i=1, tileCount - if (i<=extraDEs) then - regDecompPTile(1, i) = deCountPTile + 1 - else - regDecompPTile(1, i) = deCountPTile - endif - do j=2, dimCount - regDecompPTile(j, i) = 1 - enddo - enddo - do i2 = 1,tileCount do i1 = 1,dimCount - write(msgString,'(A,5i8)') trim(subname)//':PTile =',i2,i1,minIndexPTile(i1,i2),& - maxIndexPTile(i1,i2),regDecompPTile(i1,i2) + write(msgString,'(A,4i8)') trim(subname)//':PTile =',i2,i1,minIndexPTile(i1,i2),& + maxIndexPTile(i1,i2) call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) enddo enddo - - !--- tcraig, hardwire i direction wraparound, temporary - !--- tcraig, now getting info from model distgrid, see above - ! allocate(connectionList(1)) - ! nxg = maxIndexPTile(1,1) - minIndexPTile(1,1) + 1 - ! write(msgstring,*) trim(subname)//trim(string),': connlist nxg = ',nxg - ! call ESMF_LogWrite(trim(msgstring), ESMF_LOGMSG_INFO) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! call ESMF_DistGridConnectionSet(connectionList(1), tileIndexA=1, & - ! tileIndexB=1, positionVector=(/nxg, 0/), rc=rc) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! create the new DistGrid with the same minIndexPTile and maxIndexPTile, - ! but with a default regDecompPTile - ! tcraig, force connectionlist and gridEdge arguments to fix wraparound - ! need ESMF fixes to implement properly. if (dimcount == 2) then + call ESMF_DistGridGet(distgrid, connectionCount=connectionCount, rc=rc) + allocate(connectionList(connectionCount)) + call ESMF_DistGridGet(distgrid, connectionList=connectionList, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return distgrid = ESMF_DistGridCreate(minIndexPTile=minIndexPTile, & - maxIndexPTile=maxIndexPTile, regDecompPTile=regDecompPTile, & - connectionList=connectionList, rc=rc) + maxIndexPTile=maxIndexPTile, connectionList=connectionList, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(trim(subname)//trim(string)//': distgrid with dimcount=2', ESMF_LOGMSG_INFO) - - ! Create a new Grid on the new DistGrid and swap it in the Field - grid = ESMF_GridCreate(distgrid, gridEdgeLWidth=(/0,0/), gridEdgeUWidth=(/0,1/), rc=rc) + newgrid = ESMF_GridCreate(distgrid, gridEdgeLWidth=(/0,0/), gridEdgeUWidth=(/0,1/), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + deallocate(connectionList) else distgrid = ESMF_DistGridCreate(minIndexPTile=minIndexPTile, & - maxIndexPTile=maxIndexPTile, regDecompPTile=regDecompPTile, rc=rc) + maxIndexPTile=maxIndexPTile, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(trim(subname)//trim(string)//': distgrid with dimcount=1', ESMF_LOGMSG_INFO) - - ! Create a new Grid on the new DistGrid and swap it in the Field - grid = ESMF_GridCreate(distgrid, gridEdgeLWidth=(/0/), gridEdgeUWidth=(/0/), rc=rc) + newgrid = ESMF_GridCreate(distgrid, gridEdgeLWidth=(/0/), gridEdgeUWidth=(/0/), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif ! local clean-up - deallocate(connectionList) - deallocate(minIndexPTile, maxIndexPTile, regDecompPTile) + deallocate(minIndexPTile, maxIndexPTile) endif ! arbdimCount @@ -1381,17 +1275,13 @@ subroutine realizeConnectedGrid(State,string,rc) ! access a field in the State and set the Grid call ESMF_StateGet(State, field=field, itemName=fieldNameList(n1), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, status=fieldStatus, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (fieldStatus==ESMF_FIELDSTATUS_EMPTY .or. fieldStatus==ESMF_FIELDSTATUS_GRIDSET) then - call ESMF_FieldEmptySet(field, grid=grid, rc=rc) + call ESMF_FieldEmptySet(field, grid=newgrid, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(trim(subname)//trim(string)//": attach grid for "//trim(fieldNameList(n1)), & ESMF_LOGMSG_INFO) - if (dbug_flag > 1) then call Field_GeomPrint(field,trim(fieldNameList(n1))//'_new',rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1402,7 +1292,6 @@ subroutine realizeConnectedGrid(State,string,rc) endif enddo - elseif (geomtype == ESMF_GEOMTYPE_MESH) then call ESMF_LogWrite(trim(subname)//": geomtype is ESMF_GEOMTYPE_MESH for "//trim(fieldnameList(n)), & @@ -1412,26 +1301,12 @@ subroutine realizeConnectedGrid(State,string,rc) call Field_GeomPrint(field,trim(fieldNameList(n))//'_orig',rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - call ESMF_FieldGet(field, mesh=mesh, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_MeshGet(mesh, elementDistGrid=elemDistGrid, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - newelemDistGrid = ESMF_DistGridCreate(elemDistGrid, balanceflag=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! call ESMF_MeshGet(mesh, nodalDistGrid=nodalDistGrid, rc=rc) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! newnodalDistGrid = ESMF_DistGridCreate(nodalDistGrid, balanceflag=.true., rc=rc) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! Create a new Grid on the new DistGrid and swap it in the Field - ! newmesh = ESMF_MeshEmptyCreate(elementDistGrid=newelemDistGrid, nodalDistGrid=newnodalDistGrid, rc=rc) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - newmesh = ESMF_MeshEmptyCreate(elementDistGrid=newelemDistGrid, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1443,14 +1318,11 @@ subroutine realizeConnectedGrid(State,string,rc) call ESMF_FieldGet(field, status=fieldStatus, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (fieldStatus==ESMF_FIELDSTATUS_EMPTY .or. fieldStatus==ESMF_FIELDSTATUS_GRIDSET) then call ESMF_FieldEmptySet(field, mesh=newmesh, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(trim(subname)//trim(string)//": attach mesh for "//& trim(fieldNameList(n1)), ESMF_LOGMSG_INFO) - if (dbug_flag > 1) then call Field_GeomPrint(field,trim(fieldNameList(n1))//'_new',rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1507,6 +1379,14 @@ subroutine InitializeIPDv03p5(gcomp, importState, exportState, clock, rc) !---------------------------------------------------------- ! realize all Fields with transfer action "accept" + ! Finish initializing the State Fields + ! - Fields are partially created when this routine is called. + ! - Fields contain a geombase object internally created and the geombase object + ! associates with either a ESMF_Grid, or a ESMF_Mesh, or an or an ESMF_XGrid, + ! or a ESMF_LocStream. + ! - Fields containing grids will be transferred! to a Mesh and Realized; + ! - Fields containg meshes are completed with space allocated internally + ! for an ESMF_Array based on arrayspec !---------------------------------------------------------- type(ESMF_GridComp) :: gcomp @@ -1530,30 +1410,25 @@ subroutine InitializeIPDv03p5(gcomp, importState, exportState, clock, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - !--- Finish initializing the State Fields - !--- Write out grid information - do n1 = 1,ncomps - + ! Finish initializing import states and reset state data to spval_init if (ESMF_StateIsCreated(is_local%wrap%NStateImp(n1),rc=rc)) then call ESMF_LogWrite(trim(subname)//": calling completeFieldInitialize import states from "//trim(compname(n1)), & ESMF_LOGMSG_INFO) call completeFieldInitialization(is_local%wrap%NStateImp(n1), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call State_reset(is_local%wrap%NStateImp(n1), value=spval_init, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif + ! Finish initializing mediator export states and reset state data to spval_init if (ESMF_StateIsCreated(is_local%wrap%NStateExp(n1),rc=rc)) then call ESMF_LogWrite(trim(subname)//": calling completeFieldInitialize export states to "//trim(compname(n1)), & ESMF_LOGMSG_INFO) call completeFieldInitialization(is_local%wrap%NStateExp(n1), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call State_reset(is_local%wrap%NStateExp(n1), value=spval_init, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (dbug_flag > 1) then call State_GeomPrint(is_local%wrap%NStateExp(n1),'gridExp'//trim(compname(n1)),rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1570,10 +1445,10 @@ subroutine completeFieldInitialization(State,rc) use ESMF , only : operator(==) use ESMF , only : ESMF_State, ESMF_MAXSTR, ESMF_Grid, ESMF_Mesh, ESMF_Field, ESMF_FieldStatus_Flag - use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_FieldGet, ESMF_FieldEmptyComplete + use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_FieldGet use ESMF , only : ESMF_GeomType_Flag, ESMF_FieldCreate, ESMF_MeshCreate, ESMF_GEOMTYPE_GRID use ESMF , only : ESMF_MeshLoc_Element, ESMF_TYPEKIND_R8, ESMF_FIELDSTATUS_GRIDSET - use ESMF , only : ESMF_AttributeGet, ESMF_MeshWrite + use ESMF , only : ESMF_AttributeGet, ESMF_MeshWrite, ESMF_FAILURE use NUOPC , only : NUOPC_getStateMemberLists, NUOPC_Realize ! input/output variables @@ -1586,7 +1461,7 @@ subroutine completeFieldInitialization(State,rc) type(ESMF_Grid) :: grid type(ESMF_Mesh) :: mesh type(ESMF_Field) :: meshField - type(ESMF_Field),pointer :: fieldList(:) => null() + type(ESMF_Field),pointer :: fieldList(:) type(ESMF_FieldStatus_Flag) :: fieldStatus type(ESMF_GeomType_Flag) :: geomtype integer :: gridToFieldMapCount, ungriddedCount @@ -1605,89 +1480,99 @@ subroutine completeFieldInitialization(State,rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (fieldCount > 0) then - nullify(fieldList) - call NUOPC_getStateMemberLists(State, fieldList=fieldList, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + nullify(fieldList) + call NUOPC_getStateMemberLists(State, fieldList=fieldList, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - meshcreated = .false. - do n=1, fieldCount + meshcreated = .false. + do n=1, fieldCount - call ESMF_FieldGet(fieldList(n), status=fieldStatus, name=fieldName, & - geomtype=geomtype, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - if (geomtype == ESMF_GEOMTYPE_GRID .and. fieldName /= is_local%wrap%flds_scalar_name) then - ! Grab grid - if (dbug_flag > 1) then - call Field_GeomPrint(fieldList(n),trim(fieldName)//'_premesh',rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - call ESMF_FieldGet(fieldList(n), grid=grid, rc=rc) + call ESMF_FieldGet(fieldList(n), status=fieldStatus, name=fieldName, geomtype=geomtype, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Convert grid to mesh - if (.not. meshcreated) then - if (dbug_flag > 20) then - call med_grid_write(grid, trim(fieldName)//'_premesh.nc', rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if + ! Input fields contains grid - need to convert to mesh + if (geomtype == ESMF_GEOMTYPE_GRID .and. fieldName /= is_local%wrap%flds_scalar_name) then - mesh = ESMF_MeshCreate(grid, rc=rc) + ! Grab grid + if (dbug_flag > 1) then + call Field_GeomPrint(fieldList(n),trim(fieldName)//'_premesh',rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + call ESMF_FieldGet(fieldList(n), grid=grid, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - meshcreated = .true. - if (dbug_flag > 20) then - call ESMF_MeshWrite(mesh, filename=trim(fieldName)//'_postmesh', rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Convert grid to mesh + if (.not. meshcreated) then + if (dbug_flag > 20) then + call med_grid_write(grid, trim(fieldName)//'_premesh.nc', rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + mesh = ESMF_MeshCreate(grid, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + meshcreated = .true. + if (dbug_flag > 20) then + call ESMF_MeshWrite(mesh, filename=trim(fieldName)//'_postmesh', rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if end if - end if - meshField = ESMF_FieldCreate(mesh, typekind=ESMF_TYPEKIND_R8, & - meshloc=ESMF_MESHLOC_ELEMENT, name=fieldName, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! Swap grid for mesh, at this point, only connected fields are in the state - call NUOPC_Realize(State, field=meshField, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - endif - - if (fieldStatus==ESMF_FIELDSTATUS_GRIDSET) then - call ESMF_LogWrite(subname//" is allocating field memory for field "//trim(fieldName), & - ESMF_LOGMSG_INFO) + ! Create field on mesh + meshField = ESMF_FieldCreate(mesh, typekind=ESMF_TYPEKIND_R8, & + meshloc=ESMF_MESHLOC_ELEMENT, name=fieldName, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_AttributeGet(fieldList(n), name="GridToFieldMap", convention="NUOPC", & - purpose="Instance", itemCount=gridToFieldMapCount, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - allocate(gridToFieldMap(gridToFieldMapCount)) - call ESMF_AttributeGet(fieldList(n), name="GridToFieldMap", convention="NUOPC", & - purpose="Instance", valueList=gridToFieldMap, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Swap grid for mesh, at this point, only connected fields are in the state + call NUOPC_Realize(State, field=meshField, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - ungriddedCount=0 ! initialize in case it was not set - call ESMF_AttributeGet(fieldList(n), name="UngriddedLBound", convention="NUOPC", & - purpose="Instance", itemCount=ungriddedCount, isPresent=isPresent, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - allocate(ungriddedLBound(ungriddedCount), ungriddedUBound(ungriddedCount)) + call ESMF_FieldGet(meshField, status=fieldStatus, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (fieldStatus == ESMF_FIELDSTATUS_GRIDSET ) then + call ESMF_LogWrite(trim(subname)//": ERROR fieldStatus not complete ", ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + call Field_GeomPrint(meshField, trim(subname)//':'//trim(fieldName), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - 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) - endif + else - call ESMF_FieldEmptyComplete(fieldList(n), typekind=ESMF_TYPEKIND_R8, gridToFieldMap=gridToFieldMap, & - ungriddedLbound=ungriddedLbound, ungriddedUbound=ungriddedUbound, rc=rc) + ! Input fields contain mesh + if (fieldStatus==ESMF_FIELDSTATUS_GRIDSET) then + call ESMF_AttributeGet(fieldList(n), name="GridToFieldMap", convention="NUOPC", & + purpose="Instance", itemCount=gridToFieldMapCount, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(gridToFieldMap(gridToFieldMapCount)) + call ESMF_AttributeGet(fieldList(n), name="GridToFieldMap", convention="NUOPC", & + purpose="Instance", valueList=gridToFieldMap, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ungriddedCount=0 ! initialize in case it was not set + call ESMF_AttributeGet(fieldList(n), name="UngriddedLBound", convention="NUOPC", & + purpose="Instance", itemCount=ungriddedCount, isPresent=isPresent, rc=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) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_AttributeGet(fieldList(n), name="UngriddedUBound", convention="NUOPC", & + purpose="Instance", valueList=ungriddedUBound, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + call NUOPC_Realize(State, fieldName, typekind=ESMF_TYPEKIND_R8, gridToFieldMap=gridToFieldMap, & + ungriddedLbound=ungriddedLbound, ungriddedUbound=ungriddedUbound, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + deallocate(gridToFieldMap, ungriddedLbound, ungriddedUbound) + end if ! fieldStatus + call Field_GeomPrint(fieldlist(n), trim(subname)//':'//trim(fieldName), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - deallocate(gridToFieldMap, ungriddedLbound, ungriddedUbound) - endif ! fieldStatus + end if - call Field_GeomPrint(fieldList(n), trim(subname)//':'//trim(fieldName), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + enddo ! end of loop over fields + deallocate(fieldList) - enddo - deallocate(fieldList) - endif + endif ! end of fieldcount< 0 if (profile_memory) call ESMF_VMLogMemInfo("Leaving "//trim(subname)) call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) @@ -1707,12 +1592,10 @@ subroutine DataInitialize(gcomp, rc) ! Do not assume any import fields are connected, just allocate space and such ! -- Check present flags ! -- Check for active coupling interactions - ! -- Create FBs: FBImp, FBExp, FBExpAccum + ! -- Create FBs: FBImp, FBExp ! -- 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 @@ -1735,20 +1618,24 @@ 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_ocn_mod , only : med_phases_prep_ocn_init + use med_phases_prep_rof_mod , only : med_phases_prep_rof_init + 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 - use med_phases_post_lnd_mod , only : med_phases_post_lnd_init + use med_phases_post_lnd_mod , only : med_phases_post_lnd use med_phases_post_glc_mod , only : med_phases_post_glc use med_phases_post_ocn_mod , only : med_phases_post_ocn use med_phases_post_rof_mod , only : med_phases_post_rof use med_phases_post_wav_mod , only : med_phases_post_wav use med_phases_ocnalb_mod , only : med_phases_ocnalb_run - use med_phases_aofluxes_mod , only : med_phases_aofluxes_run + 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_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 @@ -1763,23 +1650,23 @@ 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 integer :: fieldCount character(ESMF_MAXSTR),allocatable :: fieldNameList(:) - character(CL), pointer :: fldnames(:) => null() + character(CL), pointer :: fldnames(:) character(CL) :: cvalue 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. real(r8) :: real_nx, real_ny character(len=CX) :: msgString - character(len=*), parameter :: subname=' (module_MED:DataInitialize) ' + character(len=*), parameter :: subname=' (DataInitialize) ' !----------------------------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -1932,7 +1819,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. @@ -1972,7 +1859,7 @@ subroutine DataInitialize(gcomp, rc) endif !---------------------------------------------------------- - ! Create field bundles FBImp, FBExp, FBImpAccum, FBExpAccum + ! Create field bundles FBImp, FBExp !---------------------------------------------------------- if (mastertask) then @@ -1998,27 +1885,11 @@ subroutine DataInitialize(gcomp, rc) is_local%wrap%flds_scalar_name, name='FBExp'//trim(compname(n1)), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Create import accumulation field bundles - call FB_init(is_local%wrap%FBImpAccum(n1,n1), is_local%wrap%flds_scalar_name, & - STgeom=is_local%wrap%NStateImp(n1), STflds=is_local%wrap%NStateImp(n1), & - name='FBImpAccum'//trim(compname(n1)), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_reset(is_local%wrap%FBImpAccum(n1,n1), value=czero, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! Create export accumulation field bundles - call FB_init(is_local%wrap%FBExpAccum(n1), is_local%wrap%flds_scalar_name, & - STgeom=is_local%wrap%NStateExp(n1), STflds=is_local%wrap%NStateExp(n1), & - name='FBExpAccum'//trim(compname(n1)), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_reset(is_local%wrap%FBExpAccum(n1), value=czero, rc=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' @@ -2035,9 +1906,7 @@ subroutine DataInitialize(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - ! The following are FBImp and FBImpAccum mapped to different grids. - ! FBImp(n1,n1) and FBImpAccum(n1,n1) are handled above - + ! The following is FBImp mapped to different grids. FBImp(n1,n1) is handled above do n2 = 1,ncomps if (n1 /= n2 .and. & is_local%wrap%med_coupling_active(n1,n2) .and. & @@ -2053,7 +1922,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), & @@ -2065,23 +1934,12 @@ subroutine DataInitialize(gcomp, rc) name='FBImp'//trim(compname(n1))//'_'//trim(compname(n2)), rc=rc) end if if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call FB_init(is_local%wrap%FBImpAccum(n1,n2), is_local%wrap%flds_scalar_name, & - STgeom=is_local%wrap%NStateImp(n2), & - STflds=is_local%wrap%NStateImp(n1), & - name='FBImpAccum'//trim(compname(n1))//'_'//trim(compname(n2)), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call FB_reset(is_local%wrap%FBImpAccum(n1,n2), value=czero, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - endif enddo ! loop over n2 - 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 @@ -2089,29 +1947,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 @@ -2119,49 +1970,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 !--------------------------------------- @@ -2180,19 +2017,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 @@ -2206,16 +2039,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, & @@ -2227,6 +2050,52 @@ subroutine DataInitialize(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if + !--------------------------------------- + ! Initialize ocn export accumulation field bundle + !--------------------------------------- + if ( is_local%wrap%comp_present(compocn) .and. & + ESMF_StateIsCreated(is_local%wrap%NStateImp(compocn),rc=rc) .and. & + ESMF_StateIsCreated(is_local%wrap%NStateExp(compocn),rc=rc)) then + call med_phases_prep_ocn_init(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) 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 + + !--------------------------------------- + ! Initialize rof module field bundles here if appropriate + !--------------------------------------- + if (is_local%wrap%med_coupling_active(comprof,complnd)) then + call med_phases_prep_rof_init(gcomp, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + !--------------------------------------- ! Set the data initialize flag to false !--------------------------------------- @@ -2351,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 @@ -2427,8 +2296,8 @@ subroutine DataInitialize(gcomp, rc) end if do n1 = 1,ncomps if (mastertask) then - write(logunit,*) - write(logunit,'(a)') trim(subname)//" "//trim(compname(n1)) + write(logunit,*) + write(logunit,'(a)') trim(subname)//" "//trim(compname(n1)) end if if (is_local%wrap%comp_present(n1) .and. ESMF_StateIsCreated(is_local%wrap%NStateImp(n1),rc=rc)) then call State_GetScalar(scalar_value=real_nx, & @@ -2447,7 +2316,7 @@ subroutine DataInitialize(gcomp, rc) is_local%wrap%ny(n1) = nint(real_ny) write(msgString,'(2i8,2l4)') is_local%wrap%nx(n1), is_local%wrap%ny(n1) if (mastertask) then - write(logunit,*) 'global nx,ny sizes for '//trim(compname(n1))//":"//trim(msgString) + write(logunit,'(a)') 'global nx,ny sizes for '//trim(compname(n1))//":"//trim(msgString) end if call ESMF_LogWrite(trim(subname)//":"//trim(compname(n1))//":"//trim(msgString), ESMF_LOGMSG_INFO) end if @@ -2463,17 +2332,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 @@ -2481,6 +2343,7 @@ subroutine DataInitialize(gcomp, rc) call NUOPC_CompAttributeGet(gcomp, name="read_restart", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (mastertask) then + write(logunit,*) write(logunit,'(a)') trim(subname)//' read_restart = '//trim(cvalue) end if read(cvalue,*) read_restart @@ -2509,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 @@ -2545,7 +2408,6 @@ subroutine DataInitialize(gcomp, rc) end subroutine DataInitialize !----------------------------------------------------------------------------- - subroutine SetRunClock(gcomp, rc) use ESMF , only : ESMF_GridComp, ESMF_CLOCK, ESMF_Time, ESMF_TimeInterval @@ -2553,6 +2415,7 @@ subroutine SetRunClock(gcomp, rc) 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 @@ -2561,11 +2424,18 @@ 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 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) ' !----------------------------------------------------------- @@ -2576,37 +2446,48 @@ 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, rc=rc) + call NUOPC_CompCheckSetClock(gcomp, dClock, checkTimeStep=.false., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - !-------------------------------- - ! Advance med clock to trigger alarms then reset model clock back to currtime - !-------------------------------- + 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 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 - call ESMF_ClockAdvance(mediatorClock,rc=rc) + ! Advance med clock to trigger alarms then reset model clock back to currtime + 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 @@ -2638,7 +2519,7 @@ subroutine med_meshinfo_create(FB, mesh_info, FBArea, rc) integer :: numOwnedElements integer :: spatialDim real(r8), allocatable :: ownedElemCoords(:) - real(r8), pointer :: dataptr(:) => null() + real(r8), pointer :: dataptr(:) integer :: n, dimcount, fieldcount character(len=*),parameter :: subname=' (module_MED:med_meshinfo_create) ' !------------------------------------------------------------------------------- @@ -2733,43 +2614,33 @@ subroutine med_grid_write(grid, fileName, rc) call ESMF_GridGetCoord(grid, staggerLoc=ESMF_STAGGERLOC_CENTER, & isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (isPresent) then call ESMF_GridGetCoord(grid, coordDim=1, & staggerLoc=ESMF_STAGGERLOC_CENTER, array=array, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_ArraySet(array, name="lon_center", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_ArrayBundleAdd(arrayBundle, (/array/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_GridGetCoord(grid, coordDim=2, & staggerLoc=ESMF_STAGGERLOC_CENTER, array=array, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_ArraySet(array, name="lat_center", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_ArrayBundleAdd(arrayBundle, (/array/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return endif - ! Mask call ESMF_GridGetItem(grid, itemflag=ESMF_GRIDITEM_MASK, & staggerLoc=ESMF_STAGGERLOC_CENTER, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (isPresent) then call ESMF_GridGetItem(grid, staggerLoc=ESMF_STAGGERLOC_CENTER, & itemflag=ESMF_GRIDITEM_MASK, array=array, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_ArraySet(array, name="mask_center", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_ArrayBundleAdd(arrayBundle, (/array/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return endif @@ -2778,15 +2649,12 @@ subroutine med_grid_write(grid, fileName, rc) call ESMF_GridGetItem(grid, itemflag=ESMF_GRIDITEM_AREA, & staggerLoc=ESMF_STAGGERLOC_CENTER, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (isPresent) then call ESMF_GridGetItem(grid, staggerLoc=ESMF_STAGGERLOC_CENTER, & itemflag=ESMF_GRIDITEM_AREA, array=array, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_ArraySet(array, name="area_center", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_ArrayBundleAdd(arrayBundle, (/array/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return endif @@ -2801,20 +2669,15 @@ subroutine med_grid_write(grid, fileName, rc) call ESMF_GridGetCoord(grid, coordDim=1, & staggerLoc=ESMF_STAGGERLOC_CORNER, array=array, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_ArraySet(array, name="lon_corner", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_ArrayBundleAdd(arrayBundle, (/array/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_GridGetCoord(grid, coordDim=2, & staggerLoc=ESMF_STAGGERLOC_CORNER, array=array, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_ArraySet(array, name="lat_corner", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_ArrayBundleAdd(arrayBundle, (/array/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return endif @@ -2823,15 +2686,12 @@ subroutine med_grid_write(grid, fileName, rc) call ESMF_GridGetItem(grid, itemflag=ESMF_GRIDITEM_MASK, & staggerLoc=ESMF_STAGGERLOC_CORNER, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (isPresent) then call ESMF_GridGetItem(grid, staggerLoc=ESMF_STAGGERLOC_CORNER, & itemflag=ESMF_GRIDITEM_MASK, array=array, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_ArraySet(array, name="mask_corner", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_ArrayBundleAdd(arrayBundle, (/array/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return endif @@ -2840,15 +2700,12 @@ subroutine med_grid_write(grid, fileName, rc) call ESMF_GridGetItem(grid, itemflag=ESMF_GRIDITEM_AREA, & staggerLoc=ESMF_STAGGERLOC_CORNER, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (isPresent) then call ESMF_GridGetItem(grid, staggerLoc=ESMF_STAGGERLOC_CORNER, & itemflag=ESMF_GRIDITEM_AREA, array=array, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_ArraySet(array, name="area_corner", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_ArrayBundleAdd(arrayBundle, (/array/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return endif diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index c996f4354..c8bb304e4 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 @@ -381,22 +380,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) @@ -601,12 +584,12 @@ subroutine med_phases_diag_atm(gcomp, rc) ! local variables type(InternalState) :: is_local integer :: n,nf,ic,ip - real(r8), pointer :: afrac(:) => null() - real(r8), pointer :: lfrac(:) => null() - real(r8), pointer :: ifrac(:) => null() - real(r8), pointer :: ofrac(:) => null() - real(r8), pointer :: areas(:) => null() - real(r8), pointer :: lats(:) => null() + real(r8), pointer :: afrac(:) + real(r8), pointer :: lfrac(:) + real(r8), pointer :: ifrac(:) + real(r8), pointer :: ofrac(:) + real(r8), pointer :: areas(:) + real(r8), pointer :: lats(:) type(ESMF_Field) :: lfield character(*), parameter :: subName = '(med_phases_diag_atm) ' !------------------------------------------------------------------------------- @@ -739,7 +722,7 @@ subroutine diag_atm_recv(FB, fldname, nf, areas, lats, afrac, lfrac, ofrac, ifra ! local variables integer :: n, ip type(ESMF_field) :: lfield - real(r8), pointer :: data(:) => null() + real(r8), pointer :: data(:) ! ------------------------------------------------------------------ rc = ESMF_SUCCESS if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then @@ -775,7 +758,7 @@ subroutine diag_atm_send(FB, fldname, nf, areas, lats, afrac, lfrac, ofrac, ifra ! local variables integer :: n, ip type(ESMF_field) :: lfield - real(r8), pointer :: data(:) => null() + real(r8), pointer :: data(:) ! ------------------------------------------------------------------ rc = ESMF_SUCCESS if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then @@ -814,7 +797,7 @@ subroutine diag_atm_wiso_recv(FB, fldname, nf_16O, nf_18O, nf_HDO, areas, lats, ! local variables integer :: n, ip type(ESMF_Field) :: lfield - real(r8), pointer :: data(:,:) => null() + real(r8), pointer :: data(:,:) ! ------------------------------------------------------------------ rc = ESMF_SUCCESS if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then @@ -871,7 +854,7 @@ subroutine diag_atm_wiso_send(FB, fldname, nf_16O, nf_18O, nf_HDO, areas, lats, ! local variables integer :: n, ip type(ESMF_Field) :: lfield - real(r8), pointer :: data(:,:) => null() + real(r8), pointer :: data(:,:) ! ------------------------------------------------------------------ rc = ESMF_SUCCESS if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then @@ -924,9 +907,9 @@ subroutine med_phases_diag_lnd( gcomp, rc) ! local variables type(InternalState) :: is_local - real(r8), pointer :: lfrac(:) => null() + real(r8), pointer :: lfrac(:) integer :: n,ip, ic - real(r8), pointer :: areas(:) => null() + real(r8), pointer :: areas(:) type(ESMF_Field) :: lfield character(*), parameter :: subName = '(med_phases_diag_lnd) ' ! ------------------------------------------------------------------ @@ -966,8 +949,6 @@ subroutine med_phases_diag_lnd( gcomp, rc) areas, lfrac, budget_local, minus=.true., rc=rc) call diag_lnd(is_local%wrap%FBImp(complnd,complnd), 'Flrl_rofsub', f_watr_roff, ic,& areas, lfrac, budget_local, minus=.true., rc=rc) - call diag_lnd(is_local%wrap%FBImp(complnd,complnd), 'Flrl_rofdto', f_watr_roff, ic,& - areas, lfrac, budget_local, minus=.true., rc=rc) call diag_lnd(is_local%wrap%FBImp(complnd,complnd), 'Flrl_irrig' , f_watr_roff, ic,& areas, lfrac, budget_local, minus=.true., rc=rc) call diag_lnd(is_local%wrap%FBImp(complnd,complnd), 'Flrl_rofi' , f_watr_ioff, ic,& @@ -1029,7 +1010,7 @@ subroutine diag_lnd(FB, fldname, nf, ic, areas, lfrac, budget, minus, rc) ! local variables integer :: n, ip type(ESMF_field) :: lfield - real(r8), pointer :: data(:) => null() + real(r8), pointer :: data(:) ! ------------------------------------------------------------------ rc = ESMF_SUCCESS @@ -1063,7 +1044,7 @@ subroutine diag_lnd_wiso(FB, fldname, nf_16O, nf_18O, nf_HDO, ic, areas, lfrac, ! local variables integer :: n, ip type(ESMF_field) :: lfield - real(r8), pointer :: data(:,:) => null() + real(r8), pointer :: data(:,:) ! ------------------------------------------------------------------ rc = ESMF_SUCCESS @@ -1101,7 +1082,7 @@ subroutine med_phases_diag_rof( gcomp, rc) ! local variables type(InternalState) :: is_local integer :: ic, ip, n - real(r8), pointer :: areas(:) => null() + real(r8), pointer :: areas(:) character(*), parameter :: subName = '(med_phases_diag_rof) ' ! ------------------------------------------------------------------ @@ -1145,7 +1126,6 @@ subroutine med_phases_diag_rof( gcomp, rc) call diag_rof(is_local%wrap%FBExp(comprof), 'Flrl_rofsur', f_watr_roff, ic, areas, budget_local, rc=rc) call diag_rof(is_local%wrap%FBExp(comprof), 'Flrl_rofgwl', f_watr_roff, ic, areas, budget_local, rc=rc) call diag_rof(is_local%wrap%FBExp(comprof), 'Flrl_rofsub', f_watr_roff, ic, areas, budget_local, rc=rc) - call diag_rof(is_local%wrap%FBExp(comprof), 'Flrl_rofdto', f_watr_roff, ic, areas, budget_local, rc=rc) call diag_rof(is_local%wrap%FBExp(comprof), 'Flrl_irrig' , f_watr_roff, ic, areas, budget_local, rc=rc) call diag_rof(is_local%wrap%FBExp(comprof), 'Flrl_rofi' , f_watr_ioff, ic, areas, budget_local, rc=rc) @@ -1173,7 +1153,7 @@ subroutine diag_rof(FB, fldname, nf, ic, areas, budget, minus, rc) ! local variables integer :: n, ip type(ESMF_field) :: lfield - real(r8), pointer :: data(:) => null() + real(r8), pointer :: data(:) ! ------------------------------------------------------------------ rc = ESMF_SUCCESS @@ -1207,7 +1187,7 @@ subroutine diag_rof_wiso(FB, fldname, nf_16O, nf_18O, nf_HDO, ic, areas, budget, ! local variables integer :: n, ip type(ESMF_field) :: lfield - real(r8), pointer :: data(:,:) => null() + real(r8), pointer :: data(:,:) ! ------------------------------------------------------------------ rc = ESMF_SUCCESS @@ -1245,7 +1225,7 @@ subroutine med_phases_diag_glc( gcomp, rc) ! local variables type(InternalState) :: is_local integer :: ic, ip, ns - real(r8), pointer :: areas(:) => null() + real(r8), pointer :: areas(:) character(*), parameter :: subName = '(med_phases_diag_glc) ' ! ------------------------------------------------------------------ @@ -1290,7 +1270,7 @@ subroutine diag_glc(FB, fldname, nf, ic, areas, budget, minus, rc) ! local variables integer :: n, ip type(ESMF_field) :: lfield - real(r8), pointer :: data(:) => null() + real(r8), pointer :: data(:) ! ------------------------------------------------------------------ rc = ESMF_SUCCESS if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then @@ -1314,7 +1294,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 @@ -1324,11 +1304,12 @@ subroutine med_phases_diag_ocn( gcomp, rc) type(InternalState) :: is_local integer :: n,ic,ip real(r8) :: wgt_i,wgt_o - 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 :: areas(:) => null() - real(r8), pointer :: data(:) => null() + real(r8), pointer :: ifrac(:) ! ice fraction in ocean grid cell + real(r8), pointer :: ofrac(:) ! non-ice fraction nin ocean grid cell + real(r8), pointer :: sfrac(:) ! sum of ifrac and ofrac + real(r8), pointer :: sfrac_x_ofrac(:) + real(r8), pointer :: areas(:) + real(r8), pointer :: data(:) type(ESMF_field) :: lfield character(*), parameter :: subName = '(med_phases_diag_ocn) ' ! ------------------------------------------------------------------ @@ -1346,6 +1327,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 +1373,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 +1395,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) @@ -1440,7 +1446,7 @@ subroutine diag_ocn(FB, fldname, nf, ic, areas, frac, budget, scale, rc) ! local variables integer :: n, ip type(ESMF_field) :: lfield - real(r8), pointer :: data(:) => null() + real(r8), pointer :: data(:) ! ------------------------------------------------------------------ rc = ESMF_SUCCESS if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then @@ -1473,7 +1479,7 @@ subroutine diag_ocn_wiso(FB, fldname, nf_16O, nf_18O, nf_HDO, ic, areas, frac, b ! local variables integer :: n, ip type(ESMF_field) :: lfield - real(r8), pointer :: data(:,:) => null() + real(r8), pointer :: data(:,:) ! ------------------------------------------------------------------ rc = ESMF_SUCCESS if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then @@ -1504,10 +1510,10 @@ subroutine med_phases_diag_ice_ice2med( gcomp, rc) ! local variables type(InternalState) :: is_local integer :: n,ic,ip - real(r8), pointer :: ofrac(:) => null() - real(r8), pointer :: ifrac(:) => null() - real(r8), pointer :: areas(:) => null() - real(r8), pointer :: lats(:) => null() + real(r8), pointer :: ofrac(:) + real(r8), pointer :: ifrac(:) + real(r8), pointer :: areas(:) + real(r8), pointer :: lats(:) type(ESMF_field) :: lfield character(*), parameter :: subName = '(med_phases_diag_ice_ice2med) ' ! ------------------------------------------------------------------ @@ -1544,10 +1550,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, & @@ -1580,7 +1602,7 @@ subroutine diag_ice_recv(FB, fldname, nf, areas, lats, ifrac, budget, minus, sca ! local variables integer :: n, ic, ip type(ESMF_Field) :: lfield - real(r8), pointer :: data(:) => null() + real(r8), pointer :: data(:) ! ------------------------------------------------------------------ rc = ESMF_SUCCESS if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then @@ -1626,7 +1648,7 @@ subroutine diag_ice_recv_wiso(FB, fldname, nf_16O, nf_18O, nf_HDO, areas, lats, ! local variables integer :: n, ic, ip type(ESMF_Field) :: lfield - real(r8), pointer :: data(:,:) => null() + real(r8), pointer :: data(:,:) ! ------------------------------------------------------------------ rc = ESMF_SUCCESS @@ -1670,11 +1692,11 @@ subroutine med_phases_diag_ice_med2ice( gcomp, rc) type(InternalState) :: is_local integer :: n,ic,ip real(r8) :: wgt_i, wgt_o - real(r8), pointer :: ofrac(:) => null() - real(r8), pointer :: ifrac(:) => null() - real(r8), pointer :: data(:) => null() - real(r8), pointer :: areas(:) => null() - real(r8), pointer :: lats(:) => null() + real(r8), pointer :: ofrac(:) + real(r8), pointer :: ifrac(:) + real(r8), pointer :: data(:) + real(r8), pointer :: areas(:) + real(r8), pointer :: lats(:) type(ESMF_Field) :: lfield character(*), parameter :: subName = '(med_phases_diag_ice_med2ice) ' ! ------------------------------------------------------------------ @@ -1756,7 +1778,7 @@ subroutine diag_ice_send(FB, fldname, nf, areas, lats, ifrac, budget, rc) ! local variables integer :: n, ic, ip type(ESMF_Field) :: lfield - real(r8), pointer :: data(:) => null() + real(r8), pointer :: data(:) ! ------------------------------------------------------------------ rc = ESMF_SUCCESS ip = period_inst @@ -1790,7 +1812,7 @@ subroutine diag_ice_send_wiso(FB, fldname, nf_16O, nf_18O, nf_HDO, areas, lats, ! local variables integer :: n, ic, ip type(ESMF_Field) :: lfield - real(r8), pointer :: data(:,:) => null() + real(r8), pointer :: data(:,:) ! ------------------------------------------------------------------ rc = ESMF_SUCCESS if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then @@ -2479,7 +2501,7 @@ subroutine add_to_budget_diag(entries, index, name) integer :: n integer :: oldsize logical :: found - type(budget_diag_type), pointer :: new_entries(:) => null() + type(budget_diag_type), pointer :: new_entries(:) character(len=*), parameter :: subname='(add_to_budget_diag)' !---------------------------------------------------------------------- diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index 312d1faff..7b7b7ca4d 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -166,18 +166,18 @@ subroutine med_fraction_init(gcomp, rc) type(ESMF_Field) :: field_src type(ESMF_Field) :: field_dst type(ESMF_Field) :: lfield - real(R8), pointer :: frac(:) => null() - real(R8), pointer :: ofrac(:) => null() - real(R8), pointer :: aofrac(:) => null() - real(R8), pointer :: lfrac(:) => null() - real(R8), pointer :: ifrac(:) => null() - real(R8), pointer :: gfrac(:) => null() - real(R8), pointer :: rfrac(:) => null() - real(R8), pointer :: wfrac(:) => null() - real(R8), pointer :: Sl_lfrin(:) => null() - real(R8), pointer :: Si_imask(:) => null() - real(R8), pointer :: So_omask(:) => null() - real(R8), pointer :: Sa_ofrac(:) => null() + real(R8), pointer :: frac(:) + real(R8), pointer :: ofrac(:) + real(R8), pointer :: aofrac(:) + real(R8), pointer :: lfrac(:) + real(R8), pointer :: ifrac(:) + real(R8), pointer :: gfrac(:) + real(R8), pointer :: rfrac(:) + real(R8), pointer :: wfrac(:) + real(R8), pointer :: Sl_lfrin(:) + real(R8), pointer :: Si_imask(:) + real(R8), pointer :: So_omask(:) + real(R8), pointer :: Sa_ofrac(:) integer :: i,j,n,n1,ns integer :: maptype integer :: fieldCount @@ -224,7 +224,7 @@ subroutine med_fraction_init(gcomp, rc) (ESMF_StateIsCreated(is_local%wrap%NStateImp(n1),rc=rc) .or. & ESMF_StateIsCreated(is_local%wrap%NStateExp(n1),rc=rc))) then ! Check number of fields in the state - call State_GetNumFields(is_local%wrap%NStateImp(n1), fieldCount, rc=rc) + call State_GetNumFields(is_local%wrap%NStateImp(n1), fieldCount, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! create FBFrac @@ -656,13 +656,13 @@ subroutine med_fraction_set(gcomp, rc) ! local variables type(InternalState) :: is_local - real(r8), pointer :: lfrac(:) => null() - real(r8), pointer :: ifrac(:) => null() - real(r8), pointer :: ofrac(:) => null() - real(r8), pointer :: aofrac(:) => null() - real(r8), pointer :: Si_ifrac(:) => null() - real(r8), pointer :: Si_imask(:) => null() - real(r8), pointer :: Sa_ofrac(:) => null() + real(r8), pointer :: lfrac(:) + real(r8), pointer :: ifrac(:) + real(r8), pointer :: ofrac(:) + real(r8), pointer :: aofrac(:) + real(r8), pointer :: Si_ifrac(:) + real(r8), pointer :: Si_imask(:) + real(r8), pointer :: Sa_ofrac(:) type(ESMF_Field) :: lfield type(ESMF_Field) :: field_src type(ESMF_Field) :: field_dst diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index da21c30f5..bc5287a61 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 @@ -85,20 +88,15 @@ module med_internalstate_mod type(packed_data_type) :: packed_data(ncomps,ncomps,nmappers) ! Packed data structure needed to efficiently map field bundles ! Fractions - type(ESMF_FieldBundle) :: FBfrac(ncomps) ! Fraction data for various components, on their grid + type(ESMF_FieldBundle) :: FBfrac(ncomps) ! Fraction data for various components, on their grid ! Accumulators for export field bundles - type(ESMF_FieldBundle) :: FBExpAccum(ncomps) ! Accumulator for various components export on their grid - integer :: FBExpAccumCnt(ncomps) = 0 ! Accumulator counter for each FBExpAccum - logical :: FBExpAccumFlag(ncomps) = .false. ! Accumulator flag, if true accumulation was done - - ! Accumulators for import field bundles - type(ESMF_FieldBundle) :: FBImpAccum(ncomps,ncomps) ! Accumulator for various components import - integer :: FBImpAccumCnt(ncomps) = 0 ! Accumulator counter for each FBImpAccum + type(ESMF_FieldBundle) :: FBExpAccumOcn ! Accumulator for various components export on their grid + integer :: ExpAccumOcnCnt = 0 ! Accumulator counter for each FBExpAccum ! Component Mesh info type(mesh_info_type) :: mesh_info(ncomps) - type(ESMF_FieldBundle) :: FBArea(ncomps) ! needed for mediator history writes + type(ESMF_FieldBundle) :: FBArea(ncomps) ! needed for mediator history writes end type InternalStateStruct diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index bb156258e..e26748b8f 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -7,9 +7,9 @@ module med_io_mod use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, I8=>SHR_KIND_I8, R8=>SHR_KIND_R8 use med_kind_mod , only : R4=>SHR_KIND_R4 use shr_const_mod , only : fillvalue => SHR_CONST_SPVAL - use ESMF , only : ESMF_VM, ESMF_LogWrite, ESMF_LOGMSG_INFO - use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE - use ESMF , only : ESMF_VMGetCurrent, ESMF_VMGet, ESMF_VMBroadCast, ESMF_GridComp + use ESMF , only : ESMF_VM, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LogFoundError + use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE, ESMF_END_ABORT, ESMF_LOGERR_PASSTHRU + use ESMF , only : ESMF_VMGetCurrent, ESMF_VMGet, ESMF_VMBroadCast, ESMF_Finalize use NUOPC , only : NUOPC_FieldDictionaryGetEntry use NUOPC , only : NUOPC_FieldDictionaryHasEntry use pio , only : file_desc_t, iosystem_desc_t @@ -30,6 +30,8 @@ module med_io_mod public :: med_io_enddef public :: med_io_sec2hms public :: med_io_read + public :: med_io_define_time + public :: med_io_write_time public :: med_io_write public :: med_io_init public :: med_io_date2yyyymmdd @@ -55,7 +57,6 @@ module med_io_mod module procedure med_io_write_r8 module procedure med_io_write_r81d module procedure med_io_write_char - module procedure med_io_write_time end interface med_io_write interface med_io_date2ymd module procedure med_io_date2ymd_int @@ -70,16 +71,13 @@ module med_io_mod module procedure med_io_ymd2date_long end interface med_io_ymd2date - !------------------------------------------------------------------------------- ! module data - !------------------------------------------------------------------------------- - character(*),parameter :: prefix = "med_io_" character(*),parameter :: modName = "(med_io_mod) " character(*),parameter :: version = "cmeps0" + integer , parameter :: number_strlen = 8 integer , parameter :: file_desc_t_cnt = 20 ! Note - this is hard-wired for now - integer , parameter :: number_strlen = 2 - character(CL) :: wfilename = '' + character(CL) :: wfilename(0:file_desc_t_cnt) = '' type(file_desc_t) :: io_file(0:file_desc_t_cnt) integer :: pio_iotype integer :: pio_ioformat @@ -91,7 +89,7 @@ module med_io_mod contains !================================================================================= - logical function med_io_file_exists(vm, iam, filename) + logical function med_io_file_exists(vm, filename) !--------------- ! inquire if i/o file exists @@ -99,19 +97,24 @@ logical function med_io_file_exists(vm, iam, filename) ! input/output variables type(ESMF_VM) :: vm - integer, intent(in) :: iam character(len=*), intent(in) :: filename ! local variables integer :: tmp(1) + integer :: iam integer :: rc !------------------------------------------------------------------------------- tmp(1) = 0 - med_io_file_exists = .false. - if (iam==0) inquire(file=trim(filename),exist=med_io_file_exists) - if (med_io_file_exists) tmp(1) = 1 + call ESMF_VMGet(vm, localPet=iam, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + med_io_file_exists = .false. + if (iam==0) then + inquire(file=trim(filename),exist=med_io_file_exists) + if (med_io_file_exists) tmp(1) = 1 + end if call ESMF_VMBroadCast(vm, tmp, 1, 0, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -126,6 +129,7 @@ subroutine med_io_init(gcomp, rc) ! initialize pio !--------------- + use ESMF , only : ESMF_GridComp, ESMF_UtilStringUpperCase #ifdef CESMCOUPLED use shr_pio_mod , only : shr_pio_getiosys, shr_pio_getiotype, shr_pio_getioformat #else @@ -136,13 +140,12 @@ subroutine med_io_init(gcomp, rc) use pio , only : PIO_REARR_COMM_P2P, PIO_REARR_COMM_COLL use pio , only : PIO_REARR_COMM_FC_2D_ENABLE, PIO_REARR_COMM_FC_2D_DISABLE use pio , only : PIO_REARR_COMM_FC_1D_COMP2IO, PIO_REARR_COMM_FC_1D_IO2COMP - use ESMF , only : ESMF_GridComp, ESMF_UtilStringUpperCase use NUOPC, only : NUOPC_CompAttributeGet #endif ! input/output arguments - type(ESMF_GridComp), intent(in) :: gcomp - integer , intent(out) :: rc + type(ESMF_GridComp), intent(in) :: gcomp + integer , intent(out) :: rc #ifndef CESMCOUPLED ! local variables @@ -495,7 +498,7 @@ subroutine med_io_init(gcomp, rc) end subroutine med_io_init !=============================================================================== - subroutine med_io_wopen(filename, vm, iam, clobber, file_ind, model_doi_url) + subroutine med_io_wopen(filename, vm, clobber, file_ind, model_doi_url) !--------------- ! open netcdf file @@ -509,7 +512,6 @@ subroutine med_io_wopen(filename, vm, iam, clobber, file_ind, model_doi_url) ! input/output arguments character(*), intent(in) :: filename type(ESMF_VM) :: vm - integer, intent(in) :: iam logical, optional, intent(in) :: clobber integer, optional, intent(in) :: file_ind character(CL), optional, intent(in) :: model_doi_url @@ -520,6 +522,7 @@ subroutine med_io_wopen(filename, vm, iam, clobber, file_ind, model_doi_url) integer :: nmode integer :: lfile_ind integer :: rc + integer :: iam character(CL) :: lversion character(CL) :: lmodel_doi_url character(*),parameter :: subName = '(med_io_wopen) ' @@ -538,10 +541,13 @@ subroutine med_io_wopen(filename, vm, iam, clobber, file_ind, model_doi_url) if (.not. pio_file_is_open(io_file(lfile_ind))) then + call ESMF_VMGet(vm, localPet=iam, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! filename not open - wfilename = filename + wfilename(lfile_ind) = trim(filename) - if (med_io_file_exists(vm, iam, filename)) then + if (med_io_file_exists(vm, filename)) then if (lclobber) then nmode = pio_clobber ! only applies to classic NETCDF files. @@ -549,14 +555,12 @@ subroutine med_io_wopen(filename, vm, iam, clobber, file_ind, model_doi_url) nmode = ior(nmode,pio_ioformat) endif rcode = pio_createfile(io_subsystem, io_file(lfile_ind), pio_iotype, trim(filename), nmode) - if(iam==0) write(logunit,*) subname,' create file ',trim(filename) + if(iam==0) write(logunit,'(a)') trim(subname)//' creating file '//trim(filename) rcode = pio_put_att(io_file(lfile_ind),pio_global,"file_version",version) rcode = pio_put_att(io_file(lfile_ind),pio_global,"model_doi_url",lmodel_doi_url) else rcode = pio_openfile(io_subsystem, io_file(lfile_ind), pio_iotype, trim(filename), pio_write) - if (iam==0) then - write(logunit,*) subname,' open file ',trim(filename) - end if + if (iam==0) write(logunit,'(a)') trim(subname)//' opening file '//trim(filename) call pio_seterrorhandling(io_file(lfile_ind),PIO_BCAST_ERROR) rcode = pio_get_att(io_file(lfile_ind),pio_global,"file_version",lversion) call pio_seterrorhandling(io_file(lfile_ind),PIO_INTERNAL_ERROR) @@ -573,19 +577,21 @@ subroutine med_io_wopen(filename, vm, iam, clobber, file_ind, model_doi_url) nmode = ior(nmode,pio_ioformat) endif rcode = pio_createfile(io_subsystem, io_file(lfile_ind), pio_iotype, trim(filename), nmode) - if (iam==0) then - write(logunit,*) subname,' create file ',trim(filename) - end if + if (iam==0) write(logunit,'(a)') trim(subname) //' creating file '// trim(filename) rcode = pio_put_att(io_file(lfile_ind),pio_global,"file_version",version) rcode = pio_put_att(io_file(lfile_ind),pio_global,"model_doi_url",lmodel_doi_url) endif - elseif (trim(wfilename) /= trim(filename)) then + + elseif (trim(wfilename(lfile_ind)) /= trim(filename)) then ! filename is open, better match open filename - if(iam==0) write(logunit,*) subname,' different filename currently open ',trim(filename) - if(iam==0) write(logunit,*) subname,' different wfilename currently open ',trim(wfilename) - call ESMF_LogWrite(subname//'different file currently open '//trim(filename), ESMF_LOGMSG_INFO) + if (iam==0) then + write(logunit,'(a)') trim(subname)//' different filename currently open '//trim(filename) + write(logunit,'(a)') trim(subname)//' different wfilename currently open '//trim(wfilename(lfile_ind)) + end if + call ESMF_LogWrite(trim(subname)//'different file currently open '//trim(filename), ESMF_LOGMSG_INFO) rc = ESMF_FAILURE return + else ! filename is already open, just return endif @@ -593,7 +599,7 @@ subroutine med_io_wopen(filename, vm, iam, clobber, file_ind, model_doi_url) end subroutine med_io_wopen !=============================================================================== - subroutine med_io_close(filename, iam, file_ind, rc) + subroutine med_io_close(filename, vm, file_ind, rc) !--------------- ! close netcdf file @@ -602,13 +608,14 @@ subroutine med_io_close(filename, iam, file_ind, rc) use pio, only: pio_file_is_open, pio_closefile ! input/output variables - character(*), intent(in) :: filename - integer, intent(in) :: iam - integer,optional, intent(in) :: file_ind - integer , intent(out) :: rc + character(*) , intent(in) :: filename + type(ESMF_VM) , intent(in) :: vm + integer,optional , intent(in) :: file_ind + integer , intent(out) :: rc ! local variables integer :: lfile_ind + integer :: iam character(*),parameter :: subName = '(med_io_close) ' !------------------------------------------------------------------------------- @@ -619,18 +626,28 @@ subroutine med_io_close(filename, iam, file_ind, rc) if (.not. pio_file_is_open(io_file(lfile_ind))) then ! filename not open, just return - elseif (trim(wfilename) == trim(filename)) then + elseif (trim(wfilename(lfile_ind)) == trim(filename)) then ! filename matches, close it call pio_closefile(io_file(lfile_ind)) + !wfilename(lfile_ind) = '' else + call ESMF_VMGet(vm, localPet=iam, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! different filename is open, abort - if (iam==0) write(logunit,*) subname,' different filename currently open, aborting ',trim(filename) - if (iam==0) write(logunit,*) subname,' different wfilename currently open, aborting ',trim(wfilename) + if (iam==0) then + write(logunit,*) subname,' different wfilename and filename currently open, aborting ' + write(logunit,'(a)') 'filename = ',trim(filename) + write(logunit,'(a)') 'wfilename = ',trim(wfilename(lfile_ind)) + write(logunit,'(i6)')'lfile_ind = ',lfile_ind + end if call ESMF_LogWrite(subname//'different file currently open, aborting '//trim(filename), ESMF_LOGMSG_INFO) rc = ESMF_FAILURE - return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) then + call ESMF_Finalize(endflag=ESMF_END_ABORT) + end if endif - wfilename = '' + end subroutine med_io_close !=============================================================================== @@ -669,8 +686,8 @@ subroutine med_io_enddef(filename,file_ind) lfile_ind = 0 if (present(file_ind)) lfile_ind=file_ind - rcode = pio_enddef(io_file(lfile_ind)) + end subroutine med_io_enddef !=============================================================================== @@ -728,8 +745,8 @@ character(len=8) function med_io_sec2hms (seconds, rc) end function med_io_sec2hms !=============================================================================== - subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & - fillval, pre, tavg, use_float, file_ind, rc) + subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & + fillval, pre, flds, tavg, use_float, file_ind, rc) !--------------- ! Write FB to netcdf file @@ -745,20 +762,20 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & use pio , only : pio_syncfile ! input/output variables - character(len=*), intent(in) :: filename ! file - integer, intent(in) :: iam ! local pet - type(ESMF_FieldBundle), intent(in) :: FB ! data to be written - logical, optional, intent(in) :: whead ! write header - logical, optional, intent(in) :: wdata ! write data - integer , optional, intent(in) :: nx ! 2d grid size if available - integer , optional, intent(in) :: ny ! 2d grid size if available - integer , optional, intent(in) :: nt ! time sample - real(r8), optional, intent(in) :: fillval ! fill value - character(len=*), optional, intent(in) :: pre ! prefix to variable name - logical, optional, intent(in) :: tavg ! is this a tavg - logical, optional, intent(in) :: use_float ! write output as float rather than double - integer, optional, intent(in) :: file_ind - integer, intent(out):: rc + character(len=*) , intent(in) :: filename ! file + type(ESMF_FieldBundle) , intent(in) :: FB ! data to be written + logical , intent(in) :: whead ! write header + logical , intent(in) :: wdata ! write data + integer , intent(in) :: nx ! 2d grid size if available + integer , intent(in) :: ny ! 2d grid size if available + integer , optional , intent(in) :: nt ! time sample + real(r8), optional , intent(in) :: fillval ! fill value + character(len=*), optional , intent(in) :: pre ! prefix to variable name + character(len=*), optional , intent(in) :: flds(:) ! specific fields to write out + logical, optional , intent(in) :: tavg ! is this a tavg + logical, optional , intent(in) :: use_float ! write output as float rather than double + integer, optional , intent(in) :: file_ind + integer , intent(out):: rc ! local variables type(ESMF_Field) :: field @@ -782,9 +799,8 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & character(CL) :: lname ! long name character(CL) :: sname ! standard name character(CL) :: lpre ! local prefix - logical :: lwhead, lwdata - logical :: luse_float integer :: lnx,lny + logical :: luse_float real(r8) :: lfillvalue integer, pointer :: minIndexPTile(:,:) integer, pointer :: maxIndexPTile(:,:) @@ -801,57 +817,24 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & integer :: ungriddedUBound(1) ! currently the size must equal 1 for rank 2 fields integer :: gridToFieldMap(1) ! currently the size must equal 1 for rank 2 fields logical :: isPresent + character(CL), allocatable :: fieldNameList(:) character(*),parameter :: subName = '(med_io_write_FB) ' !------------------------------------------------------------------------------- - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) - endif rc = ESMF_Success lfillvalue = fillvalue - if (present(fillval)) then - lfillvalue = fillval - endif - + if (present(fillval)) lfillvalue = fillval lpre = ' ' - if (present(pre)) then - lpre = trim(pre) - endif - - if (.not. ESMF_FieldBundleIsCreated(FB, rc=rc)) then - call ESMF_LogWrite(trim(subname)//" FB "//trim(lpre)//" not created", ESMF_LOGMSG_INFO) - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) - endif - rc = ESMF_Success - return - endif - - lwhead = .true. - lwdata = .true. - if (present(whead)) lwhead = whead - if (present(wdata)) lwdata = wdata - - if (.not.lwhead .and. .not.lwdata) then - ! should we write a warning? - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) - endif - return - endif - + if (present(pre)) lpre = trim(pre) luse_float = .false. if (present(use_float)) luse_float = use_float - lfile_ind = 0 if (present(file_ind)) lfile_ind=file_ind - call ESMF_FieldBundleGet(FB, fieldCount=nf, rc=rc) - write(tmpstr,*) subname//' field count = '//trim(lpre),nf - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) - if (nf < 1) then - call ESMF_LogWrite(trim(subname)//" FB "//trim(lpre)//" empty", ESMF_LOGMSG_INFO) + ! Error check + if (.not. ESMF_FieldBundleIsCreated(FB, rc=rc)) then + call ESMF_LogWrite(trim(subname)//" FB "//trim(lpre)//" not created", ESMF_LOGMSG_INFO) if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif @@ -859,43 +842,60 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & return endif + ! Get number of fields + if (present(flds)) then + nf = size(flds) + else + call ESMF_FieldBundleGet(FB, fieldCount=nf, rc=rc) + write(tmpstr,*) subname//' field count = '//trim(lpre), nf + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + if (nf < 1) then + call ESMF_LogWrite(trim(subname)//" FB "//trim(lpre)//" empty", ESMF_LOGMSG_INFO) + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + rc = ESMF_Success + return + endif + allocate(fieldNameList(nf)) + call ESMF_FieldBundleGet(FB, fieldNameList=fieldNameList, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + + ! Get field bundle mesh from first field call FB_getFieldN(FB, 1, field, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, mesh=mesh, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Get mesh distgrid and number of elements call ESMF_MeshGet(mesh, elementDistgrid=distgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_MeshGet(mesh, spatialDim=ndims, numOwnedElements=nelements, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - write(tmpstr,*) subname, 'ndims, nelements = ', ndims, nelements call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + ! Set element coordinates if (.not. allocated(ownedElemCoords) .and. ndims > 0 .and. nelements > 0) then allocate(ownedElemCoords(ndims*nelements)) allocate(ownedElemCoords_x(ndims*nelements/2)) allocate(ownedElemCoords_y(ndims*nelements/2)) - call ESMF_MeshGet(mesh, ownedElemCoords=ownedElemCoords, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ownedElemCoords_x = ownedElemCoords(1::2) ownedElemCoords_y = ownedElemCoords(2::2) end if + ! Get tile info call ESMF_DistGridGet(distgrid, dimCount=dimCount, tileCount=tileCount, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - allocate(minIndexPTile(dimCount, tileCount), maxIndexPTile(dimCount, tileCount)) call ESMF_DistGridGet(distgrid, minIndexPTile=minIndexPTile, maxIndexPTile=maxIndexPTile, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! write(tmpstr,*) subname,' counts = ',dimcount,tilecount,minindexptile,maxindexptile ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) - ! TODO: this is not getting the global size correct for a FB coming in that does not have ! all the global grid values in the distgrid - e.g. CTSM @@ -903,44 +903,40 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & lnx = ng lny = 1 deallocate(minIndexPTile, maxIndexPTile) - - frame = -1 - if (present(nt)) then - frame = nt - endif - if (present(nx)) then - if (nx > 0) lnx = nx - endif - if (present(ny)) then - if (ny > 0) lny = ny - endif + if (nx > 0) lnx = nx + if (ny > 0) lny = ny if (lnx*lny /= ng) then - write(tmpstr,*) subname,' ERROR: grid2d size not consistent ',ng,lnx,lny + write(tmpstr,*) subname,' WARNING: grid2d size not consistent ',ng,lnx,lny call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) - - !TODO: this should not be an error for say CTSM which does not send a global grid - !rc = ESMF_FAILURE - !return endif - if (lwhead) then - rcode = pio_def_dim(io_file(lfile_ind),trim(lpre)//'_nx',lnx,dimid2(1)) - rcode = pio_def_dim(io_file(lfile_ind),trim(lpre)//'_ny',lny,dimid2(2)) + if (present(nt)) then + frame = nt + else + frame = -1 + end if + ! Write header + if (whead) then + rcode = pio_def_dim(io_file(lfile_ind), trim(lpre)//'_nx', lnx, dimid2(1)) + rcode = pio_def_dim(io_file(lfile_ind), trim(lpre)//'_ny', lny, dimid2(2)) if (present(nt)) then dimid3(1:2) = dimid2 - rcode = pio_inq_dimid(io_file(lfile_ind),'time',dimid3(3)) + rcode = pio_inq_dimid(io_file(lfile_ind), 'time', dimid3(3)) dimid => dimid3 else dimid => dimid2 endif - write(tmpstr,*) subname,' dimid = ',dimid call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) do k = 1,nf - call FB_getNameN(FB, k, itemc, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Determine field name + if (present(flds)) then + itemc = trim(flds(k)) + else + itemc = trim(fieldNameList(k)) + end if ! Determine rank of field with name itemc call ESMF_FieldBundleGet(FB, itemc, field=lfield, rc=rc) @@ -1028,14 +1024,9 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & rcode = pio_put_att(io_file(lfile_ind), varid, "long_name", "latitude") rcode = pio_put_att(io_file(lfile_ind), varid, "units", "degrees_north") rcode = pio_put_att(io_file(lfile_ind), varid, "standard_name", "latitude") - - ! Finish define mode - if (lwdata) call med_io_enddef(filename, file_ind=lfile_ind) - end if - if (lwdata) then - + if (wdata) then ! use distgrid extracted from field 1 above call ESMF_DistGridGet(distgrid, localDE=0, elementCount=ns, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -1043,16 +1034,17 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & call ESMF_DistGridGet(distgrid, localDE=0, seqIndexList=dof, rc=rc) write(tmpstr,*) subname,' dof = ',ns,size(dof),dof(1),dof(ns) !,minval(dof),maxval(dof) call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) - call pio_initdecomp(io_subsystem, pio_double, (/lnx,lny/), dof, iodesc) - ! call pio_writedof(lpre, (/lnx,lny/), int(dof,kind=PIO_OFFSET_KIND), mpicom) - deallocate(dof) do k = 1,nf - call FB_getNameN(FB, k, itemc, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Determine field name + if (present(flds)) then + itemc = trim(flds(k)) + else + itemc = trim(fieldNameList(k)) + end if call FB_getFldPtr(FB, itemc, & fldptr1=fldptr1, fldptr2=fldptr2, rank=rank, rc=rc) @@ -1091,7 +1083,7 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & end if ! end if not "hgt" end do ! end loop over fields in FB - ! Fill coordinate variables + ! Fill coordinate variables - why is this being done each time? name1 = trim(lpre)//'_lon' rcode = pio_inq_varid(io_file(lfile_ind), trim(name1), varid) call pio_setframe(io_file(lfile_ind),varid,frame) @@ -1113,7 +1105,7 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & end subroutine med_io_write_FB !=============================================================================== - subroutine med_io_write_int(filename, iam, idata, dname, whead, wdata, file_ind, rc) + subroutine med_io_write_int(filename, idata, dname, whead, wdata, file_ind, rc) use pio, only : var_desc_t, pio_def_var, pio_put_att, pio_int, pio_inq_varid, pio_put_var @@ -1123,11 +1115,10 @@ subroutine med_io_write_int(filename, iam, idata, dname, whead, wdata, file_ind, ! intput/output variables character(len=*) ,intent(in) :: filename ! file - integer ,intent(in) :: iam ! local pet integer ,intent(in) :: idata ! data to be written character(len=*) ,intent(in) :: dname ! name of data - logical,optional ,intent(in) :: whead ! write header - logical,optional ,intent(in) :: wdata ! write data + logical ,intent(in) :: whead ! write header + logical ,intent(in) :: wdata ! write data integer,optional ,intent(in) :: file_ind integer ,intent(out):: rc @@ -1135,27 +1126,16 @@ subroutine med_io_write_int(filename, iam, idata, dname, whead, wdata, file_ind, integer :: rcode type(var_desc_t) :: varid character(CL) :: cunit ! var units - logical :: lwhead, lwdata integer :: lfile_ind character(*),parameter :: subName = '(med_io_write_int) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - lwhead = .true. - lwdata = .true. - if (present(whead)) lwhead = whead - if (present(wdata)) lwdata = wdata - - if (.not.lwhead .and. .not.lwdata) then - ! should we write a warning? - return - endif - lfile_ind = 0 if (present(file_ind)) lfile_ind=file_ind - if (lwhead) then + if (whead) then if (NUOPC_FieldDictionaryHasEntry(trim(dname))) then call NUOPC_FieldDictionaryGetEntry(dname, canonicalUnits=cunit, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -1163,19 +1143,16 @@ subroutine med_io_write_int(filename, iam, idata, dname, whead, wdata, file_ind, end if rcode = pio_def_var(io_file(lfile_ind),trim(dname),PIO_INT,varid) rcode = pio_put_att(io_file(lfile_ind),varid,"standard_name",trim(dname)) - if (lwdata) call med_io_enddef(filename, file_ind=lfile_ind) endif - - if (lwdata) then + if (wdata) then rcode = pio_inq_varid(io_file(lfile_ind),trim(dname),varid) rcode = pio_put_var(io_file(lfile_ind),varid,idata) - ! write(logunit,*) subname,' wrote AV ',trim(dname),lwhead,lwdata endif end subroutine med_io_write_int !=============================================================================== - subroutine med_io_write_int1d(filename, iam, idata, dname, whead, wdata, file_ind, rc) + subroutine med_io_write_int1d(filename, idata, dname, whead, wdata, file_ind, rc) !--------------- ! Write 1d integer array to netcdf file @@ -1186,14 +1163,13 @@ subroutine med_io_write_int1d(filename, iam, idata, dname, whead, wdata, file_in use pio , only : pio_int, pio_def_var ! input/output arguments - character(len=*),intent(in) :: filename ! file - integer ,intent(in) :: iam ! local pet - integer ,intent(in) :: idata(:) ! data to be written - character(len=*),intent(in) :: dname ! name of data - logical,optional,intent(in) :: whead ! write header - logical,optional,intent(in) :: wdata ! write data - integer,optional,intent(in) :: file_ind - integer , intent(out) :: rc + character(len=*) ,intent(in) :: filename ! file + integer ,intent(in) :: idata(:) ! data to be written + character(len=*) ,intent(in) :: dname ! name of data + logical ,intent(in) :: whead ! write header + logical ,intent(in) :: wdata ! write data + integer,optional ,intent(in) :: file_ind + integer , intent(out):: rc ! local variables integer :: rcode @@ -1203,50 +1179,34 @@ 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 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) - endif - - if (lwdata) then + else if (wdata) then rcode = pio_inq_varid(io_file(lfile_ind),trim(dname),varid) rcode = pio_put_var(io_file(lfile_ind),varid,idata) endif - ! write(logunit,*) subname,' wrote AV ',trim(dname),lwhead,lwdata - end subroutine med_io_write_int1d !=============================================================================== - subroutine med_io_write_r8(filename, iam, rdata, dname, whead, wdata, file_ind, rc) + subroutine med_io_write_r8(filename, rdata, dname, whead, wdata, file_ind, rc) !--------------- ! Write scalar double to netcdf file @@ -1256,39 +1216,25 @@ subroutine med_io_write_r8(filename, iam, rdata, dname, whead, wdata, file_ind, use pio , only : pio_double, pio_noerr, pio_inq_varid, pio_put_var ! input/output arguments - character(len=*),intent(in) :: filename ! file - integer ,intent(in) :: iam ! local pet - real(r8) ,intent(in) :: rdata ! data to be written - character(len=*),intent(in) :: dname ! name of data - logical,optional,intent(in) :: whead ! write header - logical,optional,intent(in) :: wdata ! write data - integer,optional,intent(in) :: file_ind - integer ,intent(out):: rc + character(len=*) ,intent(in) :: filename ! file + real(r8) ,intent(in) :: rdata ! data to be written + character(len=*) ,intent(in) :: dname ! name of data + logical ,intent(in) :: whead ! write header + logical ,intent(in) :: wdata ! write data + integer,optional ,intent(in) :: file_ind + integer ,intent(out):: rc ! local variables integer :: rcode type(var_desc_t) :: varid character(CL) :: cunit ! var units - logical :: lwhead, lwdata integer :: lfile_ind character(*),parameter :: subName = '(med_io_write_r8) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - lwhead = .true. - if (present(whead)) lwhead = whead - lwdata = .true. - if (present(wdata)) lwdata = wdata - lfile_ind = 0 - if (present(file_ind)) lfile_ind=file_ind - - if (.not.lwhead .and. .not.lwdata) then - ! should we write a warning? - return - endif - - if (lwhead) then + if (whead) then rcode = pio_def_var(io_file(lfile_ind),trim(dname),PIO_DOUBLE,varid) if (rcode==PIO_NOERR) then if (NUOPC_FieldDictionaryHasEntry(trim(dname))) then @@ -1297,11 +1243,8 @@ subroutine med_io_write_r8(filename, iam, rdata, dname, whead, wdata, file_ind, rcode = pio_put_att(io_file(lfile_ind),varid,"units",trim(cunit)) end if rcode = pio_put_att(io_file(lfile_ind),varid,"standard_name",trim(dname)) - if (lwdata) call med_io_enddef(filename, file_ind=lfile_ind) end if - endif - - if (lwdata) then + else if (wdata) then rcode = pio_inq_varid(io_file(lfile_ind),trim(dname),varid) rcode = pio_put_var(io_file(lfile_ind),varid,rdata) endif @@ -1309,7 +1252,7 @@ subroutine med_io_write_r8(filename, iam, rdata, dname, whead, wdata, file_ind, end subroutine med_io_write_r8 !=============================================================================== - subroutine med_io_write_r81d(filename, iam, rdata, dname, whead, wdata, file_ind, rc) + subroutine med_io_write_r81d(filename, rdata, dname, whead, wdata, file_ind, rc) !--------------- ! Write 1d double array to netcdf file @@ -1319,14 +1262,13 @@ subroutine med_io_write_r81d(filename, iam, rdata, dname, whead, wdata, file_ind use pio , only : pio_inq_varid, pio_put_var, pio_double, pio_put_att ! !INPUT/OUTPUT PARAMETERS: - character(len=*),intent(in) :: filename ! file - integer ,intent(in) :: iam - real(r8) ,intent(in) :: rdata(:) ! data to be written - character(len=*),intent(in) :: dname ! name of data - logical,optional,intent(in) :: whead ! write header - logical,optional,intent(in) :: wdata ! write data - integer,optional,intent(in) :: file_ind - integer ,intent(out):: rc + character(len=*) ,intent(in) :: filename ! file + real(r8) ,intent(in) :: rdata(:) ! data to be written + character(len=*) ,intent(in) :: dname ! name of data + logical ,intent(in) :: whead ! write header + logical ,intent(in) :: wdata ! write data + integer,optional ,intent(in) :: file_ind + integer ,intent(out):: rc ! local variables integer :: rcode @@ -1334,26 +1276,13 @@ subroutine med_io_write_r81d(filename, iam, rdata, dname, whead, wdata, file_ind type(var_desc_t) :: varid character(CL) :: cunit ! var units integer :: lnx - logical :: lwhead, lwdata integer :: lfile_ind character(*),parameter :: subName = '(med_io_write_r81d) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - lwhead = .true. - if (present(whead)) lwhead = whead - lwdata = .true. - if (present(wdata)) lwdata = wdata - lfile_ind = 0 - if (present(file_ind)) lfile_ind=file_ind - - if (.not.lwhead .and. .not.lwdata) then - ! should we write a warning? - return - endif - - if (lwhead) then + if (whead) then lnx = size(rdata) rcode = pio_def_dim(io_file(lfile_ind),trim(dname)//'_nx',lnx,dimid(1)) rcode = pio_def_var(io_file(lfile_ind),trim(dname),PIO_DOUBLE,dimid,varid) @@ -1363,10 +1292,9 @@ subroutine med_io_write_r81d(filename, iam, rdata, dname, whead, wdata, file_ind rcode = pio_put_att(io_file(lfile_ind),varid,"units",trim(cunit)) end if rcode = pio_put_att(io_file(lfile_ind),varid,"standard_name",trim(dname)) - if (lwdata) call med_io_enddef(filename, file_ind=lfile_ind) endif - if (lwdata) then + if (wdata) then rcode = pio_inq_varid(io_file(lfile_ind),trim(dname),varid) rcode = pio_put_var(io_file(lfile_ind),varid,rdata) endif @@ -1374,7 +1302,7 @@ subroutine med_io_write_r81d(filename, iam, rdata, dname, whead, wdata, file_ind end subroutine med_io_write_r81d !=============================================================================== - subroutine med_io_write_char(filename, iam, rdata, dname, whead, wdata, file_ind, rc) + subroutine med_io_write_char(filename, rdata, dname, whead, wdata, file_ind, rc) !--------------- ! Write char string to netcdf file @@ -1384,14 +1312,13 @@ subroutine med_io_write_char(filename, iam, rdata, dname, whead, wdata, file_ind use pio , only : pio_char, pio_put_var ! input/output arguments - character(len=*),intent(in) :: filename ! file - integer ,intent(in) :: iam ! local pet - character(len=*),intent(in) :: rdata ! data to be written - character(len=*),intent(in) :: dname ! name of data - logical,optional,intent(in) :: whead ! write header - logical,optional,intent(in) :: wdata ! write data - integer,optional,intent(in) :: file_ind - integer ,intent(out):: rc + character(len=*) ,intent(in) :: filename ! file + character(len=*) ,intent(in) :: rdata ! data to be written + character(len=*) ,intent(in) :: dname ! name of data + logical ,intent(in) :: whead ! write header + logical ,intent(in) :: wdata ! write data + integer,optional ,intent(in) :: file_ind + integer ,intent(out):: rc ! local variables integer :: rcode @@ -1401,7 +1328,6 @@ subroutine med_io_write_char(filename, iam, rdata, dname, whead, wdata, file_ind character(CL) :: lname ! long name character(CL) :: sname ! standard name integer :: lnx - logical :: lwhead, lwdata integer :: lfile_ind character(CL) :: charvar ! buffer for string read/write character(*),parameter :: subName = '(med_io_write_char) ' @@ -1409,18 +1335,7 @@ subroutine med_io_write_char(filename, iam, rdata, dname, whead, wdata, file_ind rc = ESMF_SUCCESS - lwhead = .true. - if (present(whead)) lwhead = whead - lwdata = .true. - if (present(wdata)) lwdata = wdata - lfile_ind = 0 - if (present(file_ind)) lfile_ind=file_ind - if (.not.lwhead .and. .not.lwdata) then - ! should we write a warning? - return - endif - - if (lwhead) then + if (whead) then lnx = len(charvar) rcode = pio_def_dim(io_file(lfile_ind),trim(dname)//'_len',lnx,dimid(1)) rcode = pio_def_var(io_file(lfile_ind),trim(dname),PIO_CHAR,dimid,varid) @@ -1429,9 +1344,7 @@ subroutine med_io_write_char(filename, iam, rdata, dname, whead, wdata, file_ind if (chkerr(rc,__LINE__,u_FILE_u)) return end if rcode = pio_put_att(io_file(lfile_ind),varid,"standard_name",trim(dname)) - if (lwdata) call med_io_enddef(filename, file_ind=lfile_ind) - endif - if (lwdata) then + else if (wdata) then charvar = '' charvar = trim(rdata) rcode = pio_inq_varid(io_file(lfile_ind),trim(dname),varid) @@ -1441,119 +1354,119 @@ subroutine med_io_write_char(filename, iam, rdata, dname, whead, wdata, file_ind end subroutine med_io_write_char !=============================================================================== - subroutine med_io_write_time(filename, iam, time_units, calendar, time_val, nt,& - whead, wdata, tbnds, file_ind, rc) + subroutine med_io_define_time(time_units, calendar, file_ind, rc) - !--------------- - ! Write time variable to netcdf file - !--------------- - - use ESMF, only : operator(==) - use ESMF, only : ESMF_Calendar + use ESMF, only : operator(==), operator(/=) + use ESMF, only : ESMF_Calendar, ESMF_CalendarIsCreated use ESMF, only : ESMF_CALKIND_360DAY, ESMF_CALKIND_GREGORIAN use ESMF, only : ESMF_CALKIND_JULIAN, ESMF_CALKIND_JULIANDAY, ESMF_CALKIND_MODJULIANDAY use ESMF, only : ESMF_CALKIND_NOCALENDAR, ESMF_CALKIND_NOLEAP + use ESMF, only : ESMF_LOGMSG_ERROR, ESMF_FAILURE use pio , only : var_desc_t, PIO_UNLIMITED use pio , only : pio_double, pio_def_dim, pio_def_var, pio_put_att use pio , only : pio_inq_varid, pio_put_var ! input/output variables - character(len=*) , intent(in) :: filename ! file - integer , intent(in) :: iam ! local pet - character(len=*) , intent(in) :: time_units ! units of time - type(ESMF_Calendar) , intent(in) :: calendar ! calendar - real(r8) , intent(in) :: time_val ! data to be written - integer , optional, intent(in) :: nt - logical , optional, intent(in) :: whead ! write header - logical , optional, intent(in) :: wdata ! write data - real(r8) , optional, intent(in) :: tbnds(2) ! time bounds - integer , optional, intent(in) :: file_ind - integer , intent(out):: rc + character(len=*) , intent(in) :: time_units ! units of time + type(ESMF_Calendar) , intent(in) :: calendar ! calendar + integer, optional , intent(in) :: file_ind + integer , intent(out):: rc ! local variables integer :: rcode integer :: dimid(1) integer :: dimid2(2) type(var_desc_t) :: varid - logical :: lwhead, lwdata - integer :: start(4),count(4) - real(r8) :: time_val_1d(1) integer :: lfile_ind character(CL) :: calname ! calendar name - character(*),parameter :: subName = '(med_io_write_time) ' + character(*),parameter :: subName = '(med_io_define_time) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - lwhead = .true. - if (present(whead)) lwhead = whead - lwdata = .true. - if (present(wdata)) lwdata = wdata lfile_ind = 0 if (present(file_ind)) lfile_ind=file_ind - if (.not.lwhead .and. .not.lwdata) then - ! should we write a warning? + + if (.not. ESMF_CalendarIsCreated(calendar)) then + call ESMF_LogWrite(trim(subname)//' ERROR: calendar is not created ', & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE return - endif + end if - ! Write out header - if (lwhead) then - rcode = pio_def_dim(io_file(lfile_ind),'time',PIO_UNLIMITED,dimid(1)) - rcode = pio_def_var(io_file(lfile_ind),'time',PIO_DOUBLE,dimid,varid) - rcode = pio_put_att(io_file(lfile_ind),varid,'units',trim(time_units)) - - if (calendar == ESMF_CALKIND_360DAY) then - calname = '360_day' - else if (calendar == ESMF_CALKIND_GREGORIAN) then - calname = 'gregorian' - else if (calendar == ESMF_CALKIND_JULIAN) then - calname = 'julian' - else if (calendar == ESMF_CALKIND_JULIANDAY) then - calname = 'ESMF_CALKIND_JULIANDAY' - else if (calendar == ESMF_CALKIND_MODJULIANDAY) then - calname = 'ESMF_CALKIND_MODJULIANDAY' - else if (calendar == ESMF_CALKIND_NOCALENDAR) then - calname = 'none' - else if (calendar == ESMF_CALKIND_NOLEAP) then - calname = 'noleap' - end if - rcode = pio_put_att(io_file(lfile_ind),varid,'calendar',trim(calname)) + ! define time and add calendar attribute + rcode = pio_def_dim(io_file(lfile_ind), 'time', PIO_UNLIMITED, dimid(1)) + rcode = pio_def_var(io_file(lfile_ind), 'time', PIO_DOUBLE, dimid, varid) + rcode = pio_put_att(io_file(lfile_ind), varid, 'units', trim(time_units)) + if (calendar == ESMF_CALKIND_360DAY) then + calname = '360_day' + else if (calendar == ESMF_CALKIND_GREGORIAN) then + calname = 'gregorian' + else if (calendar == ESMF_CALKIND_JULIAN) then + calname = 'julian' + else if (calendar == ESMF_CALKIND_JULIANDAY) then + calname = 'ESMF_CALKIND_JULIANDAY' + else if (calendar == ESMF_CALKIND_MODJULIANDAY) then + calname = 'ESMF_CALKIND_MODJULIANDAY' + else if (calendar == ESMF_CALKIND_NOCALENDAR) then + calname = 'none' + else if (calendar == ESMF_CALKIND_NOLEAP) then + calname = 'noleap' + end if + rcode = pio_put_att(io_file(lfile_ind), varid, 'calendar', trim(calname)) - if (present(tbnds)) then - dimid2(2) = dimid(1) - rcode = pio_put_att(io_file(lfile_ind),varid,'bounds','time_bnds') - rcode = pio_def_dim(io_file(lfile_ind),'ntb',2,dimid2(1)) - rcode = pio_def_var(io_file(lfile_ind),'time_bnds',PIO_DOUBLE,dimid2,varid) - endif - if (lwdata) call med_io_enddef(filename, file_ind=lfile_ind) - endif + ! define time bounds + dimid2(2) = dimid(1) + rcode = pio_def_dim(io_file(lfile_ind), 'ntb', 2, dimid2(1)) + rcode = pio_def_var(io_file(lfile_ind), 'time_bnds', PIO_DOUBLE, dimid2, varid) + rcode = pio_put_att(io_file(lfile_ind), varid, 'bounds', 'time_bnds') - ! Write out data - if (lwdata) then - start = 1 - count = 1 - if (present(nt)) then - start(1) = nt - endif - time_val_1d(1) = time_val - rcode = pio_inq_varid(io_file(lfile_ind),'time',varid) - rcode = pio_put_var(io_file(lfile_ind),varid,start,count,time_val_1d) - if (present(tbnds)) then - rcode = pio_inq_varid(io_file(lfile_ind),'time_bnds',varid) - start = 1 - count = 1 - if (present(nt)) then - start(2) = nt - endif - count(1) = 2 - rcode = pio_put_var(io_file(lfile_ind),varid,start,count,tbnds) - endif - endif + end subroutine med_io_define_time + + !=============================================================================== + subroutine med_io_write_time(time_val, tbnds, nt, file_ind, rc) + + !--------------- + ! Write time variable to netcdf file + !--------------- + + use pio, only : pio_put_att, pio_inq_varid, pio_put_var + + ! input/output variables + real(r8) , intent(in) :: time_val ! data to be written + real(r8) , intent(in) :: tbnds(2) ! time bounds + integer , intent(in) :: nt + integer , optional, intent(in) :: file_ind + integer , intent(out):: rc + + ! local variables + integer :: rcode + integer :: lfile_ind + integer :: varid + integer :: start(2),count(2) + character(*),parameter :: subName = '(med_io_write_time) ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + lfile_ind = 0 + if (present(file_ind)) lfile_ind=file_ind + + ! write time + count = 1; start = nt + rcode = pio_inq_varid(io_file(lfile_ind), 'time', varid) + rcode = pio_put_var(io_file(lfile_ind), varid, start(1:1), count(1:1), (/time_val/)) + + ! write time bounds + rcode = pio_inq_varid(io_file(lfile_ind), 'time_bnds', varid) + start(1) = 1; start(2) = nt + count(1) = 2; count(2) = 1 + rcode = pio_put_var(io_file(lfile_ind), varid, start(1:2), count(1:2), tbnds) end subroutine med_io_write_time !=============================================================================== - subroutine med_io_read_FB(filename, vm, iam, FB, pre, frame, rc) + subroutine med_io_read_FB(filename, vm, FB, pre, frame, rc) !--------------- ! Read FB from netcdf file @@ -1573,7 +1486,6 @@ subroutine med_io_read_FB(filename, vm, iam, FB, pre, frame, rc) ! input/output arguments character(len=*) ,intent(in) :: filename ! file type(ESMF_VM) ,intent(in) :: vm - integer ,intent(in) :: iam type(ESMF_FieldBundle) ,intent(in) :: FB ! data to be read character(len=*) ,optional ,intent(in) :: pre ! prefix to variable name integer(kind=PIO_OFFSET_KIND) ,optional ,intent(in) :: frame @@ -1640,13 +1552,13 @@ subroutine med_io_read_FB(filename, vm, iam, FB, pre, frame, rc) return endif - if (med_io_file_exists(vm, iam, trim(filename))) then + if (med_io_file_exists(vm, trim(filename))) then rcode = pio_openfile(io_subsystem, pioid, pio_iotype, trim(filename),pio_nowrite) call ESMF_LogWrite(trim(subname)//' open file '//trim(filename), ESMF_LOGMSG_INFO) if (chkerr(rc,__LINE__,u_FILE_u)) return else call ESMF_LogWrite(trim(subname)//' ERROR: file invalid '//trim(filename), & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) rc = ESMF_FAILURE return endif @@ -1826,16 +1738,12 @@ subroutine med_io_read_init_iodesc(FB, name1, pioid, iodesc, rc) write(tmpstr,*) trim(subname),' lny = ',lny call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) ng = lnx * lny - call FB_getFieldN(FB, 1, field, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, mesh=mesh, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_MeshGet(mesh, elementDistgrid=distgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_DistGridGet(distgrid, dimCount=dimCount, tileCount=tileCount, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -1843,8 +1751,6 @@ subroutine med_io_read_init_iodesc(FB, name1, pioid, iodesc, rc) call ESMF_DistGridGet(distgrid, minIndexPTile=minIndexPTile, & maxIndexPTile=maxIndexPTile, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - !write(tmpstr,*) subname,' counts = ',dimcount,tilecount,minindexptile,maxindexptile - !call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) if (ng > maxval(maxIndexPTile)) then write(tmpstr,*) subname,' WARNING: dimensions do not match', lnx, lny, maxval(maxIndexPTile) @@ -1872,7 +1778,7 @@ subroutine med_io_read_init_iodesc(FB, name1, pioid, iodesc, rc) end subroutine med_io_read_init_iodesc !=============================================================================== - subroutine med_io_read_int(filename, vm, iam, idata, dname, rc) + subroutine med_io_read_int(filename, vm, idata, dname, rc) !--------------- ! Read scalar integer from netcdf file @@ -1881,7 +1787,6 @@ subroutine med_io_read_int(filename, vm, iam, idata, dname, rc) ! input/output arguments character(len=*) , intent(in) :: filename ! file type(ESMF_VM) :: vm - integer , intent(in) :: iam integer , intent(inout) :: idata ! integer data character(len=*) , intent(in) :: dname ! name of data integer , intent(out) :: rc @@ -1892,14 +1797,14 @@ subroutine med_io_read_int(filename, vm, iam, idata, dname, rc) !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call med_io_read_int1d(filename, vm, iam, i1d, dname, rc) + call med_io_read_int1d(filename, vm, i1d, dname, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return idata = i1d(1) end subroutine med_io_read_int !=============================================================================== - subroutine med_io_read_int1d(filename, vm, iam, idata, dname, rc) + subroutine med_io_read_int1d(filename, vm, idata, dname, rc) !--------------- ! Read 1d integer array from netcdf file @@ -1913,7 +1818,6 @@ subroutine med_io_read_int1d(filename, vm, iam, idata, dname, rc) ! input/output arguments character(len=*), intent(in) :: filename ! file type(ESMF_VM) :: vm - integer, intent(in) :: iam integer , intent(inout) :: idata(:) ! integer data character(len=*), intent(in) :: dname ! name of data integer , intent(out) :: rc @@ -1924,6 +1828,7 @@ subroutine med_io_read_int1d(filename, vm, iam, idata, dname, rc) type(var_desc_t) :: varid character(CL) :: lversion character(CL) :: name1 + integer :: iam character(*),parameter :: subName = '(med_io_read_int1d) ' !------------------------------------------------------------------------------- @@ -1931,7 +1836,10 @@ subroutine med_io_read_int1d(filename, vm, iam, idata, dname, rc) lversion=trim(version) - if (med_io_file_exists(vm, iam, filename)) then + call ESMF_VMGet(vm, localPet=iam, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (med_io_file_exists(vm, filename)) then rcode = pio_openfile(io_subsystem, pioid, pio_iotype, trim(filename),pio_nowrite) call pio_seterrorhandling(pioid,PIO_BCAST_ERROR) rcode = pio_get_att(pioid,pio_global,"file_version",lversion) @@ -1955,7 +1863,7 @@ subroutine med_io_read_int1d(filename, vm, iam, idata, dname, rc) end subroutine med_io_read_int1d !=============================================================================== - subroutine med_io_read_r8(filename, vm, iam, rdata, dname, rc) + subroutine med_io_read_r8(filename, vm, rdata, dname, rc) !--------------- ! Read scalar double from netcdf file @@ -1964,7 +1872,6 @@ subroutine med_io_read_r8(filename, vm, iam, rdata, dname, rc) ! input/output arguments character(len=*) , intent(in) :: filename ! file type(ESMF_VM) :: vm - integer , intent(in) :: iam real(r8) , intent(inout) :: rdata ! real data character(len=*) , intent(in) :: dname ! name of data integer , intent(out) :: rc @@ -1975,7 +1882,7 @@ subroutine med_io_read_r8(filename, vm, iam, rdata, dname, rc) !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call med_io_read_r81d(filename, vm, iam, r1d,dname, rc) + call med_io_read_r81d(filename, vm, r1d,dname, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return rdata = r1d(1) @@ -1983,7 +1890,7 @@ subroutine med_io_read_r8(filename, vm, iam, rdata, dname, rc) end subroutine med_io_read_r8 !=============================================================================== - subroutine med_io_read_r81d(filename, vm, iam, rdata, dname, rc) + subroutine med_io_read_r81d(filename, vm, rdata, dname, rc) !--------------- ! Read 1d double array from netcdf file @@ -1996,7 +1903,6 @@ subroutine med_io_read_r81d(filename, vm, iam, rdata, dname, rc) ! input/output arguments character(len=*), intent(in) :: filename ! file type(ESMF_VM) :: vm - integer , intent(in) :: iam real(r8) , intent(inout) :: rdata(:) ! real data character(len=*), intent(in) :: dname ! name of data integer , intent(out) :: rc @@ -2007,6 +1913,7 @@ subroutine med_io_read_r81d(filename, vm, iam, rdata, dname, rc) type(var_desc_t) :: varid character(CL) :: lversion character(CL) :: name1 + integer :: iam character(*),parameter :: subName = '(med_io_read_r81d) ' !------------------------------------------------------------------------------- @@ -2014,7 +1921,10 @@ subroutine med_io_read_r81d(filename, vm, iam, rdata, dname, rc) lversion=trim(version) - if (med_io_file_exists(vm, iam, filename)) then + call ESMF_VMGet(vm, localPet=iam, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (med_io_file_exists(vm, filename)) then rcode = pio_openfile(io_subsystem, pioid, pio_iotype, trim(filename),pio_nowrite) call pio_seterrorhandling(pioid,PIO_BCAST_ERROR) rcode = pio_get_att(pioid,pio_global,"file_version",lversion) @@ -2038,7 +1948,7 @@ subroutine med_io_read_r81d(filename, vm, iam, rdata, dname, rc) end subroutine med_io_read_r81d !=============================================================================== - subroutine med_io_read_char(filename, vm, iam, rdata, dname, rc) + subroutine med_io_read_char(filename, vm, rdata, dname, rc) !--------------- ! Read char string from netcdf file @@ -2051,7 +1961,6 @@ subroutine med_io_read_char(filename, vm, iam, rdata, dname, rc) ! input/output arguments character(len=*), intent(in) :: filename ! file type(ESMF_VM) :: vm - integer, intent(in) :: iam character(len=*), intent(inout) :: rdata ! character data character(len=*), intent(in) :: dname ! name of data integer , intent(out) :: rc @@ -2062,6 +1971,7 @@ subroutine med_io_read_char(filename, vm, iam, rdata, dname, rc) type(var_desc_t) :: varid character(CL) :: lversion character(CL) :: name1 + integer :: iam character(CL) :: charvar ! buffer for string read/write character(*),parameter :: subName = '(med_io_read_char) ' !------------------------------------------------------------------------------- @@ -2070,7 +1980,10 @@ subroutine med_io_read_char(filename, vm, iam, rdata, dname, rc) lversion=trim(version) - if (med_io_file_exists(vm, iam, filename)) then + call ESMF_VMGet(vm, localPet=iam, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (med_io_file_exists(vm, filename)) then rcode = pio_openfile(io_subsystem, pioid, pio_iotype, trim(filename),pio_nowrite) ! write(logunit,*) subname,' open file ',trim(filename) call pio_seterrorhandling(pioid,PIO_BCAST_ERROR) diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 897341956..41b1931f2 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 + ! initialize 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(:) + type(ESMF_Field) :: field_src + character(len=CX) :: mapfile + integer :: mapindex + logical :: mapexists = .false. + real(R8), pointer :: dataptr(:) + 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 @@ -257,9 +364,9 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, integer :: srcMaskValue integer :: dstMaskValue character(len=ESMF_MAXSTR) :: lmapfile - logical :: rhprint = .false. + logical :: rhprint = .false., ldstprint = .false. integer :: ns - integer(I4), pointer :: dof(:) => null() + integer(I4), pointer :: dof(:) integer :: srcTermProcessing_Value = 0 type(ESMF_PoleMethod_Flag), parameter :: polemethod=ESMF_POLEMETHOD_ALLAVG character(len=*), parameter :: subname=' (module_med_map: med_map_routehandles_initfrom_field) ' @@ -278,6 +385,8 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, if (chkerr(rc,__LINE__,u_FILE_u)) return dststatusfield = ESMF_FieldCreate(dstmesh, ESMF_TYPEKIND_I4, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + ! set local flag to false + ldstprint = .false. if (trim(coupling_mode) == 'cesm') then dstMaskValue = ispval_mask @@ -357,6 +466,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, dstStatusField=dststatusfield, & unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + ldstprint = .true. end if else if (mapindex == mapfillv_bilnr) then if (mastertask) then @@ -372,6 +482,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, dstStatusField=dststatusfield, & unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + ldstprint = .true. else if (mapindex == mapbilnr_nstod) then if (mastertask) then write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//' for '//trim(string) @@ -387,6 +498,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, dstStatusField=dststatusfield, & unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + ldstprint = .true. else if (mapindex == mapconsf .or. mapindex == mapnstod_consf) then if (mastertask) then write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//' for '//trim(string) @@ -402,6 +514,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + ldstprint = .true. else if (mapindex == mapconsf_aofrac) then if (.not. ESMF_RouteHandleIsCreated(routehandles(mapconsf))) then if (mastertask) then @@ -418,6 +531,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + ldstprint = .true. else ! Copy existing consf RH if (mastertask) then @@ -441,6 +555,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + ldstprint = .true. else if (mapindex == mappatch .or. mapindex == mappatch_uv3d) then if (.not. ESMF_RouteHandleIsCreated(routehandles(mappatch))) then if (mastertask) then @@ -456,6 +571,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, dstStatusField=dststatusfield, & unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + ldstprint = .true. end if else if (mastertask) then @@ -468,30 +584,28 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, end if ! Output destination status field to file if requested - if (dststatus_print) then - if (mapindex /= mapfcopy .or. lmapfile /= 'unset') then - fname = 'dststatus.'//trim(compname(n1))//'.'//trim(compname(n2))//'.'//trim(mapname)//'.nc' - call ESMF_LogWrite(trim(subname)//": writing dstStatusField to "//trim(fname), ESMF_LOGMSG_INFO) - - call ESMF_FieldWrite(dststatusfield, filename=trim(fname), variableName='dststatus', & - overwrite=.true., rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! the sequence index in order to sort the dststatus field - call ESMF_MeshGet(dstmesh, elementDistgrid=distgrid, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_DistGridGet(distgrid, localDE=0, elementCount=ns, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - allocate(dof(ns)) - call ESMF_DistGridGet(distgrid, localDE=0, seqIndexList=dof, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - doffield = ESMF_FieldCreate(dstmesh, dof, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldWrite(doffield, fileName='dof.'//trim(compname(n2))//'.nc', variableName='dof', & - overwrite=.true., rc=rc) - deallocate(dof) - call ESMF_FieldDestroy(doffield, rc=rc, noGarbage=.true.) - end if + if (dststatus_print .and. ldstprint) then + fname = 'dststatus.'//trim(compname(n1))//'.'//trim(compname(n2))//'.'//trim(mapname)//'.nc' + call ESMF_LogWrite(trim(subname)//": writing dstStatusField to "//trim(fname), ESMF_LOGMSG_INFO) + + call ESMF_FieldWrite(dststatusfield, filename=trim(fname), variableName='dststatus', & + overwrite=.true., rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! the sequence index in order to sort the dststatus field + call ESMF_MeshGet(dstmesh, elementDistgrid=distgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_DistGridGet(distgrid, localDE=0, elementCount=ns, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(dof(ns)) + call ESMF_DistGridGet(distgrid, localDE=0, seqIndexList=dof, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + doffield = ESMF_FieldCreate(dstmesh, dof, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldWrite(doffield, fileName='dof.'//trim(compname(n2))//'.nc', variableName='dof', & + overwrite=.true., rc=rc) + deallocate(dof) + call ESMF_FieldDestroy(doffield, rc=rc, noGarbage=.true.) end if ! consd_nstod method requires a second routehandle @@ -506,9 +620,10 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + ldstprint = .true. ! Output destination status field to file if requested - if (dststatus_print) then + if (dststatus_print .and. ldstprint) then fname = 'dststatus.'//trim(compname(n1))//'.'//trim(compname(n2))//'.'//trim(mapname)//'_2.nc' call ESMF_LogWrite(trim(subname)//": writing dstStatusField to "//trim(fname), ESMF_LOGMSG_INFO) @@ -517,14 +632,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 +717,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) @@ -768,15 +741,15 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & integer :: fieldcount type(ESMF_Field) :: lfield integer :: ungriddedUBound(1) ! currently the size must equal 1 for rank 2 fields - real(r8), pointer :: ptrsrc_packed(:,:) => null() - real(r8), pointer :: ptrdst_packed(:,:) => null() + real(r8), pointer :: ptrsrc_packed(:,:) + real(r8), pointer :: ptrdst_packed(:,:) integer :: lsize_src integer :: lsize_dst type(ESMF_Mesh) :: lmesh_src type(ESMF_Mesh) :: lmesh_dst integer :: mapindex - type(ESMF_Field), pointer :: fieldlist_src(:) => null() - type(ESMF_Field), pointer :: fieldlist_dst(:) => null() + type(ESMF_Field), pointer :: fieldlist_src(:) + type(ESMF_Field), pointer :: fieldlist_dst(:) character(CL), allocatable :: fieldNameList(:) character(CS) :: mapnorm_mapindex character(len=CX) :: tmpstr @@ -928,8 +901,10 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & packed_data(mapindex)%field_fracsrc = ESMF_FieldCreate(lmesh_src, ESMF_TYPEKIND_R8, & meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return packed_data(mapindex)%field_fracdst = ESMF_FieldCreate(lmesh_dst, ESMF_TYPEKIND_R8, & meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return end if end do ! end loop over mapindex @@ -968,17 +943,17 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, field_normOne, packed_d integer :: fieldcount integer :: mapindex integer :: ungriddedUBound(1) - real(r8), pointer :: dataptr1d(:) => null() - real(r8), pointer :: dataptr2d(:,:) => null() - real(r8), pointer :: dataptr2d_packed(:,:) => null() + real(r8), pointer :: dataptr1d(:) + real(r8), pointer :: dataptr2d(:,:) + real(r8), pointer :: dataptr2d_packed(:,:) type(ESMF_Field) :: lfield type(ESMF_Field) :: field_fracsrc - type(ESMF_Field), pointer :: fieldlist_src(:) => null() - type(ESMF_Field), pointer :: fieldlist_dst(:) => null() + type(ESMF_Field), pointer :: fieldlist_src(:) + type(ESMF_Field), pointer :: fieldlist_dst(:) type(ESMF_Field) :: usrc, vsrc ! only used for 3d mapping of u,v type(ESMF_Field) :: udst, vdst ! only used for 3d mapping of u,v - real(r8), pointer :: data_norm(:) => null() - real(r8), pointer :: data_dst(:,:) => null() + real(r8), pointer :: data_norm(:) + real(r8), pointer :: data_dst(:,:) character(len=*), parameter :: subname=' (module_MED_map:med_map_field_packed) ' !----------------------------------------------------------- @@ -1082,6 +1057,7 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, field_normOne, packed_d maptype=mapindex, & field_normsrc=field_fracsrc, & field_normdst=packed_data(mapindex)%field_fracdst, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return else if ( trim(packed_data(mapindex)%mapnorm) == 'one' .or. trim(packed_data(mapindex)%mapnorm) == 'none') then @@ -1179,14 +1155,14 @@ subroutine med_map_field_normalized(field_src, field_dst, routehandles, maptype, ! local variables integer :: n - real(r8), pointer :: data_src2d(:,:) => null() - real(r8), pointer :: data_dst2d(:,:) => null() - real(r8), pointer :: data_srctmp2d(:,:) => null() - real(r8), pointer :: data_src1d(:) => null() - real(r8), pointer :: data_dst1d(:) => null() - real(r8), pointer :: data_srctmp1d(:) => null() - real(r8), pointer :: data_normsrc(:) => null() - real(r8), pointer :: data_normdst(:) => null() + real(r8), pointer :: data_src2d(:,:) + real(r8), pointer :: data_dst2d(:,:) + real(r8), pointer :: data_srctmp2d(:,:) + real(r8), pointer :: data_src1d(:) + real(r8), pointer :: data_dst1d(:) + real(r8), pointer :: data_srctmp1d(:) + real(r8), pointer :: data_normsrc(:) + real(r8), pointer :: data_normdst(:) integer :: ungriddedUBound(1) ! currently the size must equal 1 for rank 2 fields integer :: lsize_src integer :: lsize_dst @@ -1394,14 +1370,14 @@ subroutine med_map_uv_cart3d(FBsrc, FBdst, routehandles, mapindex, rc) real(r8) :: ux,uy,uz type(ESMF_Mesh) :: lmesh_src type(ESMF_Mesh) :: lmesh_dst - real(r8), pointer :: data_u_src(:) => null() - real(r8), pointer :: data_u_dst(:) => null() - real(r8), pointer :: data_v_src(:) => null() - real(r8), pointer :: data_v_dst(:) => null() - real(r8), pointer :: data2d_src(:,:) => null() - real(r8), pointer :: data2d_dst(:,:) => null() - real(r8), pointer :: ownedElemCoords_src(:) => null() - real(r8), pointer :: ownedElemCoords_dst(:) => null() + real(r8), pointer :: data_u_src(:) + real(r8), pointer :: data_u_dst(:) + real(r8), pointer :: data_v_src(:) + real(r8), pointer :: data_v_dst(:) + real(r8), pointer :: data2d_src(:,:) + real(r8), pointer :: data2d_dst(:,:) + real(r8), pointer :: ownedElemCoords_src(:) + real(r8), pointer :: ownedElemCoords_dst(:) integer :: numOwnedElements integer :: spatialDim real(r8), parameter :: deg2rad = shr_const_pi/180.0_R8 ! deg to rads diff --git a/mediator/med_merge_mod.F90 b/mediator/med_merge_mod.F90 index 3d0d6bbd4..c226b1ab9 100644 --- a/mediator/med_merge_mod.F90 +++ b/mediator/med_merge_mod.F90 @@ -7,8 +7,6 @@ module med_merge_mod 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 : logunit use med_constants_mod , only : dbug_flag => med_constants_dbug_flag - use med_constants_mod , only : spval_init => med_constants_spval_init - use med_constants_mod , only : spval => med_constants_spval use med_constants_mod , only : czero => med_constants_czero use med_utils_mod , only : ChkErr => med_utils_ChkErr use med_methods_mod , only : FB_FldChk => med_methods_FB_FldChk @@ -25,6 +23,11 @@ module med_merge_mod public :: med_merge_auto public :: med_merge_field + interface med_merge_auto ; module procedure & + med_merge_auto_single_fldbun, & + med_merge_auto_multi_fldbuns + end interface + interface med_merge_field ; module procedure & med_merge_field_1D end interface @@ -38,25 +41,22 @@ module med_merge_mod contains !=============================================================================== - subroutine med_merge_auto(compout, coupling_active, FBOut, FBfrac, FBImp, fldListTo, & - FBMed1, FBMed2, rc) + subroutine med_merge_auto_multi_fldbuns(coupling_active, FBOut, FBfrac, FBImp, fldListTo, FBMed1, FBMed2, rc) use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleIsCreated, ESMF_FieldBundleGet use ESMF , only : ESMF_Field, ESMF_FieldGet use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LOGMSG_ERROR - use ESMF , only : ESMF_LogSetError, ESMF_RC_OBJ_NOT_CREATED + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LOGMSG_ERROR, ESMF_LogSetError ! ---------------------------------------------- ! Auto merge based on fldListTo info ! ---------------------------------------------- ! input/output variables - integer , intent(in) :: compout ! component index for FBOut logical , intent(in) :: coupling_active(:) ! true => coupling is active type(ESMF_FieldBundle) , intent(inout) :: FBOut ! Merged output field bundle type(ESMF_FieldBundle) , intent(inout) :: FBfrac ! Fraction data for FBOut - type(ESMF_FieldBundle) , intent(in) :: FBImp(:) ! Array of field bundles each mapping to the FBOut mesh + type(ESMF_FieldBundle) , intent(in) :: FBImp(:) ! Array of field bundles each mapping to the FBOut mesh type(med_fldList_type) , intent(in) :: fldListTo ! Information for merging type(ESMF_FieldBundle) , intent(in) , optional :: FBMed1 ! mediator field bundle type(ESMF_FieldBundle) , intent(in) , optional :: FBMed2 ! mediator field bundle @@ -75,13 +75,11 @@ subroutine med_merge_auto(compout, coupling_active, FBOut, FBfrac, FBImp, fldLis logical :: error_check = .false. ! TODO: make this an input argument integer :: ungriddedUBound_out(1) ! size of ungridded dimension integer :: fieldcount - character(CL) , pointer :: fieldnamelist(:) => null() - type(ESMF_Field), pointer :: fieldlist(:) => null() - real(r8), pointer :: dataptr1d(:) => null() - real(r8), pointer :: dataptr2d(:,:) => null() - character(CL) :: msg + character(CL) , pointer :: fieldnamelist(:) + type(ESMF_Field), pointer :: fieldlist(:) + real(r8), pointer :: dataptr1d(:) + real(r8), pointer :: dataptr2d(:,:) logical :: zero_output - character(CL) :: fldname character(len=*),parameter :: subname=' (module_med_merge_mod: med_merge_auto)' !--------------------------------------- @@ -136,12 +134,10 @@ subroutine med_merge_auto(compout, coupling_active, FBOut, FBfrac, FBImp, fldLis call med_fldList_GetFldInfo(fldListTo, nfld_in, compsrc, merge_fields, merge_type, merge_fracname) if (merge_type /= 'unset' .and. merge_field /= 'unset') then - ! If merge_field is a colon delimited string then cycle through every field - otherwise by default nm ! will only equal 1 num_merge_colon_fields = merge_listGetNum(merge_fields) do nm = 1,num_merge_colon_fields - ! Determine merge field name from source field if (num_merge_fields == 1) then merge_field = trim(merge_fields) @@ -207,7 +203,139 @@ subroutine med_merge_auto(compout, coupling_active, FBOut, FBfrac, FBImp, fldLis call t_stopf('MED:'//subname) - end subroutine med_merge_auto + end subroutine med_merge_auto_multi_fldbuns + + !=============================================================================== + subroutine med_merge_auto_single_fldbun(compsrc, FBOut, FBfrac, FBIn, fldListTo, rc) + + ! ---------------------------------------------- + ! Auto merge from one import field bundle based on fldListTo info. + ! Want to loop over all of the fields in FBout here - and find the + ! corresponding index in fldListTo for that field name - then call + ! the corresponding merge routine below appropriately. + ! ---------------------------------------------- + + use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleIsCreated, ESMF_FieldBundleGet + use ESMF , only : ESMF_Field, ESMF_FieldGet + use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LOGMSG_ERROR + use ESMF , only : ESMF_LogSetError + + ! input/output variables + integer , intent(in) :: compsrc + type(ESMF_FieldBundle) , intent(inout) :: FBOut ! Merged output field bundle + type(ESMF_FieldBundle) , intent(inout) :: FBfrac ! Fraction data for FBOut + type(ESMF_FieldBundle) , intent(in) :: FBIn ! Single field bundle to merge to the FBOut mesh + type(med_fldList_type) , intent(in) :: fldListTo ! Information for merging + integer , intent(out) :: rc + + ! local variables + integer :: nfld_out,nfld_in,nm + integer :: num_merge_fields + integer :: num_merge_colon_fields + character(CL) :: merge_fields + character(CL) :: merge_field + character(CS) :: merge_type + character(CS) :: merge_fracname + character(CS), allocatable :: merge_field_names(:) + integer :: ungriddedUBound_out(1) ! size of ungridded dimension + integer :: fieldcount + character(CL) , pointer :: fieldnamelist(:) + type(ESMF_Field), pointer :: fieldlist(:) + real(r8), pointer :: dataptr1d(:) + real(r8), pointer :: dataptr2d(:,:) + logical :: zero_output + character(len=*),parameter :: subname=' (module_med_merge_mod: med_merge_auto)' + !--------------------------------------- + + call t_startf('MED:'//subname) + + rc = ESMF_SUCCESS + + if (dbug_flag > 1) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + rc = ESMF_SUCCESS + end if + + call ESMF_FieldBundleGet(FBOut, fieldCount=fieldcount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(fieldnamelist(fieldcount)) + allocate(fieldlist(fieldcount)) + call ESMF_FieldBundleGet(FBOut, fieldnamelist=fieldnamelist, fieldlist=fieldlist, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + num_merge_fields = med_fldList_GetNumFlds(fldListTo) + allocate(merge_field_names(num_merge_fields)) + do nfld_in = 1,num_merge_fields + call med_fldList_GetFldInfo(fldListTo, nfld_in, merge_field_names(nfld_in)) + end do + + ! Loop over all fields in output field bundle FBOut + do nfld_out = 1,fieldcount + zero_output = .true. + + ! Loop over the field in fldListTo to get fieldname and merging type + do nfld_in = 1,med_fldList_GetNumFlds(fldListTo) + + if (trim(merge_field_names(nfld_in)) == trim(fieldnamelist(nfld_out))) then + + ! Loop over all possible source components in the merging arrays returned from the above call + ! If the merge field name from the source components is not set, then simply go to the next component + + ! Determine the merge information for the import field + call med_fldList_GetFldInfo(fldListTo, nfld_in, compsrc, merge_fields, merge_type, merge_fracname) + + if (merge_type /= 'unset' .and. merge_field /= 'unset') then + + ! If merge_field is a colon delimited string then cycle through every field - otherwise by default nm + ! will only equal 1 + num_merge_colon_fields = merge_listGetNum(merge_fields) + do nm = 1,num_merge_colon_fields + ! Determine merge field name from source field + if (num_merge_fields == 1) then + merge_field = trim(merge_fields) + else + call merge_listGetName(merge_fields, nm, merge_field, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + ! Initialize initial output field data to zero before doing merge + if (zero_output) then + call ESMF_FieldGet(fieldlist(nfld_out), ungriddedUBound=ungriddedUbound_out, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (ungriddedUBound_out(1) > 0) then + call ESMF_FieldGet(fieldlist(nfld_out), farrayPtr=dataptr2d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + dataptr2d(:,:) = czero + else + call ESMF_FieldGet(fieldlist(nfld_out), farrayPtr=dataptr1d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + dataptr1d(:) = czero + end if + zero_output = .false. + end if + + ! Perform merge + call med_merge_auto_field(trim(merge_type), fieldlist(nfld_out), ungriddedUBound_out, & + FB=FBIn, FBFld=merge_field, FBw=FBfrac, fldw=trim(merge_fracname), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + end do ! end of nm loop + end if ! end of check of merge_type and merge_field not unset + end if ! end of check if stdname and fldname are the same + end do ! end of loop over fldsListTo + end do ! end of loop over fields in FBOut + + deallocate(fieldnamelist) + deallocate(fieldlist) + + if (dbug_flag > 1) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + end if + + call t_stopf('MED:'//subname) + + end subroutine med_merge_auto_single_fldbun !=============================================================================== subroutine med_merge_auto_field(merge_type, field_out, ungriddedUBound_out, & @@ -232,11 +360,11 @@ subroutine med_merge_auto_field(merge_type, field_out, ungriddedUBound_out, & integer :: n type(ESMF_Field) :: field_wgt type(ESMF_Field) :: field_in - real(R8), pointer :: dp1 (:) => null() - real(R8), pointer :: dp2(:,:) => null() ! output pointers to 1d and 2d fields - real(R8), pointer :: dpf1(:) => null() - real(R8), pointer :: dpf2(:,:) => null() ! intput pointers to 1d and 2d fields - real(R8), pointer :: dpw1(:) => null() ! weight pointer + real(R8), pointer :: dp1 (:) + real(R8), pointer :: dp2(:,:) ! output pointers to 1d and 2d fields + real(R8), pointer :: dpf1(:) + real(R8), pointer :: dpf2(:,:) ! intput pointers to 1d and 2d fields + real(R8), pointer :: dpw1(:) ! weight pointer character(len=*),parameter :: subname=' (med_merge_mod: med_merge_auto_field)' !--------------------------------------- @@ -439,9 +567,9 @@ subroutine med_merge_field_1D(FBout, fnameout, & integer , intent(out) :: rc ! local variables - real(R8), pointer :: dataOut(:) => null() - real(R8), pointer :: dataPtr(:) => null() - real(R8), pointer :: wgt(:) => null() + real(R8), pointer :: dataOut(:) + real(R8), pointer :: dataPtr(:) + real(R8), pointer :: wgt(:) integer :: lb1,ub1,i,j,n logical :: wgtfound, FBinfound integer :: dbrc diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index fc9e55e97..f25b024cd 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -19,14 +19,6 @@ module med_methods_mod implicit none private - interface med_methods_FB_accum ; module procedure & - med_methods_FB_accumFB2FB - end interface - - interface med_methods_FB_copy ; module procedure & - med_methods_FB_copyFB2FB - end interface - interface med_methods_FieldPtr_compare ; module procedure & med_methods_FieldPtr_compare1, & med_methods_FieldPtr_compare2 @@ -76,8 +68,6 @@ module med_methods_mod private med_methods_Mesh_Print private med_methods_Grid_Print private med_methods_Field_GetFldPtr - private med_methods_FB_copyFB2FB - private med_methods_FB_accumFB2FB private med_methods_Array_diagnose !----------------------------------------------------------------------------- @@ -116,8 +106,8 @@ subroutine med_methods_FB_init_pointer(StateIn, FBout, flds_scalar_name, name, r integer :: ungriddedLBound(1) integer :: ungriddedUBound(1) integer :: gridToFieldMap(1) - real(R8), pointer :: dataptr1d(:) => null() - real(R8), pointer :: dataptr2d(:,:) => null() + real(R8), pointer :: dataptr1d(:) + real(R8), pointer :: dataptr2d(:,:) character(ESMF_MAXSTR), allocatable :: lfieldNameList(:) character(len=*), parameter :: subname='(med_methods_FB_init_pointer)' ! ---------------------------------------------- @@ -178,8 +168,10 @@ subroutine med_methods_FB_init_pointer(StateIn, FBout, flds_scalar_name, name, r ! set ungridded dimensions and GridToFieldMap for field call ESMF_AttributeGet(lfield, name="UngriddedLBound", convention="NUOPC", & purpose="Instance", valueList=ungriddedLBound, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_AttributeGet(lfield, name="UngriddedUBound", convention="NUOPC", & purpose="Instance", valueList=ungriddedUBound, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_AttributeGet(lfield, name="GridToFieldMap", convention="NUOPC", & purpose="Instance", valueList=gridToFieldMap, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -474,8 +466,10 @@ subroutine med_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBgeom, S allocate(ungriddedLBound(ungriddedCount), ungriddedUBound(ungriddedCount)) call ESMF_AttributeGet(lfield, name="UngriddedLBound", convention="NUOPC", & purpose="Instance", valueList=ungriddedLBound, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_AttributeGet(lfield, name="UngriddedUBound", convention="NUOPC", & purpose="Instance", valueList=ungriddedUBound, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_AttributeGet(lfield, name="GridToFieldMap", convention="NUOPC", & purpose="Instance", itemCount=gridToFieldMapCount, rc=rc) @@ -545,7 +539,7 @@ subroutine med_methods_FB_getNameN(FB, fieldnum, fieldname, rc) ! local variables integer :: fieldCount - character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) => null() + character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) character(len=*),parameter :: subname='(med_methods_FB_getNameN)' ! ---------------------------------------------- @@ -629,7 +623,7 @@ subroutine med_methods_State_getNameN(State, fieldnum, fieldname, rc) ! local variables integer :: fieldCount - character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) => null() + character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) character(len=*),parameter :: subname='(med_methods_State_getNameN)' ! ---------------------------------------------- @@ -676,8 +670,7 @@ subroutine med_methods_State_getNumFields(State, fieldnum, rc) ! local variables integer :: n,itemCount - type(ESMF_Field), pointer :: fieldList(:) => null() - type(ESMF_StateItem_Flag), pointer :: itemTypeList(:) => null() + type(ESMF_Field), pointer :: fieldList(:) character(len=*),parameter :: subname='(med_methods_State_getNumFields)' ! ---------------------------------------------- @@ -719,12 +712,12 @@ subroutine med_methods_FB_reset(FB, value, rc) ! local variables integer :: i,j,n integer :: fieldCount - character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) => null() + character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) real(R8) :: lvalue type(ESMF_Field) :: lfield integer :: lrank - real(R8), pointer :: fldptr1(:) => null() - real(R8), pointer :: fldptr2(:,:) => null() + real(R8), pointer :: fldptr1(:) + real(R8), pointer :: fldptr2(:,:) character(len=*),parameter :: subname='(med_methods_FB_reset)' ! ---------------------------------------------- @@ -797,12 +790,12 @@ subroutine med_methods_State_reset(State, value, rc) ! local variables integer :: i,j,n integer :: fieldCount - character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) => null() + character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) real(R8) :: lvalue type(ESMF_Field) :: lfield integer :: lrank - real(R8), pointer :: fldptr1(:) => null() - real(R8), pointer :: fldptr2(:,:) => null() + real(R8), pointer :: fldptr1(:) + real(R8), pointer :: fldptr2(:,:) character(len=*),parameter :: subname='(med_methods_State_reset)' ! ---------------------------------------------- @@ -865,9 +858,9 @@ subroutine med_methods_FB_average(FB, count, rc) ! local variables integer :: i,j,n integer :: fieldCount, lrank - character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) => null() - real(R8), pointer :: dataPtr1(:) => null() - real(R8), pointer :: dataPtr2(:,:) => null() + character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) + real(R8), pointer :: dataPtr1(:) + real(R8), pointer :: dataPtr2(:,:) type(ESMF_Field) :: lfield character(len=*),parameter :: subname='(med_methods_FB_average)' ! ---------------------------------------------- @@ -943,10 +936,10 @@ subroutine med_methods_FB_diagnose(FB, string, rc) ! local variables integer :: i,j,n integer :: fieldCount, lrank - character(ESMF_MAXSTR), pointer :: lfieldnamelist(:) => null() + character(ESMF_MAXSTR), pointer :: lfieldnamelist(:) character(len=CL) :: lstring - real(R8), pointer :: dataPtr1d(:) => null() - real(R8), pointer :: dataPtr2d(:,:) => null() + real(R8), pointer :: dataPtr1d(:) + real(R8), pointer :: dataPtr2d(:,:) type(ESMF_Field) :: lfield character(len=*), parameter :: subname='(med_methods_FB_diagnose)' ! ---------------------------------------------- @@ -1027,7 +1020,7 @@ subroutine med_methods_Array_diagnose(array, string, rc) ! local variables character(len=CS) :: lstring - real(R8), pointer :: dataPtr3d(:,:,:) => null() + real(R8), pointer :: dataPtr3d(:,:,:) character(len=*),parameter :: subname='(med_methods_Array_diagnose)' ! ---------------------------------------------- @@ -1077,10 +1070,10 @@ subroutine med_methods_State_diagnose(State, string, rc) ! local variables integer :: i,j,n integer :: fieldCount, lrank - character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) => null() + character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) character(len=CS) :: lstring - real(R8), pointer :: dataPtr1d(:) => null() - real(R8), pointer :: dataPtr2d(:,:) => null() + real(R8), pointer :: dataPtr1d(:) + real(R8), pointer :: dataPtr2d(:,:) type(ESMF_Field) :: lfield character(len=*),parameter :: subname='(med_methods_State_diagnose)' ! ---------------------------------------------- @@ -1160,8 +1153,8 @@ subroutine med_methods_FB_Field_diagnose(FB, fieldname, string, rc) ! local variables integer :: lrank character(len=CS) :: lstring - real(R8), pointer :: dataPtr1d(:) => null() - real(R8), pointer :: dataPtr2d(:,:) => null() + real(R8), pointer :: dataPtr1d(:) + real(R8), pointer :: dataPtr2d(:,:) type(ESMF_Field) :: lfield integer :: ungriddedUBound(1) ! currently the size must equal 1 for rank 2 fields character(len=*),parameter :: subname='(med_methods_FB_Field_diagnose)' @@ -1227,8 +1220,8 @@ subroutine med_methods_Field_diagnose(field, fieldname, string, rc) ! local variables integer :: lrank character(len=CS) :: lstring - real(R8), pointer :: dataPtr1d(:) => null() - real(R8), pointer :: dataPtr2d(:,:) => null() + real(R8), pointer :: dataPtr1d(:) + real(R8), pointer :: dataPtr2d(:,:) character(len=*),parameter :: subname='(med_methods_Field_diagnose)' ! ---------------------------------------------- @@ -1280,7 +1273,7 @@ end subroutine med_methods_Field_diagnose !----------------------------------------------------------------------------- - subroutine med_methods_FB_copyFB2FB(FBout, FBin, rc) + subroutine med_methods_FB_copy(FBout, FBin, rc) ! ---------------------------------------------- ! Copy common field names from FBin to FBout @@ -1291,7 +1284,7 @@ subroutine med_methods_FB_copyFB2FB(FBout, FBin, rc) type(ESMF_FieldBundle), intent(inout) :: FBout type(ESMF_FieldBundle), intent(in) :: FBin integer , intent(out) :: rc - character(len=*), parameter :: subname='(med_methods_FB_copyFB2FB)' + character(len=*), parameter :: subname='(med_methods_FB_copy)' ! ---------------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -1304,11 +1297,11 @@ subroutine med_methods_FB_copyFB2FB(FBout, FBin, rc) call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif - end subroutine med_methods_FB_copyFB2FB + end subroutine med_methods_FB_copy !----------------------------------------------------------------------------- - subroutine med_methods_FB_accumFB2FB(FBout, FBin, copy, rc) + subroutine med_methods_FB_accum(FBout, FBin, copy, rc) ! ---------------------------------------------- ! Accumulate common field names from FBin to FBout @@ -1326,15 +1319,15 @@ subroutine med_methods_FB_accumFB2FB(FBout, FBin, copy, rc) ! local variables integer :: i,j,n integer :: fieldCount, lranki, lranko - character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) => null() + character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) logical :: exists logical :: lcopy - real(R8), pointer :: dataPtri1(:) => null() - real(R8), pointer :: dataPtro1(:) => null() - real(R8), pointer :: dataPtri2(:,:) => null() - real(R8), pointer :: dataPtro2(:,:) => null() + real(R8), pointer :: dataPtri1(:) + real(R8), pointer :: dataPtro1(:) + real(R8), pointer :: dataPtri2(:,:) + real(R8), pointer :: dataPtro2(:,:) type(ESMF_Field) :: lfield - character(len=*), parameter :: subname='(med_methods_FB_accumFB2FB)' + character(len=*), parameter :: subname='(med_methods_FB_accum)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -1427,7 +1420,7 @@ subroutine med_methods_FB_accumFB2FB(FBout, FBin, copy, rc) call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif - end subroutine med_methods_FB_accumFB2FB + end subroutine med_methods_FB_accum !----------------------------------------------------------------------------- @@ -1755,7 +1748,7 @@ subroutine med_methods_State_GeomPrint(state, string, rc) ! local variables type(ESMF_Field) :: lfield integer :: fieldcount - character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) => null() + character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) character(ESMF_MAXSTR) :: name character(len=*),parameter :: subname='(med_methods_State_GeomPrint)' ! ---------------------------------------------- @@ -1840,8 +1833,8 @@ subroutine med_methods_Field_GeomPrint(field, string, rc) type(ESMF_Grid) :: lgrid type(ESMF_Mesh) :: lmesh integer :: lrank - real(R8), pointer :: dataPtr1(:) => null() - real(R8), pointer :: dataPtr2(:,:) => null() + real(R8), pointer :: dataPtr1(:) + real(R8), pointer :: dataPtr2(:,:) type(ESMF_GeomType_Flag) :: geomtype character(len=*),parameter :: subname='(med_methods_Field_GeomPrint)' ! ---------------------------------------------- @@ -2084,10 +2077,10 @@ subroutine med_methods_Grid_Print(grid, string, rc) type(ESMF_TypeKind_Flag) :: coordTypeKind character(len=32) :: staggerstr integer, allocatable :: minIndexPTile(:,:), maxIndexPTile(:,:) - real, pointer :: fldptrR41D(:) => null() - real, pointer :: fldptrR42D(:,:) => null() - real(R8), pointer :: fldptrR81D(:) => null() - real(R8), pointer :: fldptrR82D(:,:) => null() + real, pointer :: fldptrR41D(:) + real, pointer :: fldptrR42D(:,:) + real(R8), pointer :: fldptrR81D(:) + real(R8), pointer :: fldptrR82D(:,:) integer :: n1,n2,n3 character(len=*),parameter :: subname='(med_methods_Grid_Print)' ! ---------------------------------------------- @@ -2286,7 +2279,7 @@ subroutine med_methods_State_GetScalar(state, scalar_id, scalar_value, flds_scal integer :: mytask, ierr, len, icount type(ESMF_VM) :: vm type(ESMF_Field) :: field - real(R8), pointer :: farrayptr(:,:) => null() + real(R8), pointer :: farrayptr(:,:) real(r8) :: tmp(1) character(len=*), parameter :: subname='(med_methods_State_GetScalar)' ! ---------------------------------------------- @@ -2350,7 +2343,7 @@ subroutine med_methods_State_SetScalar(scalar_value, scalar_id, State, flds_scal integer :: mytask type(ESMF_Field) :: field type(ESMF_VM) :: vm - real(R8), pointer :: farrayptr(:,:) => null() + real(R8), pointer :: farrayptr(:,:) character(len=*), parameter :: subname='(med_methods_State_SetScalar)' ! ---------------------------------------------- @@ -2504,7 +2497,7 @@ subroutine med_methods_FB_getmesh(FB, mesh, rc) ! local variables integer :: fieldCount - type(ESMF_Field), pointer :: fieldlist(:) => null() + type(ESMF_Field), pointer :: fieldlist(:) ! ---------------------------------------------- rc = ESMF_SUCCESS diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index e967cbf9b..42382d3d9 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,119 @@ 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 + use med_phases_history_mod, only : med_phases_history_write_med + ! 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 +263,76 @@ 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) + 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 - ! Calculate atm/ocn fluxes on the destination grid - call med_aofluxes_run(gcomp, aoflux, 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) - 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 (chkerr(rc,__LINE__,u_FILE_u)) return + end if + call t_stopf('MED:'//subname) end if - call t_stopf('MED:'//subname) - 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 +344,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 +360,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 +407,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 +414,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 +421,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) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(FBOcn, fldname='So_u', fldptr1=aoflux%uocn, 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_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) + ! ------------------------ + ! 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 - call FB_GetFldPtr(FBAtm, fldname='Sa_q2m', fldptr1=aoflux%shum, 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 - else - call FB_GetFldPtr(FBAtm, fldname='Sa_u', fldptr1=aoflux%ubot, 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_v', fldptr1=aoflux%vbot, 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_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 893393d2c..77496e1d7 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -2,47 +2,121 @@ module med_phases_history_mod !----------------------------------------------------------------------------- ! Mediator History control - ! - ! Each time loop has its own associated clock object. NUOPC manages - ! these clock objects, i.e. their creation and destruction, as well as - ! startTime, endTime, timeStep adjustments during the execution. The - ! outer most time loop of the run sequence is a special case. It uses - ! the driver clock itself. If a single outer most loop is defined in - ! the run sequence provided by freeFormat, this loop becomes the driver - ! loop level directly. Therefore, setting the timeStep or runDuration - ! for the outer most time loop results modifiying the driver clock - ! itself. However, for cases with concatenated loops on the upper level - ! of the run sequence in freeFormat, a single outer loop is added - ! automatically during ingestion, and the driver clock is used for this - ! loop instead. !----------------------------------------------------------------------------- use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 - use ESMF , only : ESMF_Alarm - use med_constants_mod , only : dbug_flag => med_constants_dbug_flag - use med_constants_mod , only : SecPerDay => med_constants_SecPerDay - use med_utils_mod , only : chkerr => med_utils_ChkErr - use med_methods_mod , only : FB_reset => med_methods_FB_reset - use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose - use med_methods_mod , only : FB_accum => med_methods_FB_accum - use med_methods_mod , only : State_GetScalar => med_methods_State_GetScalar + use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_VM + use ESMF , only : ESMF_Clock, ESMF_ClockGet, ESMF_ClockSet, ESMF_ClockAdvance + use ESMF , only : ESMF_ClockGetNextTime, ESMF_ClockGetAlarm, ESMF_ClockIsCreated + use ESMF , only : ESMF_Calendar, ESMF_Time, ESMF_TimeGet + use ESMF , only : ESMF_TimeInterval, ESMF_TimeIntervalGet, ESMF_TimeIntervalSet + use ESMF , only : ESMF_Alarm, ESMF_AlarmIsRinging, ESMF_AlarmRingerOff, ESMF_AlarmGet + use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LOGMSG_ERROR, ESMF_LogFoundError + use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE, ESMF_MAXSTR, ESMF_LOGERR_PASSTHRU, ESMF_END_ABORT + use ESMF , only : ESMF_Finalize + use ESMF , only : operator(-), operator(+) + use NUOPC , only : NUOPC_CompAttributeGet + use NUOPC_Model , only : NUOPC_ModelGet + use esmFlds , only : ncomps, compname + use med_utils_mod , only : chkerr => med_utils_ChkErr use med_internalstate_mod , only : InternalState, mastertask, logunit use med_time_mod , only : med_time_alarmInit - use med_io_mod , only : med_io_write, med_io_wopen, med_io_enddef - use med_io_mod , only : med_io_close, med_io_date2yyyymmdd, med_io_sec2hms - use med_io_mod , only : med_io_ymd2date + use med_io_mod , only : med_io_write, med_io_wopen, med_io_enddef, med_io_close use perf_mod , only : t_startf, t_stopf - use esmFlds , only : ncomps implicit none private - public :: med_phases_history_alarm_init - public :: med_phases_history_write - - ! type(ESMF_Alarm) :: alarm_hist_inst - ! type(ESMF_Alarm) :: alarm_hist_avg - + ! Public routine called from the run sequence + public :: med_phases_history_write ! inst only - for all variables + + ! Public routines called from post phases + public :: med_phases_history_write_comp ! inst, avg, aux for component + public :: med_phases_history_write_med ! inst only, med aoflux and ocn albedoes + public :: med_phases_history_write_lnd2glc ! inst only, yearly average of lnd->glc data on lnd grid + + ! Private routines + private :: med_phases_history_write_comp_inst ! write instantaneous file for a given component + private :: med_phases_history_write_comp_avg ! write averaged file for a given component + private :: med_phases_history_write_comp_aux ! write auxiliary file for a given component + private :: med_phases_history_init_histclock + private :: med_phases_history_query_ifwrite + private :: med_phases_history_set_timeinfo + private :: med_phases_history_fldbun_accum + private :: med_phases_history_fldbun_average + + ! ---------------------------- + ! Instantaneous history files datatypes/variables + ! ---------------------------- + type, public :: instfile_type + logical :: write_inst + character(CS) :: hist_option + integer :: hist_n + type(ESMF_Clock) :: clock + type(ESMF_Alarm) :: alarm + character(CS) :: alarmname + logical :: is_clockset = .false. + logical :: is_active = .false. + end type instfile_type + type(instfile_type) , public :: instfiles(ncomps) + + ! ---------------------------- + ! Time averaging history files + ! ---------------------------- + type, public :: avgfile_type + logical :: write_avg + type(ESMF_FieldBundle) :: FBaccum_import ! field bundle for time averaging + integer :: accumcnt_import ! field bundle accumulation counter + type(ESMF_FieldBundle) :: FBaccum_export ! field bundle for time averaging + integer :: accumcnt_export ! field bundle accumulation counter + character(CS) :: hist_option + integer :: hist_n + type(ESMF_Clock) :: clock + type(ESMF_Alarm) :: alarm + character(CS) :: alarmname + logical :: is_clockset = .false. + logical :: is_active = .false. + end type avgfile_type + type(avgfile_type) :: avgfiles(ncomps) + + ! ---------------------------- + ! Auxiliary history files + ! ---------------------------- + type, public :: auxfile_type + character(CS), allocatable :: flds(:) ! array of aux field names + character(CS) :: auxname ! name for history file creation + character(CL) :: histfile = '' ! current history file name + integer :: ntperfile ! maximum number of time samples per file + integer :: nt = 0 ! time in file + logical :: doavg ! if true, time average, otherwise instantaneous + type(ESMF_FieldBundle) :: FBaccum ! field bundle for time averaging + integer :: accumcnt ! field bundle accumulation counter + type(ESMF_Clock) :: clock ! auxiliary history clock + type(ESMF_Alarm) :: alarm ! auxfile alarm + character(CS) :: alarmname ! name of write alarm + end type auxfile_type + + integer, parameter :: max_auxfiles = 10 + type, public :: auxcomp_type + type(auxfile_type) :: files(max_auxfiles) + integer :: num_auxfiles = 0 ! actual number of auxiliary files + logical :: init_auxfiles = .false. ! if auxfile initial has occured + end type auxcomp_type + type(auxcomp_type) , public :: auxcomp(ncomps) + + !logical :: init_auxfiles(ncomps) = .false. ! if true, auxfiles has been initialized for the component + + ! ---------------------------- + ! Other private module variables + ! ---------------------------- + + logical :: whead(2) = (/.true. , .false./) + logical :: wdata(2) = (/.false., .true. /) + + character(CL) :: case_name = 'unset' ! case name + character(CS) :: inst_tag = 'unset' ! instance tag + logical :: debug_alarms = .true. character(*), parameter :: u_FILE_u = & __FILE__ @@ -50,429 +124,1641 @@ module med_phases_history_mod contains !=============================================================================== - subroutine med_phases_history_alarm_init(gcomp, rc) + subroutine med_phases_history_write(gcomp, rc) ! -------------------------------------- - ! Initialize mediator history file alarms (module variables) + ! Write instantaneous mediator history file for all variables ! -------------------------------------- - use ESMF , only : ESMF_GridComp, ESMF_GridCompGet - use ESMF , only : ESMF_Clock, ESMF_ClockGet, ESMF_ClockAdvance, ESMF_ClockSet - use ESMF , only : ESMF_Time - use ESMF , only : ESMF_TimeInterval, ESMF_TimeIntervalGet - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LOGMSG_ERROR - use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE - use ESMF , only : operator(==), operator(-) - use ESMF , only : ESMF_ALARMLIST_ALL, ESMF_Alarm, ESMF_AlarmSet - use NUOPC , only : NUOPC_CompAttributeGet - use NUOPC_Model, only : NUOPC_ModelGet + use med_io_mod, only : med_io_write_time, med_io_define_time + use ESMF , only : ESMF_Alarm, ESMF_AlarmSet + use ESMF , only : ESMF_FieldBundleIsCreated + use esmflds , only : compocn, compatm ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc ! local variables + type(InternalState) :: is_local + type(ESMF_Clock) :: mclock type(ESMF_Alarm) :: alarm - type(ESMF_Clock) :: mclock, dclock - type(ESMF_TimeInterval) :: mtimestep, dtimestep - type(ESMF_Time) :: mCurrTime - type(ESMF_Time) :: mStartTime - type(ESMF_TimeInterval) :: timestep - integer :: alarmcount - integer :: timestep_length - character(CL) :: cvalue ! attribute string - character(CL) :: histinst_option ! freq_option setting (ndays, nsteps, etc) - character(CL) :: histavg_option ! freq_option setting (ndays, nsteps, etc) - integer :: histinst_n ! freq_n setting relative to freq_option - integer :: histavg_n ! freq_n setting relative to freq_option - character(len=*), parameter :: subname='(med_phases_history_alarm_init)' + character(CS) :: alarmname + character(CL) :: hist_option ! freq_option setting (ndays, nsteps, etc) + integer :: hist_n ! freq_n setting relative to freq_option + character(CL) :: cvalue ! attribute string + logical :: isPresent + logical :: isSet + type(ESMF_VM) :: vm + type(ESMF_Calendar) :: calendar ! calendar type + integer :: i,m,n ! indices + integer :: nx,ny ! global grid size + character(CL) :: time_units ! units of time variable + character(CL) :: hist_file ! history file name + real(r8) :: time_val ! time coordinate output + real(r8) :: time_bnds(2) ! time bounds output + logical :: write_now ! true => write to history type + real(r8) :: tbnds(2) ! CF1.0 time bounds + type(ESMF_Time) :: starttime + type(ESMF_Time) :: currtime + type(ESMF_Time) :: nexttime + character(len=CS) :: currtimestr + character(len=CS) :: nexttimestr + integer :: yr,mon,day,sec ! time units + type(ESMF_TimeInterval) :: ringInterval + integer :: ringInterval_length + logical :: first_time = .true. + character(len=*), parameter :: subname='(med_phases_history_write)' !--------------------------------------- rc = ESMF_SUCCESS + call t_startf('MED:'//subname) - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) - endif + ! Get the internal state + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! ----------------------------- - ! Get model clock - ! ----------------------------- + alarmname='alarm_history_inst_all' - call NUOPC_ModelGet(gcomp, modelClock=mclock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (first_time) then + call NUOPC_CompAttributeGet(gcomp, name='history_option', isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + call NUOPC_CompAttributeGet(gcomp, name='history_option', value=hist_option, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(gcomp, name='history_n', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) hist_n + else + ! If attribute is not present - don't write history output + hist_option = 'none' + hist_n = -999 + end if - ! get start time - call ESMF_ClockGet(mclock, startTime=mStartTime, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Set alarm name and initialize clock and alarm for instantaneous history output + ! The alarm for the full history write is set on the mediator clock not as a separate alarm + if (hist_option /= 'none' .and. hist_option /= 'never') then + + ! Initialize alarm on mediator clock for instantaneous mediator history output for all variables + call NUOPC_ModelGet(gcomp, modelClock=mclock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockGet(mclock, startTime=starttime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_time_alarmInit(mclock, alarm, option=hist_option, opt_n=hist_n, & + reftime=starttime, alarmname=alarmname, rc=rc) + call ESMF_AlarmSet(alarm, clock=mclock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Advance model clock to trigger alarms then reset model clock back to currtime + call ESMF_ClockGet(mclock, currTime=CurrTime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockAdvance(mclock,rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockSet(mclock, currTime=currtime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Write diagnostic info + if (mastertask) then + write(logunit,'(a,2x,i8)') trim(subname) // " initialized history alarm "//& + trim(alarmname)//" with option "//trim(hist_option)//" and frequency ",hist_n + end if + end if + first_time = .false. + end if - ! ----------------------------- - ! Set alarm for instantaneous mediator history output - ! ----------------------------- + write_now = .false. + if (hist_option /= 'none' .and. hist_option /= 'never') then + call NUOPC_ModelGet(gcomp, modelClock=mclock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockGetAlarm(mclock, alarmname=trim(alarmname), alarm=alarm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(gcomp, name='history_option', value=histinst_option, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(gcomp, name='history_n', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) histinst_n + if (ESMF_AlarmIsRinging(alarm, rc=rc)) then + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Set write flag to .true. and turn ringer off + write_now = .true. + call ESMF_AlarmRingerOff( alarm, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_time_alarmInit(mclock, alarm, option=histinst_option, opt_n=histinst_n, & - reftime=mStartTime, alarmname='alarm_history_inst', rc=rc) + ! Write diagnostic info if appropriate + if (mastertask .and. debug_alarms) then + call ESMF_AlarmGet(alarm, ringInterval=ringInterval, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeIntervalGet(ringInterval, s=ringinterval_length, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_AlarmSet(alarm, clock=mclock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockGet(mclock, currtime=currtime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeGet(currtime,yy=yr, mm=mon, dd=day, s=sec, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(currtimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec - ! ----------------------------- - ! Set alarm for averaged mediator history output - ! ----------------------------- + call ESMF_ClockGetNextTime(mclock, nextTime=nexttime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeGet(nexttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(nexttimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + + if (mastertask) then + write(logunit,*) + write(logunit,'(a,i8)') trim(subname)//" : history alarmname "//trim(alarmname)//& + ' is ringing, interval length is ', ringInterval_length + write(logunit,'(a)') trim(subname)//" : mclock currtime = "//trim(currtimestr)//& + " mclock nexttime = "//trim(nexttimestr) + end if + end if + end if - !TODO: add isSet and isPresent flags to reading these and other config attributes - !call NUOPC_CompAttributeGet(gcomp, name='histavg_option', value=histavg_option, rc=rc) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return - !call NUOPC_CompAttributeGet(gcomp, name='histavg_n', value=cvalue, rc=rc) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return - !read(cvalue,*) histavg_n + ! If write now flag is true + if (write_now) then - !call med_time_alarmInit(mclock, alarm, option=histavg_option, opt_n=histavg_n, & - ! reftime=mStartTime, alarmname='alarm_history_avg', rc=rc) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Determine time_val and tbnds data for history as well as history file name + call med_phases_history_set_timeinfo(gcomp, mclock, alarmname, & + time_val, time_bnds, time_units, hist_file, doavg=.false., compname='all', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - !call ESMF_AlarmSet(alarm, clock=mclock, rc=rc) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Create history file + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_io_wopen(hist_file, vm, clobber=.true.) - !-------------------------------- - ! Advance model clock to trigger alarms then reset model clock back to currtime - !-------------------------------- + ! Loop over whead/wdata phases + do m = 1,2 + if (m == 2) then + call med_io_enddef(hist_file) + end if - call ESMF_ClockGet(mclock, currTime=mCurrTime, timeStep=mtimestep, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeIntervalGet(mtimestep, s=timestep_length, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Write time values + if (whead(m)) then + call ESMF_ClockGet(mclock, calendar=calendar, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_io_define_time(time_units, calendar, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call med_io_write_time(time_val, time_bnds, nt=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if - call ESMF_ClockAdvance(mclock,rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + do n = 2,ncomps ! skip the mediator here + ! Write import and export field bundles + if (is_local%wrap%comp_present(n)) then + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(n,n),rc=rc)) then + call med_io_write(hist_file, is_local%wrap%FBimp(n,n), whead(m), wdata(m), & + is_local%wrap%nx(n), is_local%wrap%ny(n), nt=1, pre=trim(compname(n))//'Imp', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(n),rc=rc)) then + call med_io_write(hist_file, is_local%wrap%FBexp(n), whead(m), wdata(m), & + is_local%wrap%nx(n), is_local%wrap%ny(n), nt=1, pre=trim(compname(n))//'Exp', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + end if + ! Write mediator fraction field bundles + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBFrac(n),rc=rc)) then + call med_io_write(hist_file, is_local%wrap%FBFrac(n), whead(m), wdata(m), & + is_local%wrap%nx(n), is_local%wrap%ny(n), nt=1, pre='Med_frac_'//trim(compname(n)), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + ! Write component mediator area field bundles + call med_io_write(hist_file, is_local%wrap%FBArea(n), whead(m), wdata(m), & + is_local%wrap%nx(n), is_local%wrap%ny(n), nt=1, pre='MED_'//trim(compname(n)), rc=rc) + end do + + ! Write atm/ocn fluxes and ocean albedoes if field bundles are created + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o,rc=rc)) then + call med_io_write(hist_file, is_local%wrap%FBMed_ocnalb_o, whead(m), wdata(m), & + is_local%wrap%nx(compocn), is_local%wrap%ny(compocn), nt=1, pre='Med_alb_ocn', rc=rc) + end if + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_o,rc=rc)) then + call med_io_write(hist_file, is_local%wrap%FBMed_aoflux_o, whead(m), wdata(m), & + is_local%wrap%nx(compocn), is_local%wrap%ny(compocn), nt=1, pre='Med_aoflux_ocn', rc=rc) + end if + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_a,rc=rc)) then + call med_io_write(hist_file, is_local%wrap%FBMed_ocnalb_a, whead(m), wdata(m), & + is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_alb_atm', rc=rc) + end if + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a,rc=rc)) then + call med_io_write(hist_file, is_local%wrap%FBMed_aoflux_a, whead(m), wdata(m), & + is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_aoflux_atm', rc=rc) + end if - call ESMF_ClockSet(mclock, currTime=mcurrtime, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do ! end of loop over whead/wdata m index phases - ! ----------------------------- - ! Write mediator diagnostic output - ! ----------------------------- + ! Close file + call med_io_close(hist_file, vm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (mastertask) then - write(logunit,*) - write(logunit,100) trim(subname)//" history clock timestep = ",timestep_length - write(logunit,100) trim(subname)//" set instantaneous mediator history alarm with option "//& - trim(histinst_option)//" and frequency ",histinst_n - !write(logunit,100) trim(subname)//" set averaged mediator history alarm with option "//& - ! trim(histavg_option)//" and frequency ",histavg_n -100 format(a,2x,i8) - write(logunit,*) + end if ! end of write_now if-block end if - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": exited", ESMF_LOGMSG_INFO) - endif + call t_stopf('MED:'//subname) - end subroutine med_phases_history_alarm_init + end subroutine med_phases_history_write !=============================================================================== + subroutine med_phases_history_write_med(gcomp, rc) - subroutine med_phases_history_write(gcomp, rc) + ! Write mediator history file for med variables - only instantaneous files are written + ! This writes out ocean albedoes and atm/ocean fluxes computed by the mediator + ! along with the fractions computed by the mediator - ! -------------------------------------- - ! Write mediator history file - ! -------------------------------------- - - use ESMF , only : ESMF_GridComp, ESMF_GridCompGet - use ESMF , only : ESMF_VM, ESMF_VMGet - use ESMF , only : ESMF_Clock, ESMF_ClockGet, ESMF_ClockGetNextTime, ESMF_ClockGetAlarm - use ESMF , only : ESMF_Calendar - use ESMF , only : ESMF_Time, ESMF_TimeGet - use ESMF , only : ESMF_TimeInterval, ESMF_TimeIntervalGet - use ESMF , only : ESMF_Alarm, ESMF_AlarmIsRinging, ESMF_AlarmRingerOff, ESMF_AlarmGet - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LOGMSG_ERROR - use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE - use ESMF , only : ESMF_FieldBundleIsCreated, ESMF_MAXSTR, ESMF_ClockPrint, ESMF_AlarmIsCreated - use ESMF , only : operator(==), operator(-) - use ESMF , only : ESMF_ALARMLIST_ALL, ESMF_ClockGetAlarmList - use NUOPC , only : NUOPC_CompAttributeGet - use esmFlds , only : compatm, compocn, ncomps, compname - use esmFlds , only : fldListFr, fldListTo - use NUOPC_Model, only : NUOPC_ModelGet + use ESMF , only : ESMF_FieldBundleIsCreated + use med_io_mod, only : med_io_write_time, med_io_define_time + use esmFlds , only : compmed, compocn, compatm ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc ! local variables - type(ESMF_Clock) :: mclock, dclock - type(ESMF_TimeInterval) :: mtimestep, dtimestep - integer :: timestep_length - type(ESMF_Alarm) :: alarm - integer :: alarmCount + type(InternalState) :: is_local + type(ESMF_VM) :: vm + type(ESMF_Calendar) :: calendar ! calendar type + integer :: i,m,n ! indices + integer :: nx,ny ! global grid size + character(CL) :: time_units ! units of time variable + character(CL) :: hist_file ! history file name + real(r8) :: time_val ! time coordinate output + real(r8) :: time_bnds(2) ! time bounds output + logical :: write_now ! true => write to history type + character(CL) :: cvalue ! attribute string + character(CL) :: hist_option ! freq_option setting (ndays, nsteps, etc) + integer :: hist_n ! freq_n setting relative to freq_option + character(CL) :: hist_option_in + character(CL) :: hist_n_in + logical :: isPresent + logical :: isSet + character(len=*), parameter :: subname='(med_phases_history_write_med)' + !--------------------------------------- + rc = ESMF_SUCCESS + + ! Get the internal state + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! alarm is not set determine hist_option and hist_n + if (.not. instfiles(compmed)%is_clockset) then + ! Determine attribute prefix + write(hist_option_in,'(a)') 'history_option_med_inst' + write(hist_n_in,'(a)') 'history_n_med_inst' + + ! Determine instantaneous mediator output frequency and type + call NUOPC_CompAttributeGet(gcomp, name=trim(hist_option_in), isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + call NUOPC_CompAttributeGet(gcomp, name=trim(hist_option_in), value=hist_option, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(gcomp, name=trim(hist_n_in), value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) hist_n + else + ! If attribute is not present - don't write history output + hist_option = 'none' + hist_n = -999 + end if + + ! Set alarm name and initialize clock and alarm for instantaneous history output + if (hist_option /= 'none' .and. hist_option /= 'never') then + instfiles(compmed)%alarmname = 'alarm_history_inst_med' + call med_phases_history_init_histclock(gcomp, instfiles(compmed)%clock, & + instfiles(compmed)%alarm, instfiles(compmed)%alarmname, hist_option, hist_n, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + instfiles(compmed)%is_active = .true. + instfiles(compmed)%is_clockset = .true. + else + instfiles(compmed)%is_active = .false. + ! this is set to true here even if history file is not active + instfiles(compmed)%is_clockset = .true. + end if + end if + + ! if history file is active and history clock is initialized - process history file + if (instfiles(compmed)%is_active .and. instfiles(compmed)%is_clockset) then + + ! Determine if will write to history file + call med_phases_history_query_ifwrite(gcomp, instfiles(compmed)%clock, instfiles(compmed)%alarmname, & + write_now, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! If write now flag is true + if (write_now) then + + ! Determine time_val and tbnds data for history as well as history file name + call med_phases_history_set_timeinfo(gcomp, instfiles(compmed)%clock, instfiles(compmed)%alarmname, & + time_val, time_bnds, time_units, hist_file, doavg=.false., compname='med', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Create history file + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_io_wopen(hist_file, vm, clobber=.true.) + do m = 1,2 + ! Write time values + if (whead(m)) then + call ESMF_ClockGet(instfiles(compmed)%clock, calendar=calendar, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_io_define_time(time_units, calendar, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call med_io_enddef(hist_file) + call med_io_write_time(time_val, time_bnds, nt=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + ! Write aoflux fields computed in mediator + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_o,rc=rc)) then + call med_io_write(hist_file, is_local%wrap%FBMed_aoflux_o, whead(m), wdata(m), & + is_local%wrap%nx(compocn), is_local%wrap%ny(compocn), nt=1, pre='Med_aoflux_ocn', rc=rc) + end if + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a,rc=rc)) then + call med_io_write(hist_file, is_local%wrap%FBMed_aoflux_a, whead(m), wdata(m), & + is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_aoflux_atm', rc=rc) + end if + + ! If appropriate - write ocn albedos computed in mediator + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o,rc=rc)) then + call med_io_write(hist_file, is_local%wrap%FBMed_ocnalb_o, whead(m), wdata(m), & + is_local%wrap%nx(compocn), is_local%wrap%ny(compocn), nt=1, pre='Med_alb_ocn', rc=rc) + end if + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_a,rc=rc)) then + call med_io_write(hist_file, is_local%wrap%FBMed_ocnalb_a, whead(m), wdata(m), & + is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_alb_atm', rc=rc) + end if + end do ! end of loop over m + + ! Close file + call med_io_close(hist_file, vm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + end if ! end of if-write_now block + end if ! end of if-active block + + end subroutine med_phases_history_write_med + + !=============================================================================== + subroutine med_phases_history_write_lnd2glc(gcomp, fldbun, rc) + + ! Write yearly average of lnd -> glc fields + + use esmFlds , only : complnd + use med_constants_mod , only : SecPerDay => med_constants_SecPerDay + use med_io_mod , only : med_io_write_time, med_io_define_time + use med_io_mod , only : med_io_date2yyyymmdd, med_io_sec2hms, med_io_ymd2date + + ! input/output variables + type(ESMF_GridComp) , intent(in) :: gcomp + type(ESMF_FieldBundle) , intent(in) :: fldbun + integer , intent(out) :: rc + + ! local variables + type(InternalState) :: is_local type(ESMF_VM) :: vm - type(ESMF_Time) :: currtime + type(ESMF_Clock) :: clock type(ESMF_Time) :: starttime + type(ESMF_Time) :: currtime type(ESMF_Time) :: nexttime - type(ESMF_TimeInterval) :: timediff ! Used to calculate curr_time - type(ESMF_Calendar) :: calendar ! calendar type - character(len=64) :: currtimestr - character(len=64) :: nexttimestr - type(InternalState) :: is_local - character(CS) :: histavg_option ! Histavg option units - integer :: i,j,m,n,n1,ncnt - integer :: start_ymd ! Starting date YYYYMMDD - integer :: start_tod ! Starting time-of-day (s) - integer :: nx,ny ! global grid size - integer :: yr,mon,day,sec ! time units - real(r8) :: rval ! real tmp value - real(r8) :: dayssince ! Time interval since reference time - integer :: fk ! index - character(CL) :: time_units ! units of time variable - character(CL) :: case_name ! case name - character(CL) :: hist_file ! Local path to history filename - character(CS) :: cpl_inst_tag ! instance tag - character(CL) :: cvalue ! attribute string - real(r8) :: tbnds(2) ! CF1.0 time bounds - logical :: whead,wdata ! for writing restart/history cdf files - integer :: iam - logical :: isPresent - type(ESMF_TimeInterval) :: RingInterval - integer :: ringInterval_length - logical :: first_time = .true. - character(len=*), parameter :: subname='(med_phases_history_write)' + type(ESMF_Calendar) :: calendar ! calendar type + type(ESMF_TimeInterval) :: timediff(2) ! time bounds upper and lower relative to start + character(len=CS) :: nexttime_str + integer :: yr,mon,day,sec + integer :: start_ymd ! starting date YYYYMMDD + character(CL) :: time_units ! units of time variable + real(r8) :: time_val ! time coordinate output + real(r8) :: time_bnds(2) ! time bounds output + character(len=CL) :: hist_str + character(len=CL) :: hist_file + integer :: m + logical :: isPresent, isSet + character(len=*), parameter :: subname='(med_phases_history_write_lnd2glc)' !--------------------------------------- - call t_startf('MED:'//subname) - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) - endif rc = ESMF_SUCCESS - !--------------------------------------- - ! --- Get the communicator and localpet - !--------------------------------------- + ! Get the internal state + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + ! Get the model clock + call NUOPC_ModelGet(gcomp, modelClock=clock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMGet(vm, localPet=iam, rc=rc) + + ! Determine starttime, currtime and nexttime + call ESMF_ClockGet(clock, currtime=currtime, starttime=starttime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockGetNextTime(clock, nextTime=nexttime, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - !--------------------------------------- - ! --- Get the internal state - !--------------------------------------- + ! Determine time units + call ESMF_TimeGet(starttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_io_ymd2date(yr,mon,day,start_ymd) + time_units = 'days since ' // trim(med_io_date2yyyymmdd(start_ymd)) // ' ' // med_io_sec2hms(sec, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - nullify(is_local%wrap) - call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + ! Set time bounds and time coord + timediff(1) = nexttime - starttime + call ESMF_TimeIntervalGet(timediff(1), d=day, s=sec, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(gcomp, name='case_name', value=case_name, rc=rc) + time_val = day + sec/real(SecPerDay,R8) + time_bnds(1) = time_val + time_bnds(2) = time_val + + ! Determine history file name + if (trim(case_name) == 'unset') then + call NUOPC_CompAttributeGet(gcomp, name='case_name', value=case_name, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(gcomp, name='inst_suffix', isPresent=isPresent, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if(isPresent) then + call NUOPC_CompAttributeGet(gcomp, name='inst_suffix', value=inst_tag, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + inst_tag = "" + endif + end if + call ESMF_TimeGet(nexttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(nexttime_str,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + write(hist_file, "(6a)") trim(case_name),'.cpl',trim(inst_tag),'.hx.1yr2glc.',trim(nexttime_str),'.nc' - call NUOPC_CompAttributeGet(gcomp, name='inst_suffix', isPresent=isPresent, rc=rc) + ! Create history file + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if(isPresent) then - call NUOPC_CompAttributeGet(gcomp, name='inst_suffix', value=cpl_inst_tag, rc=rc) + call med_io_wopen(hist_file, vm, clobber=.true.) + + ! Write data to history file + do m = 1,2 + if (whead(m)) then + call ESMF_ClockGet(clock, calendar=calendar, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_io_define_time(time_units, calendar, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call med_io_enddef(hist_file) + call med_io_write_time(time_val, time_bnds, nt=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + call med_io_write(hist_file, fldbun, whead(m), wdata(m), is_local%wrap%nx(complnd), is_local%wrap%ny(complnd), & + nt=1, pre=trim(compname(complnd))//'Imp', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - cpl_inst_tag = "" - endif + end do ! end of loop over m - call NUOPC_ModelGet(gcomp, modelClock=mclock, rc=rc) + ! Close history file + call med_io_close(hist_file, vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (first_time) then - call med_phases_history_alarm_init(gcomp, rc) - end if + end subroutine med_phases_history_write_lnd2glc + + !=============================================================================== + subroutine med_phases_history_write_comp(gcomp, compid, rc) + + ! Write mediator history file for atm variables + + ! input/output variables + type(ESMF_GridComp), intent(inout) :: gcomp + integer , intent(in) :: compid + integer , intent(out) :: rc !--------------------------------------- - ! Check if history alarm is ringing - and if so write the mediator history file + rc = ESMF_SUCCESS + + call med_phases_history_write_comp_inst(gcomp, compid, instfiles(compid), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_phases_history_write_comp_avg(gcomp, compid, avgfiles(compid), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_phases_history_write_comp_aux(gcomp, compid, auxcomp(compid), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine med_phases_history_write_comp + + !=============================================================================== + subroutine med_phases_history_write_comp_inst(gcomp, compid, instfile, rc) + + ! Write instantaneous mediator history file for component compid + + use med_io_mod, only : med_io_write_time, med_io_define_time + use ESMF , only : ESMF_FieldBundleIsCreated + + ! input/output variables + type(ESMF_GridComp) , intent(inout) :: gcomp + integer , intent(in) :: compid + type(instfile_type) , intent(inout) :: instfile + integer , intent(out) :: rc + + ! local variables + type(InternalState) :: is_local + character(CL) :: cvalue ! attribute string + character(CL) :: hist_option ! freq_option setting (ndays, nsteps, etc) + integer :: hist_n ! freq_n setting relative to freq_option + character(CL) :: hist_option_in + character(CL) :: hist_n_in + logical :: isPresent + logical :: isSet + type(ESMF_VM) :: vm + type(ESMF_Calendar) :: calendar ! calendar type + integer :: i,m,n ! indices + integer :: nx,ny ! global grid size + character(CL) :: time_units ! units of time variable + character(CL) :: hist_file ! history file name + real(r8) :: time_val ! time coordinate output + real(r8) :: time_bnds(2) ! time bounds output + logical :: write_now ! true => write to history type + real(r8) :: tbnds(2) ! CF1.0 time bounds + character(len=*), parameter :: subname='(med_phases_history_write_inst_comp)' !--------------------------------------- - ! TODO: Add history averaging functionality and Determine if history average alarm is on - ! if (ESMF_AlarmIsRinging(AlarmHistAvg, rc=rc)) then - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! alarmIsOn = .true. - ! call ESMF_AlarmRingerOff( AlarmHist, rc=rc ) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! else - ! alarmisOn = .false. - ! endif + rc = ESMF_SUCCESS + call t_startf('MED:'//subname) - call ESMF_ClockGetAlarm(mclock, alarmname='alarm_history_inst', alarm=alarm, rc=rc) + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (dbug_flag > 2) then - call ESMF_AlarmGet(alarm, ringInterval=ringInterval, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeIntervalGet(ringInterval, s=ringinterval_length, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockGet(mclock, currtime=currtime, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeGet(currtime,yy=yr, mm=mon, dd=day, s=sec, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - write(currtimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec - call ESMF_ClockGetNextTime(mclock, nextTime=nexttime, rc=rc) + ! alarm is not set determine hist_option and hist_n + if (.not. instfile%is_clockset) then + + ! Determine attribute prefix + write(hist_option_in,'(a)') 'history_option_'//trim(compname(compid))//'_inst' + write(hist_n_in,'(a)') 'history_n_'//trim(compname(compid))//'_inst' + + ! Determine instantaneous mediator output frequency and type + call NUOPC_CompAttributeGet(gcomp, name=trim(hist_option_in), isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeGet(nexttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) + if (isPresent .and. isSet) then + call NUOPC_CompAttributeGet(gcomp, name=trim(hist_option_in), value=hist_option, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(gcomp, name=trim(hist_n_in), value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) hist_n + else + ! If attribute is not present - don't write history output + hist_option = 'none' + hist_n = -999 + end if + + ! Set alarm name and initialize clock and alarm for instantaneous history output + if (hist_option /= 'none' .and. hist_option /= 'never') then + instfile%alarmname = 'alarm_history_inst_'//trim(compname(compid)) + call med_phases_history_init_histclock(gcomp, instfile%clock, & + instfile%alarm, instfile%alarmname, hist_option, hist_n, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + instfile%is_active = .true. + instfile%is_clockset = .true. + else + instfile%is_active = .false. + ! this is set to true here even if history file is not active + instfile%is_clockset = .true. + end if + end if ! end of if-clock set if block + + ! if history file is active and history clock is initialized - process history file + if (instfile%is_active .and. instfile%is_clockset) then + + ! Determine if should write to history file + call med_phases_history_query_ifwrite(gcomp, instfile%clock, instfile%alarmname, write_now, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (mastertask) then - write(nexttimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec - write(logunit,*) - write(logunit,*) trim(subname)//": history alarm ringinterval = ", ringInterval_length - write(logunit,' (a)') trim(subname)//": currtime = "//trim(currtimestr)//" nexttime = "//trim(nexttimestr) - write(logunit,*) trim(subname) //' history alarm is ringing = ', ESMF_AlarmIsRinging(alarm) + + ! If write now flag is true + if (write_now) then + ! Determine time_val and tbnds data for history as well as history file name + call med_phases_history_set_timeinfo(gcomp, instfile%clock, instfile%alarmname, & + time_val, time_bnds, time_units, hist_file, doavg=.false., compname=compname(compid), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Create history file + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_io_wopen(hist_file, vm, clobber=.true.) + do m = 1,2 + ! Write time values + if (whead(m)) then + call ESMF_ClockGet(instfile%clock, calendar=calendar, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_io_define_time(time_units, calendar, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call med_io_enddef(hist_file) + call med_io_write_time(time_val, time_bnds, nt=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + nx = is_local%wrap%nx(compid) + ny = is_local%wrap%ny(compid) + ! Define/write import field bundle + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(compid,compid),rc=rc)) then + call med_io_write(hist_file, is_local%wrap%FBimp(compid,compid), whead(m), wdata(m), nx, ny, & + nt=1, pre=trim(compname(compid))//'Imp', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + ! Define/write import export bundle + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(compid),rc=rc)) then + call med_io_write(hist_file, is_local%wrap%FBexp(compid), whead(m), wdata(m), nx, ny, & + nt=1, pre=trim(compname(compid))//'Exp', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + ! Define/Write mediator fractions + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBFrac(compid),rc=rc)) then + call med_io_write(hist_file, is_local%wrap%FBFrac(compid), whead(m), wdata(m), nx, ny, & + nt=1, pre='Med_frac_'//trim(compname(compid)), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + end do ! end of loop over m + + ! Close file + call med_io_close(hist_file, vm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if end if - if (ESMF_AlarmIsRinging(alarm, rc=rc)) then - if (ChkErr(rc,__LINE__,u_FILE_u)) return + call t_stopf('MED:'//subname) - ! Turn ringer off - call ESMF_AlarmRingerOff( alarm, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + end subroutine med_phases_history_write_comp_inst - ! Get time info for history file - call ESMF_GridCompGet(gcomp, clock=mclock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + !=============================================================================== + subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) - call ESMF_ClockGet(mclock, currtime=currtime, starttime=starttime, calendar=calendar, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Write mediator average history file variables for component compid - call ESMF_ClockGetNextTime(mclock, nextTime=nexttime, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + use ESMF , only : ESMF_FieldBundleIsCreated + use med_constants_mod , only : czero => med_constants_czero + use med_methods_mod , only : med_methods_FB_init, med_methods_FB_reset + use med_io_mod , only : med_io_write_time, med_io_define_time - call ESMF_TimeGet(currtime,yy=yr, mm=mon, dd=day, s=sec, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - write(currtimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + ! input/output variables + type(ESMF_GridComp) , intent(inout) :: gcomp + integer , intent(in) :: compid + type(avgfile_type) , intent(inout) :: avgfile + integer , intent(out) :: rc - call ESMF_TimeGet(nexttime,yy=yr, mm=mon, dd=day, s=sec, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - write(nexttimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec - timediff = nexttime - starttime - call ESMF_TimeIntervalGet(timediff, d=day, s=sec, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - dayssince = day + sec/real(SecPerDay,R8) + ! local variables + type(InternalState) :: is_local + character(CL) :: cvalue ! attribute string + character(CL) :: hist_option ! freq_option setting (ndays, nsteps, etc) + integer :: hist_n ! freq_n setting relative to freq_option + character(CL) :: hist_option_in + character(CL) :: hist_n_in + logical :: isPresent + logical :: isSet + type(ESMF_VM) :: vm + type(ESMF_Calendar) :: calendar ! calendar type + integer :: i,m,n ! indices + integer :: nx,ny ! global grid size + character(CL) :: time_units ! units of time variable + character(CL) :: hist_file ! history file name + real(r8) :: time_val ! time coordinate output + real(r8) :: time_bnds(2) ! time bounds output + logical :: write_now ! true => write to history type + real(r8) :: tbnds(2) ! CF1.0 time bounds + character(CS) :: scalar_name + character(len=*), parameter :: subname='(med_phases_history_write_comp_avg)' + !--------------------------------------- - call ESMF_TimeGet(starttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_ymd2date(yr,mon,day,start_ymd) - start_tod = sec - time_units = 'days since ' // trim(med_io_date2yyyymmdd(start_ymd)) // ' ' // med_io_sec2hms(start_tod, rc) + rc = ESMF_SUCCESS + + call t_startf('MED:'//subname) + + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! alarm is not set determine hist_option and hist_n + if (.not. avgfile%is_clockset) then + + ! Determine attribute prefix + write(hist_option_in,'(a)') 'history_option_'//trim(compname(compid))//'_avg' + write(hist_n_in,'(a)') 'history_n_'//trim(compname(compid))//'_avg' + + ! Determine time average mediator output frequency and type + call NUOPC_CompAttributeGet(gcomp, name=trim(hist_option_in), isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + call NUOPC_CompAttributeGet(gcomp, name=trim(hist_option_in), value=hist_option, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(gcomp, name=trim(hist_n_in), value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) hist_n + else + hist_option = 'none' + hist_n = -999 + end if + if (hist_option /= 'never' .and. hist_option /= 'none') then + + ! Set alarm name, initialize clock and alarm for average history output and + avgfile%alarmname = 'alarm_history_avg_'//trim(compname(compid)) + call med_phases_history_init_histclock(gcomp, avgfile%clock, & + avgfile%alarm, avgfile%alarmname, hist_option, hist_n, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + avgfile%is_active = .true. + avgfile%is_clockset = .true. + + ! Initialize accumulation import/export field bundles + scalar_name = trim(is_local%wrap%flds_scalar_name) + if ( ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(compid,compid)) .and. .not. & + ESMF_FieldBundleIsCreated(avgfile%FBaccum_import)) then + call med_methods_FB_init(avgfile%FBaccum_import, scalar_name, & + FBgeom=is_local%wrap%FBImp(compid,compid), FBflds=is_local%wrap%FBimp(compid,compid), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call med_methods_FB_reset(avgfile%FBaccum_import, czero, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + avgfile%accumcnt_import = 0 + end if + if ( ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(compid)) .and. .not. & + ESMF_FieldBundleIsCreated(avgfile%FBaccum_export)) then + call med_methods_FB_init(avgfile%FBaccum_export, scalar_name, & + FBgeom=is_local%wrap%FBExp(compid), FBflds=is_local%wrap%FBexp(compid), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call med_methods_FB_reset(avgfile%FBaccum_export, czero, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + avgfile%accumcnt_export = 0 + end if + + else - ! Use nexttimestr rather than currtimestr here since that is the time at the end of - ! the timestep and is preferred for history file names - write(hist_file,"(6a)") trim(case_name), '.cpl',trim(cpl_inst_tag),'.hi.', trim(nexttimestr),'.nc' + avgfile%is_active = .false. + ! this is set to true here even if history file is not active + avgfile%is_clockset = .true. - if (mastertask) then - write(logunit,*) - write(logunit,' (a)') trim(subname)//": writing mediator history file "//trim(hist_file) - write(logunit,' (a)') trim(subname)//": currtime = "//trim(currtimestr) - write(logunit,' (a)') trim(subname)//": nexttime = "//trim(nexttimestr) end if + end if ! end of if-clock set if block - call med_io_wopen(hist_file, vm, iam, clobber=.true.) - do m = 1,2 - whead=.false. - wdata=.false. - if (m == 1) then - whead=.true. - elseif (m == 2) then - wdata=.true. - call med_io_enddef(hist_file) - endif + ! if history file is active and history clock is initialized - process history file + if (avgfile%is_active .and. avgfile%is_clockset) then - tbnds = dayssince + ! Determine if will write to history file + call med_phases_history_query_ifwrite(gcomp, avgfile%clock, avgfile%alarmname, write_now, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (tbnds(1) >= tbnds(2)) then - call med_io_write(hist_file, iam, time_units=time_units, calendar=calendar, time_val=dayssince, & - whead=whead, wdata=wdata, rc=rc) + ! Accumulate and then average if write_now flag is true + if (ESMF_FieldBundleIsCreated(avgfile%FBaccum_import)) then + call med_phases_history_fldbun_accum(is_local%wrap%FBImp(compid,compid), & + avgfile%FBaccum_import, avgfile%accumcnt_import, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (write_now) then + call med_phases_history_fldbun_average(avgfile%FBaccum_import, avgfile%accumcnt_import, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - call med_io_write(hist_file, iam, time_units=time_units, calendar=calendar, time_val=dayssince, & - whead=whead, wdata=wdata, tbnds=tbnds, rc=rc) + end if + end if + if (ESMF_FieldBundleIsCreated(avgfile%FBaccum_export)) then + call med_phases_history_fldbun_accum(is_local%wrap%FBExp(compid), & + avgfile%FBaccum_export, avgfile%accumcnt_export, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (write_now) then + call med_phases_history_fldbun_average(avgfile%FBaccum_export, avgfile%accumcnt_export, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - endif + end if + end if + + ! If write now flag is true + if (write_now) then + + ! Determine time_val and tbnds data for history as well as history file name + call med_phases_history_set_timeinfo(gcomp, avgfile%clock, avgfile%alarmname, & + time_val, time_bnds, time_units, hist_file, doavg=.true., compname=trim(compname(compid)), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Create history file + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_io_wopen(hist_file, vm, clobber=.true.) + do m = 1,2 + ! Write time values + if (whead(m)) then + call ESMF_ClockGet(avgfile%clock, calendar=calendar, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_io_define_time(time_units, calendar, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call med_io_enddef(hist_file) + call med_io_write_time(time_val, time_bnds, nt=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if - do n = 1,ncomps - if (is_local%wrap%comp_present(n)) then - if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(n,n),rc=rc)) then - nx = is_local%wrap%nx(n) - ny = is_local%wrap%ny(n) - call med_io_write(hist_file, iam, is_local%wrap%FBimp(n,n), & - nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre=trim(compname(n))//'Imp', rc=rc) + ! Write import and export field bundles + if (is_local%wrap%comp_present(compid)) then + nx = is_local%wrap%nx(compid) + ny = is_local%wrap%ny(compid) + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(compid,compid),rc=rc)) then + call med_io_write(hist_file, avgfile%FBaccum_import, whead(m), wdata(m), nx, ny, & + nt=1, pre=trim(compname(compid))//'Imp', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (wdata(m)) then + call med_methods_FB_reset(avgfile%FBAccum_import, czero, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if endif - if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(n),rc=rc)) then - nx = is_local%wrap%nx(n) - ny = is_local%wrap%ny(n) - call med_io_write(hist_file, iam, is_local%wrap%FBexp(n), & - nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre=trim(compname(n))//'Exp', rc=rc) + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(compid),rc=rc)) then + call med_io_write(hist_file, avgfile%FBaccum_export, whead(m), wdata(m), nx, ny, & + nt=1, pre=trim(compname(compid))//'Exp', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (wdata(m)) then + call med_methods_FB_reset(avgfile%FBAccum_export, czero, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if endif - ! write component mediator fractions - if (ESMF_FieldBundleIsCreated(is_local%wrap%FBFrac(n),rc=rc)) then - nx = is_local%wrap%nx(n) - ny = is_local%wrap%ny(n) - call med_io_write(hist_file, iam, is_local%wrap%FBFrac(n), & - nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre='Med_frac_'//trim(compname(n)), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end do ! end of loop over m + + ! Close file + call med_io_close(hist_file, vm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + end if ! end of write_now if-block + end if ! end of clock created if-block + + call t_stopf('MED:'//subname) + + end subroutine med_phases_history_write_comp_avg + + !=============================================================================== + subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc) + + ! ----------------------------- + ! Write mediator auxiliary history file for auxcomp component + ! Initialize auxiliary history file + ! Each time this routine is called the routine SetRunClock in med.F90 is called + ! at the beginning and the mediator clock current time and time step is set to the + ! driver current time and time step + ! ----------------------------- + + use ESMF , only : ESMF_FieldBundleIsCreated, ESMF_FieldBundleRemove + use med_constants_mod, only : czero => med_constants_czero + use med_io_mod , only : med_io_write_time, med_io_define_time + use med_methods_mod , only : med_methods_FB_init + use med_methods_mod , only : med_methods_FB_reset + use med_methods_mod , only : med_methods_FB_fldchk + + ! input/output variables + type(ESMF_GridComp) , intent(inout) :: gcomp + integer , intent(in) :: compid + type(auxcomp_type) , intent(inout) :: auxcomp + integer , intent(out) :: rc + + ! local variables + type(InternalState) :: is_local + type(ESMF_VM) :: vm + type(ESMF_Calendar) :: calendar ! calendar type + logical :: isPresent ! is attribute present + logical :: isSet ! is attribute set + character(CL) :: hist_option ! freq_option setting (ndays, nsteps, etc) + integer :: hist_n ! freq_n setting relative to freq_option + integer :: nfcnt + integer :: nfile + integer :: nfld + integer :: n,n1,nf + character(CL) :: prefix + character(CL) :: cvalue + character(CL) :: auxflds + integer :: fieldCount + logical :: found + logical :: enable_auxfile + character(CS) :: timestr ! yr-mon-day-sec string + character(CL) :: time_units ! units of time variable + integer :: nx,ny ! global grid size + logical :: write_now ! if true, write time sample to file + integer :: yr,mon,day,sec ! time units + real(r8) :: time_val ! time coordinate output + real(r8) :: time_bnds(2) ! time bounds output + character(CS), allocatable :: fieldNameList(:) + character(len=*), parameter :: subname='(med_phases_history_write_comp_aux)' + !--------------------------------------- + + rc = ESMF_SUCCESS + call t_startf('MED:'//subname) + + ! Get the internal state + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (.not. auxcomp%init_auxfiles) then + + ! Initialize number of aux files for this component to zero + nfcnt = 0 + do nfile = 1,max_auxfiles + ! Determine attribute prefix + write(prefix,'(a,i0)') 'histaux_'//trim(compname(compid))//'2med_file',nfile + + ! Determine if will write the file + call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_enabled', isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_enabled', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,'(l)') enable_auxfile + else + enable_auxfile = .false. + end if + + ! If file will be written - then initialize auxcomp%files(nfcnt) + if (enable_auxfile) then + ! Increment nfcnt + nfcnt = nfcnt + 1 + + ! Determine number of time samples per file + call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_ntperfile', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) auxcomp%files(nfcnt)%ntperfile + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Determine if will do time average for aux file + call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_doavg', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) auxcomp%files(nfcnt)%doavg + + ! Determine the colon delimited field names for this file + call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_flds', value=auxflds, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Determine fields that will be output to auxhist files + if (trim(auxflds) == 'all') then + + ! Output all fields sent to the mediator from ncomp to the auxhist files + call ESMF_FieldBundleGet(is_local%wrap%FBImp(compid,compid), fieldCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(auxcomp%files(nfcnt)%flds(fieldcount)) + call ESMF_FieldBundleGet(is_local%wrap%FBImp(compid,compid), fieldNameList=auxcomp%files(nfcnt)%flds, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + else + + ! Translate the colon deliminted string (auxflds) into a character array (fieldnamelist) + ! Note that the following call allocates the memory for fieldnamelist + call get_auxflds(auxflds, fieldnamelist, rc) + + ! TODO: print warning statement if remove field + ! TODO: if request field that is NOT in the field definition file - then quit + ! Remove all fields from fieldnamelist that are not in FBImp(compid,compid) + fieldCount = size(fieldnamelist) + do n = 1,fieldcount + if (.not. med_methods_FB_fldchk(is_local%wrap%FBImp(compid,compid), trim(fieldnamelist(n)), rc)) then + do n1 = n, fieldCount-1 + fieldnamelist(n1) = fieldnamelist(n1+1) + end do + fieldCount = fieldCount - 1 + end if + end do + + ! Create auxcomp%files(nfcnt)%flds array + allocate(auxcomp%files(nfcnt)%flds(fieldcount)) + do n = 1,fieldcount + auxcomp%files(nfcnt)%flds(n) = trim(fieldnamelist(n)) + end do + + ! Deallocate memory from fieldnamelist + deallocate(fieldnamelist) ! this was allocated in med_phases_history_get_auxflds + + end if ! end of if auxflds is set to 'all' + + if (mastertask) then + write(logunit,*) + write(logunit,'(a,i4,a)') trim(subname) // ' Writing the following fields to auxfile ',nfcnt,& + ' for component '//trim(compname(compid)) + do nfld = 1,size(auxcomp%files(nfcnt)%flds) + write(logunit,'(8x,a)') trim(auxcomp%files(nfcnt)%flds(nfld)) + end do + end if + + ! Create FBaccum if averaging is on + if (auxcomp%files(nfcnt)%doavg) then + + ! First duplicate all fields in FBImp(compid,compid) + call ESMF_LogWrite(trim(subname)// ": initializing FBaccum(compid)", ESMF_LOGMSG_INFO) + if ( ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compid,compid)) .and. .not. & + ESMF_FieldBundleIsCreated(auxcomp%files(nfcnt)%FBaccum)) then + call med_methods_FB_init(auxcomp%files(nfcnt)%FBaccum, is_local%wrap%flds_scalar_name, & + FBgeom=is_local%wrap%FBImp(compid,compid), FBflds=is_local%wrap%FBImp(compid,compid), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call med_methods_FB_reset(auxcomp%files(nfcnt)%FBaccum, czero, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + auxcomp%files(nfcnt)%accumcnt = 0 + end if + + ! Now remove all fields from FBAccum that are not in the input flds list + call ESMF_FieldBundleGet(is_local%wrap%FBImp(compid,compid), fieldCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(fieldNameList(fieldCount)) + call ESMF_FieldBundleGet(is_local%wrap%FBImp(compid,compid), fieldNameList=fieldNameList, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + do n = 1,size(fieldnamelist) + found = .false. + do n1 = 1,size(auxcomp%files(nfcnt)%flds) + if (trim(fieldnamelist(n)) == trim(auxcomp%files(nfcnt)%flds(n1))) then + found = .true. + exit + end if + end do + if (.not. found) then + call ESMF_FieldBundleRemove(auxcomp%files(nfcnt)%FBaccum, fieldnamelist(n:n), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + end do + deallocate(fieldnameList) + + ! Check that FBAccum has at least one field left - if not exit + call ESMF_FieldBundleGet(auxcomp%files(nfcnt)%FBAccum, fieldCount=nfld, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (nfld == 0) then + call ESMF_LogWrite(subname//'FBAccum is zero for '//trim(auxcomp%files(nfcnt)%auxname), & + ESMF_LOGMSG_ERROR) + rc = ESMF_FAILURE + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) then + call ESMF_Finalize(endflag=ESMF_END_ABORT) + end if end if - ! write component mediator areas - nx = is_local%wrap%nx(n) - ny = is_local%wrap%ny(n) - call med_io_write(hist_file, iam, is_local%wrap%FBArea(n), & - nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre='MED_'//trim(compname(n)), rc=rc) + end if - enddo - if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o,rc=rc)) then - nx = is_local%wrap%nx(compocn) - ny = is_local%wrap%ny(compocn) - call med_io_write(hist_file, iam, is_local%wrap%FBMed_ocnalb_o, & - nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre='Med_alb_ocn', rc=rc) + + ! Determine auxiliary file output frequency and type + call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_history_option', value=hist_option, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_history_n', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) hist_n + + ! Determine alarmname + call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_auxname', value=auxcomp%files(nfcnt)%auxname, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(auxcomp%files(nfcnt)%alarmname,'(a,i0)') 'alarm_'//trim(prefix) + + ! Initialize clock and alarm for instantaneous history output + call med_phases_history_init_histclock(gcomp, auxcomp%files(nfcnt)%clock, & + auxcomp%files(nfcnt)%alarm, auxcomp%files(nfcnt)%alarmname, hist_option, hist_n, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + end if ! end of isPresent and isSet and if flag is on for file n + end do ! end of loop over nfile + + ! Set number of aux files for this component - this is a module variable + auxcomp%num_auxfiles = nfcnt + + ! Set initialization flags to .true. + auxcomp%init_auxfiles = .true. + + end if ! end of initialization if-block + + ! Write auxiliary history files for component compid + do nf = 1,auxcomp%num_auxfiles + + ! Determine if will write to history file + call med_phases_history_query_ifwrite(gcomp, auxcomp%files(nf)%clock, auxcomp%files(nf)%alarmname, write_now, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Do accumulation and average if required + if (auxcomp%files(nf)%doavg) then + call med_phases_history_fldbun_accum(is_local%wrap%FBImp(compid,compid), & + auxcomp%files(nf)%FBaccum, auxcomp%files(nf)%accumcnt, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (write_now) then + call med_phases_history_fldbun_average(auxcomp%files(nf)%FBaccum, auxcomp%files(nf)%accumcnt, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + end if + + ! Write time sample to file + if ( write_now ) then + + ! Determine time_val and tbnds data for history as well as history file name + call med_phases_history_set_timeinfo(gcomp, auxcomp%files(nf)%clock, auxcomp%files(nf)%alarmname, & + time_val, time_bnds, time_units, auxcomp%files(nf)%histfile, auxcomp%files(nf)%doavg, & + auxname=auxcomp%files(nf)%auxname, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Set shorthand variables + nx = is_local%wrap%nx(compid) + ny = is_local%wrap%ny(compid) + + ! Increment number of time samples on file + auxcomp%files(nf)%nt = auxcomp%files(nf)%nt + 1 + + ! Write header + if (auxcomp%files(nf)%nt == 1) then + ! open file + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_io_wopen(auxcomp%files(nf)%histfile, vm, file_ind=nf, clobber=.true.) + + ! define time variables + call ESMF_ClockGet(auxcomp%files(nf)%clock, calendar=calendar, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_io_define_time(time_units, calendar, file_ind=nf, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! define data variables with a time dimension (include the nt argument below) + call med_io_write(auxcomp%files(nf)%histfile, is_local%wrap%FBimp(compid,compid), & + whead(1), wdata(1), nx, ny, nt=auxcomp%files(nf)%nt, & + pre=trim(compname(compid))//'Imp', flds=auxcomp%files(nf)%flds, & + file_ind=nf, use_float=.true., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! end definition phase + call med_io_enddef(auxcomp%files(nf)%histfile, file_ind=nf) end if - if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_o,rc=rc) .and. & - ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compatm,compocn))) then - ! This provides the atm input on the ocn mesh needed for that atm/ocn calculation - ! that currently is restricted to the ocn mesh - nx = is_local%wrap%nx(compocn) - ny = is_local%wrap%ny(compocn) - call med_io_write(hist_file, iam, is_local%wrap%FBImp(compatm,compocn), & - nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre='AtmImp_ocn', rc=rc) + + ! Write time variables for time nt + call med_io_write_time(time_val, time_bnds, nt=auxcomp%files(nf)%nt, file_ind=nf, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Write data variables for time nt + if (auxcomp%files(nf)%doavg) then + call med_io_write(auxcomp%files(nf)%histfile, auxcomp%files(nf)%FBaccum, whead(2), wdata(2), nx, ny, & + nt=auxcomp%files(nf)%nt, pre=trim(compname(compid))//'Imp', flds=auxcomp%files(nf)%flds, file_ind=nf, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_methods_FB_reset(auxcomp%files(nf)%FBaccum, value=czero, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call med_io_write(auxcomp%files(nf)%histfile, is_local%wrap%FBimp(compid,compid), whead(2), wdata(2), nx, ny, & + nt=auxcomp%files(nf)%nt, pre=trim(compname(compid))//'Imp', flds=auxcomp%files(nf)%flds, file_ind=nf, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_o,rc=rc)) then - nx = is_local%wrap%nx(compocn) - ny = is_local%wrap%ny(compocn) - call med_io_write(hist_file, iam, is_local%wrap%FBMed_aoflux_o, & - nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre='Med_aoflux_ocn', rc=rc) + + ! Close file + if (auxcomp%files(nf)%nt == auxcomp%files(nf)%ntperfile) then + call med_io_close(auxcomp%files(nf)%histfile, vm, file_ind=nf, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + auxcomp%files(nf)%nt = 0 end if - if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_a,rc=rc)) then - nx = is_local%wrap%nx(compatm) - ny = is_local%wrap%ny(compatm) - call med_io_write(hist_file, iam, is_local%wrap%FBMed_ocnalb_a, & - nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre='Med_alb_atm', rc=rc) + + end if ! end of write_now if-block + + end do + call t_stopf('MED:'//subname) + + contains + + subroutine get_auxflds(str, flds, rc) + ! input/output variables + character(len=*) , intent(in) :: str ! colon deliminted string to search + character(len=*) , allocatable , intent(out) :: flds(:) ! memory will be allocate for flds + integer , intent(out) :: rc + ! local variables + integer :: i,k,n ! generic indecies + integer :: nflds ! allocatable size of flds + integer :: count ! counts occurances of char + integer :: kFlds ! number of fields in list + integer :: i0,i1 ! name = list(i0:i1) + integer :: nChar ! temporary + logical :: valid ! check if str is valid + !--------------------------------------- + rc = ESMF_SUCCESS + + ! check that this is a str is a valid colon dlimited list + valid = .true. + nChar = len_trim(str) + if (nChar < 1) then ! list is an empty string + valid = .false. + else if (str(1:1) == ':') then ! first char is delimiter + valid = .false. + else if (str(nChar:nChar) == ':') then ! last char is delimiter + valid = .false. + else if (index(trim(str)," ") > 0) then ! white-space in a field name + valid = .false. + end if + if (.not. valid) then + if (mastertask) write(logunit,*) "ERROR: invalid list = ",trim(str) + call ESMF_LogWrite("ERROR: invalid list = "//trim(str), ESMF_LOGMSG_ERROR) + rc = ESMF_FAILURE + return + end if + ! get number of fields in a colon delimited string list + nflds = 0 + if (len_trim(str) > 0) then + count = 0 + do n = 1, len_trim(str) + if (str(n:n) == ':') count = count + 1 + end do + nflds = count + 1 + endif + ! allocate memory for flds) + allocate(flds(nflds)) + do k = 1,nflds + ! start with whole list + i0 = 1 + i1 = len_trim(str) + ! remove field names before kth field + do n = 2,k + i = index(str(i0:i1),':') + i0 = i0 + i + end do + ! remove field names after kth field + if (k < nFlds) then + i = index(str(i0:i1),':') + i1 = i0 + i - 2 + end if + ! set flds(k) + flds(k) = str(i0:i1)//" " + end do + end subroutine get_auxflds + + end subroutine med_phases_history_write_comp_aux + + !=============================================================================== + subroutine med_phases_history_fldbun_accum(fldbun, fldbun_accum, count, rc) + + use ESMF, only : ESMF_Field, ESMF_FieldGet + + ! input/output variables + type(ESMF_FieldBundle) , intent(in) :: fldbun + type(ESMF_FieldBundle) , intent(inout) :: fldbun_accum + integer , intent(out) :: count + integer , intent(out) :: rc + + ! local variables + integer :: n + type(ESMF_Field) :: lfield + type(ESMF_Field) :: lfield_accum + integer :: fieldCount + character(CL), pointer :: fieldnames(:) + real(r8), pointer :: dataptr1d(:) + real(r8), pointer :: dataptr2d(:,:) + real(r8), pointer :: dataptr1d_accum(:) + real(r8), pointer :: dataptr2d_accum(:,:) + integer :: ungriddedUBound(1) + !--------------------------------------- + + rc = ESMF_SUCCESS + + ! Accumulate field + call ESMF_FieldBundleGet(fldbun_accum, fieldCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(fieldnames(fieldCount)) + call ESMF_FieldBundleGet(fldbun_accum, fieldNameList=fieldnames, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + do n = 1, fieldcount + call ESMF_FieldBundleGet(fldbun, fieldName=trim(fieldnames(n)), field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleGet(fldbun_accum, fieldName=trim(fieldnames(n)), field=lfield_accum, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, ungriddedUBound=ungriddedUBound, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (ungriddedUBound(1) > 0) then + call ESMF_FieldGet(lfield, farrayptr=dataptr2d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield_accum, farrayptr=dataptr2d_accum, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + dataptr2d_accum(:,:) = dataptr2d_accum(:,:) + dataptr2d(:,:) + else + call ESMF_FieldGet(lfield, farrayptr=dataptr1d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield_accum, farrayptr=dataptr1d_accum, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + dataptr1d_accum(:) = dataptr1d_accum(:) + dataptr1d(:) + end if + end do + deallocate(fieldnames) + + ! Accumulate counter + count = count + 1 + + end subroutine med_phases_history_fldbun_accum + + !=============================================================================== + subroutine med_phases_history_fldbun_average(fldbun_accum, count, rc) + + use ESMF , only : ESMF_Field, ESMF_FieldGet + use med_constants_mod , only : czero => med_constants_czero + + ! input/output variables + type(ESMF_FieldBundle) , intent(inout) :: fldbun_accum + integer , intent(inout) :: count + integer , intent(out) :: rc + + ! local variables + integer :: n,i + type(ESMF_Field) :: lfield_accum + integer :: fieldCount + character(CL), pointer :: fieldnames(:) + real(r8), pointer :: dataptr1d_accum(:) + real(r8), pointer :: dataptr2d_accum(:,:) + integer :: ungriddedUBound(1) + !--------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_FieldBundleGet(fldbun_accum, fieldCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(fieldnames(fieldCount)) + call ESMF_FieldBundleGet(fldbun_accum, fieldNameList=fieldnames, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + do n = 1, fieldcount + call ESMF_FieldBundleGet(fldbun_accum, fieldName=trim(fieldnames(n)), field=lfield_accum, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield_accum, ungriddedUBound=ungriddedUBound, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (ungriddedUBound(1) > 0) then + call ESMF_FieldGet(lfield_accum, farrayptr=dataptr2d_accum, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (count == 0) then + dataptr2d_accum(:,:) = czero + else + dataptr2d_accum(:,:) = dataptr2d_accum(:,:) / real(count, r8) end if - if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a,rc=rc)) then - nx = is_local%wrap%nx(compatm) - ny = is_local%wrap%ny(compatm) - call med_io_write(hist_file, iam, is_local%wrap%FBMed_aoflux_a, & - nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre='Med_aoflux_atm', rc=rc) + else + call ESMF_FieldGet(lfield_accum, farrayptr=dataptr1d_accum, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (count == 0) then + dataptr1d_accum(:) = czero + else + dataptr1d_accum(:) = dataptr1d_accum(:) / real(count, r8) end if - enddo + end if + end do + deallocate(fieldnames) + + ! Reset counter + count = 0 + + end subroutine med_phases_history_fldbun_average + + !=============================================================================== + subroutine med_phases_history_init_histclock(gcomp, hclock, alarm, alarmname, hist_option, hist_n, rc) + + use NUOPC_Mediator, only : NUOPC_MediatorGet + use ESMF , only : ESMF_ClockCreate, ESMF_ClockGet, ESMF_ClockSet + use med_time_mod , only : med_time_alarmInit + + ! input/output variables + type(ESMF_GridComp) , intent(in) :: gcomp + type(ESMF_Clock) , intent(inout) :: hclock + type(ESMF_Alarm) , intent(inout) :: alarm + character(len=*) , intent(in) :: alarmname + character(len=*) , intent(in) :: hist_option ! freq_option setting (ndays, nsteps, etc) + integer , intent(in) :: hist_n ! freq_n setting relative to freq_option + integer , intent(out) :: rc + + ! local variables + type(ESMF_Clock) :: mclock, dclock + type(ESMF_Time) :: StartTime + type(ESMF_TimeInterval) :: htimestep + type(ESMF_TimeInterval) :: mtimestep, dtimestep + integer :: msec, dsec + character(len=*), parameter :: subname='(med_phases_history_init_histclock) ' + !--------------------------------------- + + rc = ESMF_SUCCESS + + call NUOPC_MediatorGet(gcomp, mediatorClock=mClock, driverClock=dClock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ClockGet(mclock, timeStep=mtimestep, starttime=starttime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeIntervalGet(mtimestep, s=msec, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ClockGet(dclock, timeStep=dtimestep, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeIntervalGet(dtimestep, s=dsec, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (mastertask) then + write(logunit,'(a,2x,i8,2x,i8)') trim(subname) // " mediator, driver timesteps for " & + //trim(alarmname),msec,dsec + end if - call med_io_close(hist_file, iam, rc=rc) + ! Create history clock from mediator clock - THIS CALL DOES NOT COPY ALARMS + hclock = ESMF_ClockCreate(mclock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Initialize history alarm and advance history clock to trigger + ! alarms then reset history clock back to mcurrtime + call med_time_alarmInit(hclock, alarm, option=hist_option, opt_n=hist_n, & + reftime=StartTime, alarmname=trim(alarmname), advance_clock=.true., rc=rc) + + ! Write diagnostic info + if (mastertask) then + write(logunit,'(a,2x,i8)') trim(subname) // " initialized history alarm "//& + trim(alarmname)//" with option "//trim(hist_option)//" and frequency ",hist_n + end if + + end subroutine med_phases_history_init_histclock + + !=============================================================================== + subroutine med_phases_history_query_ifwrite(gcomp, hclock, alarmname, write_now, rc) + + use NUOPC_Mediator, only : NUOPC_MediatorGet + + ! input/output variables + type(ESMF_GridComp) , intent(in) :: gcomp + type(ESMF_Clock) , intent(inout) :: hclock ! write clock + character(len=*) , intent(in) :: alarmname ! write alarmname + logical , intent(out) :: write_now ! if true => write now + integer , intent(out) :: rc ! error code + + ! local variables + type(ESMF_Clock) :: mclock ! mediator clock + type(ESMF_Alarm) :: alarm ! write alarm + type(ESMF_Time) :: currtime ! current time + character(len=CS) :: currtimestr ! current time string + type(ESMF_Time) :: nexttime ! next time + character(len=CS) :: nexttimestr ! next time string + integer :: yr,mon,day,sec ! time units + type(ESMF_TimeInterval) :: ringInterval + integer :: ringInterval_length + character(len=*), parameter :: subname='(med_phases_history_query_ifwrite) ' + !--------------------------------------- + + rc = ESMF_SUCCESS + + ! Update hclock to trigger alarm + call ESMF_ClockAdvance(hclock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Get the history file alarm and determine if alarm is ringing + call ESMF_ClockGetAlarm(hclock, alarmname=trim(alarmname), alarm=alarm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Set write_now flag and turn ringer off if appropriate + if (ESMF_AlarmIsRinging(alarm, rc=rc)) then + if (ChkErr(rc,__LINE__,u_FILE_u)) return + write_now = .true. + call ESMF_AlarmRingerOff(alarm, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + write_now = .false. + end if + + ! Write diagnostic output + if (write_now) then + if (mastertask .and. debug_alarms) then + ! output alarm info + call ESMF_AlarmGet(alarm, ringInterval=ringInterval, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeIntervalGet(ringInterval, s=ringinterval_length, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ClockGet(hclock, currtime=currtime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeGet(currtime,yy=yr, mm=mon, dd=day, s=sec, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(currtimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + call ESMF_ClockGetNextTime(hclock, nextTime=nexttime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeGet(nexttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(nexttimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec - endif + if (mastertask) then + write(logunit,*) + write(logunit,'(a,i8)') trim(subname)//" : history alarmname "//trim(alarmname)//& + ' is ringing, interval length is ', ringInterval_length + write(logunit,'(a)') trim(subname)//" : hclock currtime = "//trim(currtimestr)//& + " hclock nexttime = "//trim(nexttimestr) + end if - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) - endif - call t_stopf('MED:'//subname) + call NUOPC_MediatorGet(gcomp, mediatorClock=mClock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockGet(mclock, currtime=currtime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeGet(currtime,yy=yr, mm=mon, dd=day, s=sec, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(currtimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + + call ESMF_ClockGetNextTime(mclock, nextTime=nexttime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeGet(nexttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(nexttimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec - first_time = .false. + if (mastertask) then + write(logunit,'(a)') trim(subname)//" : mclock currtime = "//trim(currtimestr)//& + " mclock nexttime = "//trim(nexttimestr) + end if - end subroutine med_phases_history_write + end if + end if + + end subroutine med_phases_history_query_ifwrite !=============================================================================== + subroutine med_phases_history_set_timeinfo(gcomp, hclock, alarmname, & + time_val, time_bnds, time_units, histfile, doavg, auxname, compname, rc) + + use NUOPC_Mediator , only : NUOPC_MediatorGet + use ESMF , only : ESMF_GridComp, ESMF_Clock, ESMF_Alarm, ESMF_Time, ESMF_TimeInterval + use ESMF , only : ESMF_ClockGet, ESMF_ClockGetNextTime, ESMF_ClockGetAlarm + use ESMF , only : ESMF_AlarmGet, ESMF_TimeIntervalGet, ESMF_TimeGet + use med_constants_mod , only : SecPerDay => med_constants_SecPerDay + use med_io_mod , only : med_io_ymd2date, med_io_date2yyyymmdd, med_io_sec2hms + + ! input/output variables + type(ESMF_GridComp) , intent(in) :: gcomp + type(ESMF_Clock) , intent(in) :: hclock + character(len=*) , intent(in) :: alarmname + real(r8) , intent(out) :: time_val + real(r8) , intent(out) :: time_bnds(2) + character(len=*) , intent(out) :: time_units + character(len=*) , intent(out) :: histfile + logical , intent(in) :: doavg + character(len=*) , optional , intent(in) :: auxname + character(len=*) , optional , intent(in) :: compname + integer , intent(out) :: rc + + ! local variables + type(ESMF_Clock) :: mclock + type(ESMF_Alarm) :: alarm + type(ESMF_Time) :: starttime + type(ESMF_Time) :: currtime + type(ESMF_Time) :: nexttime + type(ESMF_TimeInterval) :: ringInterval ! alarm interval + type(ESMF_TimeInterval) :: timediff(2) ! time bounds upper and lower relative to start + character(len=CL) :: currtime_str + character(len=CL) :: nexttime_str + character(len=CL) :: hist_str + integer :: yr,mon,day,sec ! time units + integer :: start_ymd ! Starting date YYYYMMDD + logical :: isPresent + logical :: isSet + character(len=*), parameter :: subname='(med_phases_history_set_timeinfo) ' + !--------------------------------------- + + rc = ESMF_SUCCESS + + ! Determine starttime, currtime and nexttime from the mediator clock rather than the input history clock + call NUOPC_MediatorGet(gcomp, mediatorClock=mClock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockGet(mclock, currtime=currtime, starttime=starttime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockGetNextTime(mclock, nextTime=nexttime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Determine time units + call ESMF_TimeGet(starttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_io_ymd2date(yr,mon,day,start_ymd) + time_units = 'days since ' // trim(med_io_date2yyyymmdd(start_ymd)) // ' ' // med_io_sec2hms(sec, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Set time bounds and time coord + if (doavg) then + call ESMF_ClockGetAlarm(hclock, alarmname=trim(alarmname), alarm=alarm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_AlarmGet(alarm, ringInterval=ringInterval, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + timediff(2) = nexttime - starttime + timediff(1) = nexttime - starttime - ringinterval + call ESMF_TimeIntervalGet(timediff(2), d_r8=time_bnds(2), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeIntervalGet(timediff(1), d_r8=time_bnds(1), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + time_val = 0.5_r8 * (time_bnds(1) + time_bnds(2)) + else + timediff(1) = nexttime - starttime + call ESMF_TimeIntervalGet(timediff(1), d=day, s=sec, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + time_val = day + sec/real(SecPerDay,R8) + time_bnds(1) = time_val + time_bnds(2) = time_val + end if + + ! Determine history file name + ! Use nexttime_str rather than currtime_str here since that is the time at the end of + ! the timestep and is preferred for history file names + + call ESMF_TimeGet(nexttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(nexttime_str,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + + if (trim(case_name) == 'unset') then + call NUOPC_CompAttributeGet(gcomp, name='case_name', value=case_name, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(gcomp, name='inst_suffix', isPresent=isPresent, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if(isPresent) then + call NUOPC_CompAttributeGet(gcomp, name='inst_suffix', value=inst_tag, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + inst_tag = "" + endif + end if + + if (present(auxname)) then + write(histfile, "(8a)") trim(case_name),'.cpl' ,trim(inst_tag),'.hx.',trim(auxname),'.',& + trim(nexttime_str),'.nc' + else if (present(compname)) then + if (doavg) then + hist_str = '.ha.' + else + hist_str = '.hi.' + end if + if (trim(compname) /= 'all') then + hist_str = trim(hist_str) // trim(compname) // '.' + end if + write(histfile, "(6a)") trim(case_name),'.cpl',trim(inst_tag),trim(hist_str),trim(nexttime_str),'.nc' + end if + + if (mastertask) then + call ESMF_TimeGet(currtime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(currtime_str,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + write(logunit,*) + write(logunit,' (a)') trim(subname) // " writing mediator history file "//trim(histfile) + write(logunit,' (a)') trim(subname) // " currtime = "//trim(currtime_str)//" nexttime = "//trim(nexttime_str) + end if + + end subroutine med_phases_history_set_timeinfo end module med_phases_history_mod diff --git a/mediator/med_phases_ocnalb_mod.F90 b/mediator/med_phases_ocnalb_mod.F90 index 1cd819ac8..c9c4d76fe 100644 --- a/mediator/med_phases_ocnalb_mod.F90 +++ b/mediator/med_phases_ocnalb_mod.F90 @@ -94,11 +94,11 @@ subroutine med_phases_ocnalb_init(gcomp, ocnalb, rc) integer :: spatialDim integer :: numOwnedElements type(InternalState) :: is_local - real(R8), pointer :: ownedElemCoords(:) => null() + real(R8), pointer :: ownedElemCoords(:) character(len=CL) :: tempc1,tempc2 logical :: mastertask integer :: fieldCount - type(ESMF_Field), pointer :: fieldlist(:) => null() + type(ESMF_Field), pointer :: fieldlist(:) character(*), parameter :: subname = '(med_phases_ocnalb_init) ' !----------------------------------------------------------------------- @@ -232,10 +232,10 @@ subroutine med_phases_ocnalb_run(gcomp, rc) character(CL) :: runtype ! initial, continue, hybrid, branch logical :: flux_albav ! flux avg option real(R8) :: nextsw_cday ! calendar day of next atm shortwave - real(R8), pointer :: ofrac(:) => null() - real(R8), pointer :: ofrad(:) => null() - real(R8), pointer :: ifrac(:) => null() - real(R8), pointer :: ifrad(:) => null() + real(R8), pointer :: ofrac(:) + real(R8), pointer :: ofrad(:) + real(R8), pointer :: ifrac(:) + real(R8), pointer :: ifrad(:) integer :: lsize ! local size integer :: n,i ! indices real(R8) :: rlat ! gridcell latitude in radians diff --git a/mediator/med_phases_post_atm_mod.F90 b/mediator/med_phases_post_atm_mod.F90 index bd6b93230..acf1c2298 100644 --- a/mediator/med_phases_post_atm_mod.F90 +++ b/mediator/med_phases_post_atm_mod.F90 @@ -22,10 +22,13 @@ subroutine med_phases_post_atm(gcomp, rc) ! map atm to ocn and atm to ice and atm to land !--------------------------------------- + use NUOPC_Mediator , only : NUOPC_MediatorGet + use ESMF , only : ESMF_Clock, ESMF_ClockIsCreated use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_FieldBundleGet use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use med_internalstate_mod , only : InternalState, mastertask, logunit + use med_phases_history_mod, only : med_phases_history_write_comp use med_map_mod , only : med_map_field_packed use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_utils_mod , only : chkerr => med_utils_ChkErr @@ -38,6 +41,7 @@ subroutine med_phases_post_atm(gcomp, rc) ! local variables type(InternalState) :: is_local + type(ESMF_Clock) :: dClock character(len=*), parameter :: subname='(med_phases_post_atm)' !------------------------------------------------------------------------------- @@ -93,6 +97,14 @@ subroutine med_phases_post_atm(gcomp, rc) call t_stopf('MED:'//trim(subname)//' map_atm2lnd') end if + ! Write atm inst, avg or aux if requested in mediator attributes + call NUOPC_MediatorGet(gcomp, driverClock=dClock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (ESMF_ClockIsCreated(dclock)) then + call med_phases_history_write_comp(gcomp, compatm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + if (dbug_flag > 20) then call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) end if diff --git a/mediator/med_phases_post_glc_mod.F90 b/mediator/med_phases_post_glc_mod.F90 index e04fc64b4..44e013641 100644 --- a/mediator/med_phases_post_glc_mod.F90 +++ b/mediator/med_phases_post_glc_mod.F90 @@ -85,11 +85,16 @@ module med_phases_post_glc_mod subroutine med_phases_post_glc(gcomp, rc) + use NUOPC_Mediator , only : NUOPC_MediatorGet + use ESMF , only : ESMF_Clock, ESMF_ClockIsCreated + use med_phases_history_mod, only : med_phases_history_write_comp + ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc ! local variables + type(ESMF_Clock) :: dClock type(ESMF_StateItem_Flag) :: itemType type(InternalState) :: is_local integer :: n1,ncnt,ns @@ -213,6 +218,16 @@ subroutine med_phases_post_glc(gcomp, rc) ! Reset first call logical first_call = .false. + ! Write glc inst, avg or aux if requested in mediator attributes + call NUOPC_MediatorGet(gcomp, driverClock=dClock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (ESMF_ClockIsCreated(dclock)) then + do ns = 1,num_icesheets + call med_phases_history_write_comp(gcomp, compglc(ns), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do + end if + if (dbug_flag > 20) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end if @@ -235,7 +250,7 @@ subroutine map_glc2lnd_init(gcomp, rc) integer :: ungriddedUBound_output(1) integer :: fieldCount integer :: ns,n - type(ESMF_Field), pointer :: fieldlist(:) => null() + type(ESMF_Field), pointer :: fieldlist(:) character(len=*) , parameter :: subname='(map_glc2lnd_init)' !--------------------------------------- @@ -353,22 +368,22 @@ subroutine map_glc2lnd( gcomp, rc) type(ESMF_Field) :: lfield_dst integer :: ec, l, g, ns, n real(r8) :: topo_virtual - real(r8), pointer :: icemask_g(:) => null() ! glc ice mask field on glc grid - real(r8), pointer :: frac_g(:) => null() ! total ice fraction in each glc cell - real(r8), pointer :: frac_g_ec(:,:) => null() ! glc fractions on the glc grid - real(r8), pointer :: frac_l_ec(:,:) => null() ! glc fractions on the land grid - real(r8), pointer :: topo_g(:) => null() ! topo height of each glc cell (no elev classes) - real(r8), pointer :: topo_l_ec(:,:) => null() ! topo height in each land gridcell for each elev class - real(r8), pointer :: frac_x_icemask_g_ec(:,:) => null() ! (glc fraction) x (icemask), on the glc grid - real(r8), pointer :: frac_x_icemask_l_ec(:,:) => null() - real(r8), pointer :: topo_x_icemask_g_ec(:,:) => null() - real(r8), pointer :: topo_x_icemask_l_ec(:,:) => null() - real(r8), pointer :: dataptr1d(:) => null() - real(r8), pointer :: dataptr2d(:,:) => null() - real(r8), pointer :: frac_l_ec_sum(:,:) => null() - real(r8), pointer :: topo_l_ec_sum(:,:) => null() - real(r8), pointer :: dataptr1d_src(:) => null() - real(r8), pointer :: dataptr1d_dst(:) => null() + real(r8), pointer :: icemask_g(:) ! glc ice mask field on glc grid + real(r8), pointer :: frac_g(:) ! total ice fraction in each glc cell + real(r8), pointer :: frac_g_ec(:,:) ! glc fractions on the glc grid + real(r8), pointer :: frac_l_ec(:,:) ! glc fractions on the land grid + real(r8), pointer :: topo_g(:) ! topo height of each glc cell (no elev classes) + real(r8), pointer :: topo_l_ec(:,:) ! topo height in each land gridcell for each elev class + real(r8), pointer :: frac_x_icemask_g_ec(:,:) ! (glc fraction) x (icemask), on the glc grid + real(r8), pointer :: frac_x_icemask_l_ec(:,:) + real(r8), pointer :: topo_x_icemask_g_ec(:,:) + real(r8), pointer :: topo_x_icemask_l_ec(:,:) + real(r8), pointer :: dataptr1d(:) + real(r8), pointer :: dataptr2d(:,:) + real(r8), pointer :: frac_l_ec_sum(:,:) + real(r8), pointer :: topo_l_ec_sum(:,:) + real(r8), pointer :: dataptr1d_src(:) + real(r8), pointer :: dataptr1d_dst(:) character(len=*), parameter :: subname = 'map_glc2lnd' !----------------------------------------------------------------------- diff --git a/mediator/med_phases_post_ice_mod.F90 b/mediator/med_phases_post_ice_mod.F90 index f605006e5..2daa4c358 100644 --- a/mediator/med_phases_post_ice_mod.F90 +++ b/mediator/med_phases_post_ice_mod.F90 @@ -18,15 +18,18 @@ module med_phases_post_ice_mod subroutine med_phases_post_ice(gcomp, rc) - use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 + use NUOPC_Mediator , only : NUOPC_MediatorGet + use ESMF , only : ESMF_Clock, ESMF_ClockIsCreated use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS use ESMF , only : ESMF_GridComp + use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_utils_mod , only : chkerr => med_utils_ChkErr use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose use med_map_mod , only : med_map_field_packed use med_fraction_mod , only : med_fraction_set use med_internalstate_mod , only : InternalState, mastertask + use med_phases_history_mod, only : med_phases_history_write_comp use esmFlds , only : compice, compatm, compocn, compwav use perf_mod , only : t_startf, t_stopf @@ -35,7 +38,8 @@ subroutine med_phases_post_ice(gcomp, rc) integer, intent(out) :: rc ! local variables - type(InternalState) :: is_local + type(InternalState) :: is_local + type(ESMF_Clock) :: dClock character(len=*),parameter :: subname='(med_phases_post_ice)' !------------------------------------------------------------------------------- @@ -94,6 +98,14 @@ subroutine med_phases_post_ice(gcomp, rc) call t_stopf('MED:'//trim(subname)//' map_ice2wav') end if + ! Write ice inst, avg or aux if requested in mediator attributes + call NUOPC_MediatorGet(gcomp, driverClock=dClock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (ESMF_ClockIsCreated(dclock)) then + call med_phases_history_write_comp(gcomp, compice, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + call t_stopf('MED:'//subname) if (dbug_flag > 20) then call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) diff --git a/mediator/med_phases_post_lnd_mod.F90 b/mediator/med_phases_post_lnd_mod.F90 index 21f4f243e..1bd416c77 100644 --- a/mediator/med_phases_post_lnd_mod.F90 +++ b/mediator/med_phases_post_lnd_mod.F90 @@ -3,11 +3,8 @@ 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 - logical :: lnd2glc_coupling - character(*), parameter :: u_FILE_u = & __FILE__ @@ -17,17 +14,21 @@ module med_phases_post_lnd_mod subroutine med_phases_post_lnd(gcomp, rc) - use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 + use NUOPC_Mediator , only : NUOPC_MediatorGet + use ESMF , only : ESMF_Clock, ESMF_ClockIsCreated use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS use ESMF , only : ESMF_GridComp + use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_utils_mod , only : chkerr => med_utils_ChkErr use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose use med_map_mod , only : med_map_field_packed use med_internalstate_mod , only : InternalState, mastertask use med_phases_prep_rof_mod , only : med_phases_prep_rof_accum - use med_phases_prep_glc_mod , only : med_phases_prep_glc_accum_lnd + use med_phases_prep_glc_mod , only : med_phases_prep_glc_accum_lnd, med_phases_prep_glc_avg + use med_phases_history_mod , only : med_phases_history_write_comp use esmFlds , only : complnd, compatm, comprof, compglc, num_icesheets + use esmFlds , only : lnd2glc_coupling, accum_lnd2glc use perf_mod , only : t_startf, t_stopf ! input/output variables @@ -36,8 +37,7 @@ subroutine med_phases_post_lnd(gcomp, rc) ! local variables type(InternalState) :: is_local - integer :: ns - logical :: first_call = .true. + type(ESMF_Clock) :: dClock character(len=*),parameter :: subname='(med_phases_post_lnd)' !------------------------------------------------------------------------------- @@ -53,93 +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_comp(gcomp, complnd, rc=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 + else - ! accumulate lnd input for glc - if (lnd2glc_coupling) then - call med_phases_prep_glc_accum_lnd(gcomp, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if + ! initialization phase - map lnd to atm + if (is_local%wrap%med_coupling_active(complnd,compatm)) then + call med_map_field_packed( & + FBSrc=is_local%wrap%FBImp(complnd,complnd), & + FBDst=is_local%wrap%FBImp(complnd,compatm), & + FBFracSrc=is_local%wrap%FBFrac(complnd), & + field_NormOne=is_local%wrap%field_normOne(complnd,compatm,:), & + packed_data=is_local%wrap%packed_data(complnd,compatm,:), & + routehandles=is_local%wrap%RH(complnd,compatm,:), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if - if (dbug_flag > 20) then - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) - end if - call t_stopf('MED:'//subname) - - end subroutine med_phases_post_lnd - - !=============================================================================== - subroutine med_phases_post_lnd_init(gcomp, rc) - - use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS - use ESMF , only : ESMF_GridComp - use med_constants_mod , only : dbug_flag => med_constants_dbug_flag - use med_utils_mod , only : chkerr => med_utils_ChkErr - use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose - use med_map_mod , only : med_map_field_packed - use med_internalstate_mod , only : InternalState, mastertask - use esmFlds , only : complnd, compatm - use perf_mod , only : t_startf, t_stopf - - ! input/output variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! local variables - type(InternalState) :: is_local - character(len=*),parameter :: subname='(med_phases_post_lnd)' - !------------------------------------------------------------------------------- - - 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 @@ -147,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 d0d00b970..c51f9eecf 100644 --- a/mediator/med_phases_post_ocn_mod.F90 +++ b/mediator/med_phases_post_ocn_mod.F90 @@ -20,13 +20,16 @@ module med_phases_post_ocn_mod subroutine med_phases_post_ocn(gcomp, rc) - use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 + use NUOPC_Mediator , only : NUOPC_MediatorGet + use ESMF , only : ESMF_Clock, ESMF_ClockIsCreated use ESMF , only : ESMF_GridComp use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS + use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use med_utils_mod , only : chkerr => med_utils_ChkErr use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_map_mod , only : med_map_field_packed use med_internalstate_mod , only : InternalState, logunit, mastertask + use med_phases_history_mod , only : med_phases_history_write_comp use med_phases_prep_glc_mod , only : med_phases_prep_glc_accum_ocn use esmFlds , only : compice, compglc, compocn, num_icesheets use perf_mod , only : t_startf, t_stopf @@ -38,6 +41,7 @@ subroutine med_phases_post_ocn(gcomp, rc) ! local variables type(InternalState) :: is_local integer :: ns + type(ESMF_Clock) :: dClock logical :: first_call = .true. character(len=*),parameter :: subname='(med_phases_post_ocn)' !--------------------------------------- @@ -83,6 +87,14 @@ subroutine med_phases_post_ocn(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if + ! Write ocn inst, avg or aux if requested in mediator attributes + call NUOPC_MediatorGet(gcomp, driverClock=dClock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (ESMF_ClockIsCreated(dclock)) then + call med_phases_history_write_comp(gcomp, compocn, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + if (dbug_flag > 20) then call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) end if diff --git a/mediator/med_phases_post_rof_mod.F90 b/mediator/med_phases_post_rof_mod.F90 index 93e73ac3e..10ca7bfc7 100644 --- a/mediator/med_phases_post_rof_mod.F90 +++ b/mediator/med_phases_post_rof_mod.F90 @@ -16,13 +16,16 @@ module med_phases_post_rof_mod subroutine med_phases_post_rof(gcomp, rc) - use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 + use NUOPC_Mediator , only : NUOPC_MediatorGet + use ESMF , only : ESMF_Clock, ESMF_ClockIsCreated use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LOGMSG_ERROR, ESMF_SUCCESS, ESMF_FAILURE use ESMF , only : ESMF_GridComp, ESMF_GridCompGet + use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use esmFlds , only : complnd, compocn, compice, compatm, comprof, ncomps, compname use med_utils_mod , only : chkerr => med_utils_ChkErr use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_internalstate_mod , only : InternalState, mastertask, logunit + use med_phases_history_mod, only : med_phases_history_write_comp use med_map_mod , only : med_map_field_packed use perf_mod , only : t_startf, t_stopf @@ -32,6 +35,7 @@ subroutine med_phases_post_rof(gcomp, rc) ! local variables type(InternalState) :: is_local + type(ESMF_Clock) :: dClock character(len=*), parameter :: subname='(med_phases_post_rof)' !--------------------------------------- @@ -86,6 +90,14 @@ subroutine med_phases_post_rof(gcomp, rc) call t_stopf('MED:'//trim(subname)//' map_rof2ice') end if + ! Write rof inst, avg or aux if requested in mediator attributes + call NUOPC_MediatorGet(gcomp, driverClock=dClock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (ESMF_ClockIsCreated(dclock)) then + call med_phases_history_write_comp(gcomp, comprof, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + if (dbug_flag > 20) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end if diff --git a/mediator/med_phases_post_wav_mod.F90 b/mediator/med_phases_post_wav_mod.F90 index feb1c8515..a1bf805ef 100644 --- a/mediator/med_phases_post_wav_mod.F90 +++ b/mediator/med_phases_post_wav_mod.F90 @@ -14,14 +14,17 @@ module med_phases_post_wav_mod subroutine med_phases_post_wav(gcomp, rc) - use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 + use NUOPC_Mediator , only : NUOPC_MediatorGet + use ESMF , only : ESMF_Clock, ESMF_ClockIsCreated use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS use ESMF , only : ESMF_GridComp + use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_utils_mod , only : chkerr => med_utils_ChkErr use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose use med_map_mod , only : med_map_field_packed use med_internalstate_mod , only : InternalState, mastertask + use med_phases_history_mod, only : med_phases_history_write_comp use esmFlds , only : compwav, compatm, compocn, compice use perf_mod , only : t_startf, t_stopf @@ -30,7 +33,8 @@ subroutine med_phases_post_wav(gcomp, rc) integer, intent(out) :: rc ! local variables - type(InternalState) :: is_local + type(InternalState) :: is_local + type(ESMF_Clock) :: dClock character(len=*),parameter :: subname='(med_phases_post_wav)' !------------------------------------------------------------------------------- @@ -80,6 +84,14 @@ subroutine med_phases_post_wav(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if + ! Write atm inst, avg or aux if requested in mediator attributes + call NUOPC_MediatorGet(gcomp, driverClock=dClock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (ESMF_ClockIsCreated(dclock)) then + call med_phases_history_write_comp(gcomp, compwav, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + call t_stopf('MED:'//subname) if (dbug_flag > 20) then call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index e26f3b5f1..76c8b1e83 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -42,10 +42,10 @@ subroutine med_phases_prep_atm(gcomp, rc) type(ESMF_Field) :: lfield character(len=64) :: timestr type(InternalState) :: is_local - real(R8), pointer :: dataPtr1(:) => null() - real(R8), pointer :: dataPtr2(:) => null() - real(R8), pointer :: ifrac(:) => null() - real(R8), pointer :: ofrac(:) => null() + real(R8), pointer :: dataPtr1(:) + real(R8), pointer :: dataPtr2(:) + real(R8), pointer :: ifrac(:) + real(R8), pointer :: ofrac(:) integer :: i, j, n, n1, ncnt character(len=*),parameter :: subname='(med_phases_prep_atm)' !------------------------------------------------------------------------------- @@ -108,22 +108,27 @@ 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 !--------------------------------------- !--- merge all fields to atm !--------------------------------------- if (trim(coupling_mode) == 'cesm' .or. trim(coupling_mode) == 'hafs') then - call med_merge_auto(compatm, & + call med_merge_auto(& is_local%wrap%med_coupling_active(:,compatm), & is_local%wrap%FBExp(compatm), & is_local%wrap%FBFrac(compatm), & @@ -133,7 +138,7 @@ subroutine med_phases_prep_atm(gcomp, rc) FBMed2=is_local%wrap%FBMed_aoflux_a, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else if (trim(coupling_mode) == 'nems_frac' .or. trim(coupling_mode) == 'nems_orig') then - call med_merge_auto(compatm, & + call med_merge_auto(& is_local%wrap%med_coupling_active(:,compatm), & is_local%wrap%FBExp(compatm), & is_local%wrap%FBFrac(compatm), & @@ -193,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 4c0879a2c..890bb5501 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,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 + 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 @@ -34,6 +36,7 @@ module med_phases_prep_glc_mod use med_methods_mod , only : fldbun_getdata1d => med_methods_FB_getdata1d use med_methods_mod , only : fldbun_diagnose => med_methods_FB_diagnose use med_methods_mod , only : fldbun_reset => med_methods_FB_reset + use med_methods_mod , only : fldbun_init => med_methods_FB_init use med_methods_mod , only : field_getdata2d => med_methods_Field_getdata2d use med_methods_mod , only : field_getdata1d => med_methods_Field_getdata1d use med_utils_mod , only : chkerr => med_utils_ChkErr @@ -48,11 +51,12 @@ module med_phases_prep_glc_mod implicit none private + public :: med_phases_prep_glc_init ! called from med.F90 + 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 - 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 - private :: med_phases_prep_glc_init private :: med_phases_prep_glc_map_lnd2glc private :: med_phases_prep_glc_renormalize_smb @@ -70,49 +74,48 @@ 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(:) ! 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__ @@ -132,22 +135,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(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 + 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(:,:) + real(r8), pointer :: data2d_out(:,:) + 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) ' !--------------------------------------- @@ -162,90 +165,12 @@ 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 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 + ! If will accumulate lnd2glc input on land grid ! ------------------------------- - 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 - 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) @@ -259,41 +184,47 @@ 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 + 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 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) @@ -310,9 +241,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 @@ -384,6 +313,12 @@ subroutine med_phases_prep_glc_init(gcomp, rc) ! Create route handle if it has not been created - this will be needed to map the fractions if (.not. med_map_RH_is_created(is_local%wrap%RH(compglc(ns),complnd,:),mapconsd, rc=rc)) then + if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compglc(ns),complnd))) then + call fldbun_init(is_local%wrap%FBImp(compglc(ns),complnd), is_local%wrap%flds_scalar_name, & + STgeom=is_local%wrap%NStateImp(complnd), & + STflds=is_local%wrap%NStateImp(compglc(ns)), & + name='FBImp'//trim(compname(compglc(ns)))//'_'//trim(compname(complnd)), rc=rc) + end if call med_map_routehandles_init( compglc(ns), complnd, & FBSrc=is_local%wrap%FBImp(compglc(ns),compglc(ns)), & FBDst=is_local%wrap%FBImp(compglc(ns),complnd), & @@ -404,19 +339,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 @@ -465,9 +400,9 @@ subroutine med_phases_prep_glc_accum_lnd(gcomp, rc) type(InternalState) :: is_local type(ESMF_Field) :: lfield integer :: i,n - real(r8), pointer :: data2d_in(:,:) => null() - real(r8), pointer :: data2d_out(:,:) => null() - character(len=*),parameter :: subname=' (med_phases_prep_glc_accum) ' + real(r8), pointer :: data2d_in(:,:) + real(r8), pointer :: data2d_out(:,:) + character(len=*),parameter :: subname=' (med_phases_prep_glc_accum) ' !--------------------------------------- call t_startf('MED:'//subname) @@ -477,17 +412,6 @@ 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 (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 - ! 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) @@ -497,15 +421,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 @@ -534,8 +458,8 @@ subroutine med_phases_prep_glc_accum_ocn(gcomp, rc) type(InternalState) :: is_local type(ESMF_Field) :: lfield integer :: i,n - real(r8), pointer :: data2d_in(:,:) => null() - real(r8), pointer :: data2d_out(:,:) => null() + real(r8), pointer :: data2d_in(:,:) + real(r8), pointer :: data2d_out(:,:) character(len=*),parameter :: subname=' (med_phases_prep_glc_accum) ' !--------------------------------------- @@ -547,35 +471,24 @@ 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) 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) 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 @@ -587,13 +500,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 @@ -612,8 +527,12 @@ subroutine med_phases_prep_glc(gcomp, rc) integer :: yr_prepglc, mon_prepglc, day_prepglc, sec_prepglc type(ESMF_Alarm) :: alarm integer :: i, n, ns - real(r8), pointer :: data2d(:,:) => null() - real(r8), pointer :: data2d_import(:,:) => null() + real(r8), pointer :: data2d(:,:) + real(r8), pointer :: data2d_import(:,:) + character(len=CS) :: cvalue + logical :: do_avg + logical :: isPresent, isSet + logical :: write_histaux_l2x1yrg character(len=*) , parameter :: subname=' (med_phases_prep_glc) ' !--------------------------------------- @@ -624,58 +543,100 @@ 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) if (chkErr(rc,__LINE__,u_FILE_u)) return - ! Check time - call NUOPC_ModelGet(gcomp, modelClock=med_clock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockGet(med_clock, currtime=med_currtime, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeGet(med_currtime,yy=yr_med, mm=mon_med, dd=day_med, s=sec_med, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockGet(prepglc_clock, currtime=prepglc_currtime, rc=rc) + if (.not. ESMF_ClockIsCreated(prepglc_clock)) then + ! Initialize prepglc_clock from mclock - THIS CALL DOES NOT COPY ALARMS + call NUOPC_ModelGet(gcomp, modelClock=med_clock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + prepglc_clock = ESMF_ClockCreate(med_clock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Set alarm glc averaging interval + call NUOPC_CompAttributeGet(gcomp, name="glc_avg_period", value=glc_avg_period, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (trim(glc_avg_period) == 'yearly') then + call med_time_alarmInit(prepglc_clock, glc_avg_alarm, 'yearly', alarmname='alarm_glc_avg', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (mastertask) then + write(logunit,'(a,i10)') trim(subname)//& + ' created alarm with averaging period for export to glc is yearly' + end if + else if (trim(glc_avg_period) == 'glc_coupling_period') then + call NUOPC_CompAttributeGet(gcomp, name="glc_cpl_dt", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) glc_cpl_dt + call med_time_alarmInit(prepglc_clock, glc_avg_alarm, 'nseconds', opt_n=glc_cpl_dt, alarmname='alarm_glc_avg', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (mastertask) then + write(logunit,'(a,i10)') trim(subname)//& + ' created alarm with averaging period for export to glc (in seconds) ',glc_cpl_dt + end if + else + call ESMF_LogWrite(trim(subname)// ": ERROR glc_avg_period = "//trim(glc_avg_period)//" not supported", & + ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + RETURN + end if + call ESMF_AlarmSet(glc_avg_alarm, clock=prepglc_clock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + ! Advance prepglc_clock - this will make the prepglc_clock in sync with the mediator clock + call ESMF_ClockAdvance(prepglc_clock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeGet(prepglc_currtime,yy=yr_prepglc, mm=mon_prepglc, dd=day_prepglc, s=sec_prepglc, rc=rc) - if (mastertask) then - write(logunit,'(a,4(i8,2x))') trim(subname)//'med clock yr, mon, day, sec = ',& - yr_med,mon_med,day_med,sec_med - write(logunit,'(a,4(i8,2x))') trim(subname)//'prep glc clock yr, mon, day, sec = ',& - yr_prepglc,mon_prepglc,day_prepglc,sec_prepglc + + ! Check time + if (dbug_flag > 5) then + if (mastertask) then + call NUOPC_ModelGet(gcomp, modelClock=med_clock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockGet(med_clock, currtime=med_currtime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeGet(med_currtime,yy=yr_med, mm=mon_med, dd=day_med, s=sec_med, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockGet(prepglc_clock, currtime=prepglc_currtime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeGet(prepglc_currtime,yy=yr_prepglc, mm=mon_prepglc, dd=day_prepglc, s=sec_prepglc, rc=rc) + if (mastertask) then + write(logunit,'(a,4(i8,2x))') trim(subname)//'med clock yr, mon, day, sec = ',& + yr_med,mon_med,day_med,sec_med + write(logunit,'(a,4(i8,2x))') trim(subname)//'prep glc clock yr, mon, day, sec = ',& + yr_prepglc,mon_prepglc,day_prepglc,sec_prepglc + end if + end if end if ! Determine if the alarm is ringing call ESMF_ClockGetAlarm(prepglc_clock, alarmname='alarm_glc_avg', alarm=alarm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (.not. ESMF_AlarmIsRinging(alarm, rc=rc)) then - ! Do nothing if the alarm is not ringing - call ESMF_LogWrite(trim(subname)//": glc_avg alarm is not ringing - returning", ESMF_LOGMSG_INFO) - else - call ESMF_LogWrite(trim(subname)//": glc_avg alarm is ringing - averaging input from lnd and ocn to glc", & + if (ESMF_AlarmIsRinging(alarm, rc=rc)) then + do_avg = .true. + call ESMF_LogWrite(trim(subname)//": glc_avg alarm is ringing - average input from lnd and ocn to glc", & ESMF_LOGMSG_INFO) if (mastertask) then write(logunit,'(a)') trim(subname)//"glc_avg alarm is ringing - averaging input from lnd and ocn to glc" end if - ! Turn off the alarm call ESMF_AlarmRingerOff( alarm, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + do_avg = .false. + call ESMF_LogWrite(trim(subname)//": glc_avg alarm is not ringing - returning", ESMF_LOGMSG_INFO) + end if - ! Average import from accumulated land import data + ! Average and map data from land (and possibly ocean) + if (do_avg) then + ! Always average import from accumulated land import data do n = 1, size(fldnames_fr_lnd) - call fldbun_getdata2d(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,14 +646,30 @@ 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) - 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 @@ -702,14 +679,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) @@ -720,8 +697,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 @@ -731,8 +708,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 @@ -749,6 +726,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 !================================================================================================ @@ -764,17 +753,17 @@ subroutine med_phases_prep_glc_map_lnd2glc(gcomp, rc) ! local variables type(InternalState) :: is_local - real(r8), pointer :: topolnd_g_ec(:,:) => null() ! topo in elevation classes - real(r8), pointer :: dataptr_g(:) => null() ! temporary data pointer for one elevation class - real(r8), pointer :: topoglc_g(:) => null() ! ice topographic height on the glc grid extracted from glc import - real(r8), pointer :: data_ice_covered_g(:) => null() ! data for ice-covered regions on the GLC grid - real(r8), pointer :: ice_covered_g(:) => null() ! if points on the glc grid is ice-covered (1) or ice-free (0) - integer , pointer :: elevclass_g(:) => null() ! elevation classes glc grid - real(r8), pointer :: dataexp_g(:) => null() ! pointer into - real(r8), pointer :: dataptr2d(:,:) => null() - real(r8), pointer :: dataptr1d(:) => null() - real(r8) :: elev_l, elev_u ! lower and upper elevations in interpolation range - real(r8) :: d_elev ! elev_u - elev_l + real(r8), pointer :: topolnd_g_ec(:,:) ! topo in elevation classes + real(r8), pointer :: dataptr_g(:) ! temporary data pointer for one elevation class + real(r8), pointer :: topoglc_g(:) ! ice topographic height on the glc grid extracted from glc import + real(r8), pointer :: data_ice_covered_g(:) ! data for ice-covered regions on the GLC grid + real(r8), pointer :: ice_covered_g(:) ! if points on the glc grid is ice-covered (1) or ice-free (0) + integer , pointer :: elevclass_g(:) ! elevation classes glc grid + real(r8), pointer :: dataexp_g(:) ! pointer into + real(r8), pointer :: dataptr2d(:,:) + real(r8), pointer :: dataptr1d(:) + real(r8) :: elev_l, elev_u ! lower and upper elevations in interpolation range + real(r8) :: d_elev ! elev_u - elev_l integer :: nfld, ec integer :: i,j,n,g,lsize_g,ns integer :: ungriddedUBound_output(1) @@ -782,8 +771,8 @@ subroutine med_phases_prep_glc_map_lnd2glc(gcomp, rc) type(ESMF_Field) :: field_lfrac_l integer :: fieldCount character(len=3) :: cnum - type(ESMF_Field), pointer :: fieldlist_lnd(:) => null() - type(ESMF_Field), pointer :: fieldlist_glc(:) => null() + type(ESMF_Field), pointer :: fieldlist_lnd(:) + type(ESMF_Field), pointer :: fieldlist_glc(:) character(len=*) , parameter :: subname=' (med_phases_prep_glc_map_lnd2glc) ' !--------------------------------------- @@ -799,7 +788,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 @@ -809,27 +798,25 @@ 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 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)%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( & @@ -847,13 +834,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 @@ -883,7 +870,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 ! ------------------------------------------------------------------------ @@ -901,7 +888,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) @@ -968,12 +955,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 @@ -1052,18 +1039,18 @@ subroutine med_phases_prep_glc_renormalize_smb(gcomp, rc) type(InternalState) :: is_local type(ESMF_VM) :: vm type(ESMF_Field) :: lfield - real(r8) , pointer :: qice_g(:) => null() ! SMB (Flgl_qice) on glc grid without elev classes - real(r8) , pointer :: qice_l_ec(:,:) => null() ! SMB (Flgl_qice) on land grid with elev classes - real(r8) , pointer :: topo_g(:) => null() ! ice topographic height on the glc grid cell - real(r8) , pointer :: frac_g(:) => null() ! total ice fraction in each glc cell - real(r8) , pointer :: frac_g_ec(:,:) => null() ! total ice fraction in each glc cell - real(r8) , pointer :: frac_l_ec(:,:) => null() ! EC fractions (Sg_ice_covered) on land grid - real(r8) , pointer :: icemask_g(:) => null() ! icemask on glc grid - real(r8) , pointer :: icemask_l(:) => null() ! icemask on land grid - real(r8) , pointer :: lfrac(:) => null() ! land fraction on land grid - real(r8) , pointer :: dataptr1d(:) => null() ! temporary 1d pointer - real(r8) , pointer :: dataptr2d(:,:) => null() ! temporary 2d pointer - integer :: ec ! loop index over elevation classes + real(r8) , pointer :: qice_g(:) ! SMB (Flgl_qice) on glc grid without elev classes + real(r8) , pointer :: qice_l_ec(:,:) ! SMB (Flgl_qice) on land grid with elev classes + real(r8) , pointer :: topo_g(:) ! ice topographic height on the glc grid cell + real(r8) , pointer :: frac_g(:) ! total ice fraction in each glc cell + real(r8) , pointer :: frac_g_ec(:,:) ! total ice fraction in each glc cell + real(r8) , pointer :: frac_l_ec(:,:) ! EC fractions (Sg_ice_covered) on land grid + real(r8) , pointer :: icemask_g(:) ! icemask on glc grid + real(r8) , pointer :: icemask_l(:) ! icemask on land grid + real(r8) , pointer :: lfrac(:) ! land fraction on land grid + real(r8) , pointer :: dataptr1d(:) ! temporary 1d pointer + real(r8) , pointer :: dataptr2d(:,:) ! temporary 2d pointer + integer :: ec ! loop index over elevation classes integer :: n, ns ! local and global sums of accumulation and ablation; used to compute renormalization factors @@ -1076,7 +1063,7 @@ subroutine med_phases_prep_glc_renormalize_smb(gcomp, rc) real(r8) :: accum_renorm_factor ! ratio between global accumulation on the two grids real(r8) :: ablat_renorm_factor ! ratio between global ablation on the two grids real(r8) :: effective_area ! grid cell area multiplied by min(lfrac,icemask_l). - real(r8), pointer :: area_g(:) ! areas on glc grid + real(r8), pointer :: area_g(:) ! areas on glc grid character(len=*), parameter :: subname=' (renormalize_smb) ' !--------------------------------------------------------------- @@ -1100,7 +1087,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 @@ -1129,10 +1116,8 @@ subroutine med_phases_prep_glc_renormalize_smb(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! get frac_g(:), the total ice fraction in each glc gridcell - call fldbun_getdata1d(is_local%wrap%FBImp(compglc(ns),compglc(ns)), Sg_frac_fieldname, dataptr1d, rc) + call fldbun_getdata1d(is_local%wrap%FBImp(compglc(ns),compglc(ns)), Sg_frac_fieldname, frac_g, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call field_getdata1d(toglc_frlnd(ns)%field_lfrac_g, frac_g, rc) ! module field - frac_g(:) = dataptr1d(:) ! get frac_g_ec - the glc_elevclass gives the elevation class of each ! glc grid cell, assuming that the grid cell is ice-covered, spans [1 -> ungriddedcount] @@ -1164,7 +1149,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 @@ -1302,4 +1287,3 @@ subroutine dynOcnMaskProc(dynamicMaskList, dynamicSrcMaskValue, dynamicDstMaskVa end subroutine DynOcnMaskProc end module med_phases_prep_glc_mod - diff --git a/mediator/med_phases_prep_ice_mod.F90 b/mediator/med_phases_prep_ice_mod.F90 index 4f12f97ad..1f6424bf1 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 @@ -50,8 +50,8 @@ subroutine med_phases_prep_ice(gcomp, rc) type(InternalState) :: is_local type(ESMF_Field) :: lfield integer :: i,n - real(R8), pointer :: dataptr(:) => null() - real(R8), pointer :: dataptr_scalar_ocn(:,:) => null() + real(R8), pointer :: dataptr(:) + real(R8), pointer :: dataptr_scalar_ocn(:,:) real(R8) :: precip_fact(1) character(len=CS) :: cvalue character(len=64), allocatable :: fldnames(:) @@ -80,7 +80,7 @@ subroutine med_phases_prep_ice(gcomp, rc) ! ocn->ice is mapped in med_phases_post_ocn ! auto merges to create FBExp(compice) - call med_merge_auto(compice, & + call med_merge_auto(& is_local%wrap%med_coupling_active(:,compice), & is_local%wrap%FBExp(compice), & is_local%wrap%FBFrac(compice), & @@ -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_lnd_mod.F90 b/mediator/med_phases_prep_lnd_mod.F90 index ca1ed38d5..d60ac6dcf 100644 --- a/mediator/med_phases_prep_lnd_mod.F90 +++ b/mediator/med_phases_prep_lnd_mod.F90 @@ -47,10 +47,10 @@ subroutine med_phases_prep_lnd(gcomp, rc) real(r8) :: nextsw_cday integer :: scalar_id real(r8) :: tmp(1) - real(r8), pointer :: dataptr2d(:,:) => null() + real(r8), pointer :: dataptr2d(:,:) logical :: first_call = .true. - real(r8), pointer :: dataptr_scalar_lnd(:,:) => null() - real(r8), pointer :: dataptr_scalar_atm(:,:) => null() + real(r8), pointer :: dataptr_scalar_lnd(:,:) + real(r8), pointer :: dataptr_scalar_atm(:,:) character(len=*), parameter :: subname='(med_phases_prep_lnd)' !--------------------------------------- @@ -82,7 +82,7 @@ subroutine med_phases_prep_lnd(gcomp, rc) ! auto merges to create FBExp(complnd) - other than glc->lnd ! The following will merge all fields in fldsSrc call t_startf('MED:'//trim(subname)//' merge') - call med_merge_auto(complnd, & + call med_merge_auto(& is_local%wrap%med_coupling_active(:,complnd), & is_local%wrap%FBExp(complnd), & is_local%wrap%FBFrac(complnd), & diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index 705d8a595..ffa029b37 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -27,8 +27,9 @@ module med_phases_prep_ocn_mod implicit none private - public :: med_phases_prep_ocn_accum - public :: med_phases_prep_ocn_avg + public :: med_phases_prep_ocn_init ! called from med.F90 + public :: med_phases_prep_ocn_accum ! called from run sequence + public :: med_phases_prep_ocn_avg ! called from run sequence private :: med_phases_prep_ocn_custom_cesm private :: med_phases_prep_ocn_custom_nems @@ -40,6 +41,41 @@ module med_phases_prep_ocn_mod contains !----------------------------------------------------------------------------- + subroutine med_phases_prep_ocn_init(gcomp, rc) + + use ESMF , only : ESMF_GridComp, ESMF_SUCCESS + use med_methods_mod , only : FB_Init => med_methods_FB_init + use med_methods_mod , only : FB_Reset => med_methods_FB_Reset + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(InternalState) :: is_local + character(len=*),parameter :: subname=' (med_phases_prep_ocn_init) ' + !--------------------------------------- + + 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 + + if (mastertask) then + write(logunit,'(a)') trim(subname)//' initializing ocean export accumulation FB for ' + end if + call FB_init(is_local%wrap%FBExpAccumOcn, is_local%wrap%flds_scalar_name, & + STgeom=is_local%wrap%NStateExp(compocn), STflds=is_local%wrap%NStateExp(compocn), & + name='FBExpAccumOcn', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_reset(is_local%wrap%FBExpAccumOcn, value=czero, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine med_phases_prep_ocn_init + + !----------------------------------------------------------------------------- subroutine med_phases_prep_ocn_accum(gcomp, rc) use ESMF , only : ESMF_GridComp, ESMF_FieldBundleGet @@ -72,7 +108,7 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) if ( trim(coupling_mode) == 'cesm' .or. & trim(coupling_mode) == 'nems_orig_data' .or. & trim(coupling_mode) == 'hafs') then - call med_merge_auto(compocn, & + call med_merge_auto(& is_local%wrap%med_coupling_active(:,compocn), & is_local%wrap%FBExp(compocn), & is_local%wrap%FBFrac(compocn), & @@ -81,7 +117,7 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) FBMed1=is_local%wrap%FBMed_aoflux_o, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else if (trim(coupling_mode) == 'nems_frac' .or. trim(coupling_mode) == 'nems_orig') then - call med_merge_auto(compocn, & + call med_merge_auto(& is_local%wrap%med_coupling_active(:,compocn), & is_local%wrap%FBExp(compocn), & is_local%wrap%FBFrac(compocn), & @@ -100,13 +136,13 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) end if ! ocean accumulator - call FB_accum(is_local%wrap%FBExpAccum(compocn), is_local%wrap%FBExp(compocn), rc=rc) + call FB_accum(is_local%wrap%FBExpAccumOcn, is_local%wrap%FBExp(compocn), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - is_local%wrap%FBExpAccumCnt(compocn) = is_local%wrap%FBExpAccumCnt(compocn) + 1 + is_local%wrap%ExpAccumOcnCnt = is_local%wrap%ExpAccumOcnCnt + 1 ! diagnose output if (dbug_flag > 1) then - call FB_diagnose(is_local%wrap%FBExpAccum(compocn), string=trim(subname)//' FBExpAccum accumulation ', rc=rc) + call FB_diagnose(is_local%wrap%FBExpAccumOcn, string=trim(subname)//' FBExpAccumOcn accumulation ', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if if (dbug_flag > 20) then @@ -147,34 +183,32 @@ subroutine med_phases_prep_ocn_avg(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Count the number of fields outside of scalar data, if zero, then return - call ESMF_FieldBundleGet(is_local%wrap%FBExpAccum(compocn), fieldCount=ncnt, rc=rc) + call ESMF_FieldBundleGet(is_local%wrap%FBExpAccumOcn, fieldCount=ncnt, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (ncnt > 0) then ! average ocn accumulator if (dbug_flag > 1) then - call FB_diagnose(is_local%wrap%FBExpAccum(compocn), & - string=trim(subname)//' FBExpAccum(compocn) before avg ', rc=rc) + call FB_diagnose(is_local%wrap%FBExpAccumOcn, & + string=trim(subname)//' FBExpAccumOcn before avg ', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - call FB_average(is_local%wrap%FBExpAccum(compocn), & - is_local%wrap%FBExpAccumCnt(compocn), rc=rc) + call FB_average(is_local%wrap%FBExpAccumOcn, is_local%wrap%ExpAccumOcnCnt, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 1) then - call FB_diagnose(is_local%wrap%FBExpAccum(compocn), & - string=trim(subname)//' FBExpAccum(compocn) after avg ', rc=rc) + call FB_diagnose(is_local%wrap%FBExpAccumOcn, & + string=trim(subname)//' FBExpAccumOcn after avg ', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if ! copy to FBExp(compocn) - call FB_copy(is_local%wrap%FBExp(compocn), is_local%wrap%FBExpAccum(compocn), rc=rc) + call FB_copy(is_local%wrap%FBExp(compocn), is_local%wrap%FBExpAccumOcn, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! zero accumulator - is_local%wrap%FBExpAccumFlag(compocn) = .true. - is_local%wrap%FBExpAccumCnt(compocn) = 0 - call FB_reset(is_local%wrap%FBExpAccum(compocn), value=czero, rc=rc) + is_local%wrap%ExpAccumOcnCnt = 0 + call FB_reset(is_local%wrap%FBExpAccumOcn, value=czero, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -205,31 +239,31 @@ subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc) ! local variables type(InternalState) :: is_local type(ESMF_Field) :: lfield - real(R8), pointer :: ifrac(:) => null() - real(R8), pointer :: ofrac(:) => null() - real(R8), pointer :: ifracr(:) => null() - real(R8), pointer :: ofracr(:) => null() - real(R8), pointer :: avsdr(:) => null() - real(R8), pointer :: avsdf(:) => null() - real(R8), pointer :: anidr(:) => null() - real(R8), pointer :: anidf(:) => null() - real(R8), pointer :: Faxa_swvdf(:) => null() - real(R8), pointer :: Faxa_swndf(:) => null() - real(R8), pointer :: Faxa_swvdr(:) => null() - real(R8), pointer :: Faxa_swndr(:) => null() - real(R8), pointer :: Foxx_swnet(:) => null() - real(R8), pointer :: Foxx_swnet_afracr(:) => null() - real(R8), pointer :: Foxx_swnet_vdr(:) => null() - real(R8), pointer :: Foxx_swnet_vdf(:) => null() - real(R8), pointer :: Foxx_swnet_idr(:) => null() - real(R8), pointer :: Foxx_swnet_idf(:) => null() - real(R8), pointer :: Fioi_swpen_vdr(:) => null() - real(R8), pointer :: Fioi_swpen_vdf(:) => null() - real(R8), pointer :: Fioi_swpen_idr(:) => null() - real(R8), pointer :: Fioi_swpen_idf(:) => null() - real(R8), pointer :: Fioi_swpen(:) => null() - real(R8), pointer :: dataptr(:) => null() - real(R8), pointer :: dataptr_scalar_ocn(:,:) => null() + real(R8), pointer :: ifrac(:) + real(R8), pointer :: ofrac(:) + real(R8), pointer :: ifracr(:) + real(R8), pointer :: ofracr(:) + real(R8), pointer :: avsdr(:) + real(R8), pointer :: avsdf(:) + real(R8), pointer :: anidr(:) + real(R8), pointer :: anidf(:) + real(R8), pointer :: Faxa_swvdf(:) + real(R8), pointer :: Faxa_swndf(:) + real(R8), pointer :: Faxa_swvdr(:) + real(R8), pointer :: Faxa_swndr(:) + real(R8), pointer :: Foxx_swnet(:) + real(R8), pointer :: Foxx_swnet_afracr(:) + real(R8), pointer :: Foxx_swnet_vdr(:) + real(R8), pointer :: Foxx_swnet_vdf(:) + real(R8), pointer :: Foxx_swnet_idr(:) + real(R8), pointer :: Foxx_swnet_idf(:) + real(R8), pointer :: Fioi_swpen_vdr(:) + real(R8), pointer :: Fioi_swpen_vdf(:) + real(R8), pointer :: Fioi_swpen_idr(:) + real(R8), pointer :: Fioi_swpen_idf(:) + real(R8), pointer :: Fioi_swpen(:) + real(R8), pointer :: dataptr(:) + real(R8), pointer :: dataptr_scalar_ocn(:,:) real(R8) :: frac_sum real(R8) :: ifrac_scaled, ofrac_scaled real(R8) :: ifracr_scaled, ofracr_scaled @@ -438,12 +472,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 +492,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) @@ -501,13 +535,13 @@ subroutine med_phases_prep_ocn_custom_nems(gcomp, rc) ! local variables type(InternalState) :: is_local - real(R8), pointer :: ocnwgt1(:) => null() - real(R8), pointer :: icewgt1(:) => null() - real(R8), pointer :: wgtp01(:) => null() - real(R8), pointer :: wgtm01(:) => null() - real(R8), pointer :: customwgt(:) => null() - real(R8), pointer :: ifrac(:) => null() - real(R8), pointer :: ofrac(:) => null() + real(R8), pointer :: ocnwgt1(:) + real(R8), pointer :: icewgt1(:) + real(R8), pointer :: wgtp01(:) + real(R8), pointer :: wgtm01(:) + real(R8), pointer :: customwgt(:) + real(R8), pointer :: ifrac(:) + real(R8), pointer :: ofrac(:) integer :: lsize real(R8) , parameter :: const_lhvap = 2.501e6_R8 ! latent heat of evaporation ~ J/kg character(len=*), parameter :: subname='(med_phases_prep_ocn_custom_nems)' diff --git a/mediator/med_phases_prep_rof_mod.F90 b/mediator/med_phases_prep_rof_mod.F90 index 41625bcfb..f54da223b 100644 --- a/mediator/med_phases_prep_rof_mod.F90 +++ b/mediator/med_phases_prep_rof_mod.F90 @@ -3,11 +3,11 @@ module med_phases_prep_rof_mod !----------------------------------------------------------------------------- ! Create rof export fields ! - accumulate import lnd fields on the land grid that are sent to rof - ! this will be done in med_phases_prep_rof_accum - ! - time avergage accumulated import lnd fields when necessary - ! map the time averaged accumulated lnd fields to the rof grid - ! merge the mapped lnd fields to create FBExp(comprof) - ! this will be done in med_phases_prep_rof_avg + ! - done in med_phases_prep_rof_accum + ! - time avergage accumulated import lnd fields on lnd grid when necessary and + ! then map the time averaged accumulated lnd fields to the rof grid + ! and then merge the mapped lnd fields to create FBExp(comprof) + ! - done in med_phases_prep_rof_avg !----------------------------------------------------------------------------- use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 @@ -18,20 +18,19 @@ module med_phases_prep_rof_mod use med_constants_mod , only : czero => med_constants_czero use med_utils_mod , only : chkerr => med_utils_chkerr use med_methods_mod , only : fldbun_getmesh => med_methods_FB_getmesh - 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_diagnose => med_methods_FB_diagnose use med_methods_mod , only : fldbun_reset => med_methods_FB_reset use med_methods_mod , only : fldbun_average => med_methods_FB_average - use med_methods_mod , only : field_getdata2d => med_methods_Field_getdata2d use med_methods_mod , only : field_getdata1d => med_methods_Field_getdata1d use perf_mod , only : t_startf, t_stopf implicit none private + public :: med_phases_prep_rof_init ! called from med.F90 + public :: med_phases_prep_rof_accum ! called by med_phases_post_lnd.F90 public :: med_phases_prep_rof ! called by run sequence - public :: med_phases_prep_rof_accum ! called by med_phases_post_lnd private :: med_phases_prep_rof_irrig @@ -49,13 +48,18 @@ module med_phases_prep_rof_mod character(len=*), parameter :: irrig_normalized_field = 'Flrl_irrig_normalized' character(len=*), parameter :: irrig_volr0_field = 'Flrl_irrig_volr0 ' - ! the following are the fields that will be accumulated from the land - character(CS) :: lnd2rof_flds(6) = (/'Flrl_rofsur','Flrl_rofgwl','Flrl_rofsub', & - 'Flrl_rofdto','Flrl_rofi ','Flrl_irrig '/) + ! the following are the fields that will be accumulated from the land and are derived from fldlistTo(comprof) + character(CS), allocatable :: lnd2rof_flds(:) integer :: maptype_lnd2rof integer :: maptype_rof2lnd + ! Accumulation to river field bundles - accumulation is done on the land mesh and then averaged and mapped to the + ! rof mesh + integer , public :: lndAccum2rof_cnt + type(ESMF_FieldBundle), public :: FBlndAccum2rof_l + type(ESMF_FieldBundle), public :: FBlndAccum2rof_r + character(*) , parameter :: u_FILE_u = & __FILE__ @@ -63,6 +67,108 @@ module med_phases_prep_rof_mod contains !=============================================================================== + subroutine med_phases_prep_rof_init(gcomp, rc) + + !--------------------------------------- + ! Create module field bundles FBlndAccum2rof_l and FBlndAccum2rof_r + ! land accumulation on both complnd and comprof meshes + !--------------------------------------- + + use ESMF , only : ESMF_GridComp, ESMF_GridCompGet + use ESMF , only : ESMF_Field, ESMF_FieldGet, ESMF_FieldCreate + use ESMF , only : ESMF_Mesh, ESMF_MESHLOC_ELEMENT + use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleCreate, ESMF_FieldBundleGet, ESMF_FieldBundleAdd + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS + use ESMF , only : ESMF_TYPEKIND_R8 + use esmFlds , only : fldListFr, fldlistTo, med_fldlist_GetNumFlds, med_fldlist_getFldInfo + use med_map_mod , only : med_map_packed_field_create + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(InternalState) :: is_local + integer :: n, n1, nflds + type(ESMF_Mesh) :: mesh_l + type(ESMF_Mesh) :: mesh_r + type(ESMF_Field) :: lfield + character(len=CS), allocatable :: fldnames_temp(:) + character(len=*),parameter :: subname=' (med_phases_prep_rof_init) ' + !--------------------------------------- + + 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 lnd2rof_flds (module variable) - note that fldListTo is set in esmFldsExchange_cesm.F90 + ! Remove scalar field from lnd2rof_flds + nflds = med_fldlist_getnumflds(fldlistTo(comprof)) + allocate(fldnames_temp(nflds)) + do n = 1,nflds + call med_fldList_GetFldInfo(fldListTo(comprof), n, fldnames_temp(n)) + end do + do n = 1,nflds + if (trim(fldnames_temp(n)) == trim(is_local%wrap%flds_scalar_name)) then + do n1 = n, nflds-1 + fldnames_temp(n1) = fldnames_temp(n1+1) + enddo + nflds = nflds - 1 + endif + enddo + allocate(lnd2rof_flds(nflds)) + do n = 1,nflds + lnd2rof_flds(n) = trim(fldnames_temp(n)) + end do + deallocate(fldnames_temp) + + ! Get lnd and rof meshes + call fldbun_getmesh(is_local%wrap%FBImp(complnd,complnd), mesh_l, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call fldbun_getmesh(is_local%wrap%FBImp(complnd,comprof), mesh_r, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Create module field bundle FBlndAccum2rof_l on land mesh and FBlndAccum2rof_r on rof mesh + FBlndAccum2rof_l = ESMF_FieldBundleCreate(name='FBlndAccum2rof_l', rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + FBlndAccum2rof_r = ESMF_FieldBundleCreate(name='FBlndAccum2rof_r', rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + do n = 1,size(lnd2rof_flds) + lfield = ESMF_FieldCreate(mesh_l, ESMF_TYPEKIND_R8, name=lnd2rof_flds(n), meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleAdd(FBlndAccum2rof_l, (/lfield/), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(trim(subname)//' adding field '//trim(lnd2rof_flds(n))//' to FBLndAccum2rof_l', & + ESMF_LOGMSG_INFO) + lfield = ESMF_FieldCreate(mesh_r, ESMF_TYPEKIND_R8, name=lnd2rof_flds(n), meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleAdd(FBlndAccum2rof_r, (/lfield/), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(trim(subname)//' adding field '//trim(lnd2rof_flds(n))//' to FBLndAccum2rof_r', & + ESMF_LOGMSG_INFO) + end do + + ! Initialize field bundles and accumulation count + call fldbun_reset(FBlndAccum2rof_l, value=0.0_r8, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call fldbun_reset(FBlndAccum2rof_r, value=0.0_r8, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + lndAccum2rof_cnt = 0 + + ! Create packed mapping from rof->lnd + call med_map_packed_field_create(destcomp=comprof, & + flds_scalar_name=is_local%wrap%flds_scalar_name, & + fldsSrc=fldListFr(complnd)%flds, & + FBSrc=FBLndAccum2rof_l, FBDst=FBLndAccum2rof_r, & + packed_data=is_local%wrap%packed_data(complnd,comprof,:), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine med_phases_prep_rof_init + + !=============================================================================== subroutine med_phases_prep_rof_accum(gcomp, rc) !------------------------------------ @@ -80,7 +186,6 @@ subroutine med_phases_prep_rof_accum(gcomp, rc) ! input/output variables type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc ! local variables @@ -89,15 +194,10 @@ subroutine med_phases_prep_rof_accum(gcomp, rc) integer :: fieldCount integer :: ungriddedUBound(1) logical :: exists - real(r8), pointer :: dataptr1d(:) => null() - real(r8), pointer :: dataptr2d(:,:) => null() - real(r8), pointer :: dataptr1d_accum(:) => null() - real(r8), pointer :: dataptr2d_accum(:,:) => null() + real(r8), pointer :: dataptr1d(:) + real(r8), pointer :: dataptr1d_accum(:) 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)' !--------------------------------------- @@ -119,36 +219,25 @@ subroutine med_phases_prep_rof_accum(gcomp, rc) isPresent=exists, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (exists) then + call ESMF_FieldBundleGet(FBlndAccum2rof_l, fieldName=trim(lnd2rof_flds(n)), & + field=lfield_accum, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldBundleGet(is_local%wrap%FBImp(complnd,complnd), fieldName=trim(lnd2rof_flds(n)), & field=lfield, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldBundleGet(is_local%wrap%FBImpaccum(complnd,complnd), fieldName=trim(lnd2rof_flds(n)), & - field=lfield_accum, rc=rc) + call field_getdata1d(lfield, dataptr1d, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(lfield, ungriddedUBound=ungriddedUBound, rc=rc) + call field_getdata1d(lfield_accum, dataptr1d_accum, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (ungriddedUBound(1) > 0) then - call field_getdata2d(lfield, dataptr2d, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call field_getdata2d(lfield_accum, dataptr2d_accum, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - dataptr2d_accum(:,:) = dataptr2d_accum(:,:) + dataptr2d(:,:) - else - call field_getdata1d(lfield, dataptr1d, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call field_getdata1d(lfield_accum, dataptr1d_accum, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - dataptr1d_accum(:) = dataptr1d_accum(:) + dataptr1d(:) - end if + dataptr1d_accum(:) = dataptr1d_accum(:) + dataptr1d(:) end if end do ! Accumulate counter - is_local%wrap%FBImpAccumCnt(complnd) = is_local%wrap%FBImpAccumCnt(complnd) + 1 + lndAccum2rof_cnt = lndAccum2rof_cnt + 1 if (dbug_flag > 1) then - call fldbun_diagnose(is_local%wrap%FBImpAccum(complnd,complnd), & - string=trim(subname)//' FBImpAccum(complnd,complnd) ', rc=rc) + call fldbun_diagnose(FBlndAccum2rof_l, string=trim(subname)//' FBlndAccum2rof_l accum', rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if @@ -184,15 +273,14 @@ subroutine med_phases_prep_rof(gcomp, rc) integer :: i,j,n,n1,ncnt integer :: count logical :: exists - real(r8), pointer :: dataptr(:) => null() - real(r8), pointer :: dataptr1d(:) => null() - real(r8), pointer :: dataptr2d(:,:) => null() + real(r8), pointer :: dataptr(:) + real(r8), pointer :: dataptr1d(:) 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() + type(ESMF_Field) :: lfield_src + type(ESMF_Field) :: lfield_dst + type(ESMF_Field) :: field_lfrac_lnd + character(CL), pointer :: lfieldnamelist(:) character(len=*),parameter :: subname='(med_phases_prep_rof_mod: med_phases_prep_rof)' !--------------------------------------- @@ -214,7 +302,7 @@ subroutine med_phases_prep_rof(gcomp, rc) ! Average import from land accumuled FB !--------------------------------------- - count = is_local%wrap%FBImpAccumCnt(complnd) + count = lndAccum2rof_cnt if (count == 0) then if (mastertask) then write(logunit,'(a)')trim(subname)//'accumulation count for land input averging to river is 0 '// & @@ -223,77 +311,57 @@ subroutine med_phases_prep_rof(gcomp, rc) end if do n = 1,size(lnd2rof_flds) - call ESMF_FieldBundleGet(is_local%wrap%FBImpAccum(complnd,complnd), fieldName=trim(lnd2rof_flds(n)), & - isPresent=exists, rc=rc) + call ESMF_FieldBundleGet(FBlndAccum2rof_l, fieldName=trim(lnd2rof_flds(n)), isPresent=exists, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (exists) then - call ESMF_FieldBundleGet(is_local%wrap%FBImpAccum(complnd,complnd), fieldName=trim(lnd2rof_flds(n)), & - field=lfield, rc=rc) + call ESMF_FieldBundleGet(FBlndAccum2rof_l, fieldName=trim(lnd2rof_flds(n)), field=lfield, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(lfield, ungriddedUBound=ungriddedUBound, rc=rc) + call field_getdata1d(lfield, dataptr1d, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (ungriddedUBound(1) > 0) then - call field_getdata2d(lfield, dataptr2d, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (count == 0) then - dataptr2d(:,:) = czero - else - dataptr2d(:,:) = dataptr2d(:,:) / real(count, r8) - end if + if (count == 0) then + dataptr1d(:) = czero else - call field_getdata1d(lfield, dataptr1d, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (count == 0) then - dataptr1d(:) = czero - else - dataptr1d(:) = dataptr1d(:) / real(count, r8) - end if + dataptr1d(:) = dataptr1d(:) / real(count, r8) end if end if end do if (dbug_flag > 1) then - call fldbun_diagnose(is_local%wrap%FBImpAccum(complnd,complnd), & - string=trim(subname)//' FBImpAccum(complnd,complnd) after avg ', rc=rc) + call fldbun_diagnose(FBlndAccum2rof_l, string=trim(subname)//' FBlndAccum2rof_l after avg ', rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if !--------------------------------------- - ! Map to create FBImpAccum(complnd,comprof) + ! Map to create FBlndAccum2rof_r !--------------------------------------- ! The following assumes that only land import fields are needed to create the ! export fields for the river component and that ALL mappings are done with mapconsf - if (is_local%wrap%med_coupling_active(complnd,comprof)) then - call med_map_field_packed( & - FBSrc=is_local%wrap%FBImpAccum(complnd,complnd), & - FBDst=is_local%wrap%FBImpAccum(complnd,comprof), & - FBFracSrc=is_local%wrap%FBFrac(complnd), & - field_normOne=is_local%wrap%field_normOne(complnd,comprof,:), & - packed_data=is_local%wrap%packed_data(complnd,comprof,:), & - routehandles=is_local%wrap%RH(complnd,comprof,:), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - if (dbug_flag > 1) then - call fldbun_diagnose(is_local%wrap%FBImpAccum(complnd,comprof), & - string=trim(subname)//' FBImpAccum(complnd,comprof) after map ', rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end if + call med_map_field_packed( FBSrc=FBlndAccum2rof_l, FBDst=FBlndAccum2rof_r, & + FBFracSrc=is_local%wrap%FBFrac(complnd), & + field_normOne=is_local%wrap%field_normOne(complnd,comprof,:), & + packed_data=is_local%wrap%packed_data(complnd,comprof,:), & + routehandles=is_local%wrap%RH(complnd,comprof,:), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Reset the irrig_flux_field with the map_lnd2rof_irrig calculation below if appropriate - if ( NUOPC_IsConnected(is_local%wrap%NStateImp(complnd), fieldname=trim(irrig_flux_field))) then - call med_phases_prep_rof_irrig( gcomp, rc=rc ) - if (chkerr(rc,__LINE__,u_FILE_u)) return - else - ! This will ensure that no irrig is sent from the land - call fldbun_getdata1d(is_local%wrap%FBImpAccum(complnd,comprof), irrig_flux_field, dataptr, rc) - dataptr(:) = czero - end if - endif + if (dbug_flag > 1) then + call fldbun_diagnose(FBlndAccum2rof_r, string=trim(subname)//' FBlndAccum2rof_r after map ', rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + + ! Reset the irrig_flux_field with the map_lnd2rof_irrig calculation below if appropriate + if ( NUOPC_IsConnected(is_local%wrap%NStateImp(complnd), fieldname=trim(irrig_flux_field))) then + call med_phases_prep_rof_irrig( gcomp, rc=rc ) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + ! This will ensure that no irrig is sent from the land + call fldbun_getdata1d(FBlndAccum2rof_r, irrig_flux_field, dataptr, rc) + dataptr(:) = czero + end if !--------------------------------------- - ! auto merges to create FBExp(comprof) + ! auto merges to create FBExp(comprof) - assumes that all data is coming from FBlndAccum2rof_r !--------------------------------------- if (dbug_flag > 1) then @@ -302,12 +370,8 @@ subroutine med_phases_prep_rof(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if - call med_merge_auto(comprof, & - is_local%wrap%med_coupling_active(:,comprof), & - is_local%wrap%FBExp(comprof), & - is_local%wrap%FBFrac(comprof), & - is_local%wrap%FBImpAccum(:,comprof), & - fldListTo(comprof), rc=rc) + call med_merge_auto(compsrc=complnd, FBout=is_local%wrap%FBExp(comprof), & + FBfrac=is_local%wrap%FBFrac(comprof), FBin=FBlndAccum2rof_r, fldListTo=fldListTo(comprof), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 1) then @@ -321,28 +385,19 @@ subroutine med_phases_prep_rof(gcomp, rc) !--------------------------------------- ! zero counter - is_local%wrap%FBImpAccumCnt(complnd) = 0 + lndAccum2rof_cnt = 0 - ! zero lnd2rof fields in FBImpAccum + ! zero lnd2rof fields in FBlndAccum2rof_l do n = 1,size(lnd2rof_flds) call ESMF_FieldBundleGet(is_local%wrap%FBImp(complnd,complnd), fieldName=trim(lnd2rof_flds(n)), & isPresent=exists, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (exists) then - call ESMF_FieldBundleGet(is_local%wrap%FBImpaccum(complnd,complnd), fieldName=trim(lnd2rof_flds(n)), & - field=lfield, rc=rc) + call ESMF_FieldBundleGet(FBlndAccum2rof_l, fieldName=trim(lnd2rof_flds(n)), field=lfield, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(lfield, ungriddedUBound=ungriddedUBound, rc=rc) + call field_getdata1d(lfield, dataptr1d, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (ungriddedUBound(1) > 0) then - call field_getdata2d(lfield, dataptr2d, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - dataptr2d(:,:) = czero - else - call field_getdata1d(lfield, dataptr1d, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - dataptr1d(:) = czero - end if + dataptr1d(:) = czero end if end do @@ -396,19 +451,17 @@ subroutine med_phases_prep_rof_irrig(gcomp, rc) type(ESMF_Field) :: field_import_lnd type(ESMF_Field) :: field_irrig_flux type(ESMF_Field) :: field_lfrac_lnd - type(ESMF_Field), pointer :: fieldlist_lnd(:) => null() - type(ESMF_Field), pointer :: fieldlist_rof(:) => null() type(ESMF_Mesh) :: lmesh_lnd type(ESMF_Mesh) :: lmesh_rof - real(r8), pointer :: volr_l(:) => null() - real(r8), pointer :: volr_r(:) => null() - real(r8), pointer :: volr_r_import(:) => null() - real(r8), pointer :: irrig_normalized_l(:) => null() - real(r8), pointer :: irrig_normalized_r(:) => null() - real(r8), pointer :: irrig_volr0_l(:) => null() - real(r8), pointer :: irrig_volr0_r(:) => null() - real(r8), pointer :: irrig_flux_l(:) => null() - real(r8), pointer :: irrig_flux_r(:) => null() + real(r8), pointer :: volr_l(:) + real(r8), pointer :: volr_r(:) + real(r8), pointer :: volr_r_import(:) + real(r8), pointer :: irrig_normalized_l(:) + real(r8), pointer :: irrig_normalized_r(:) + real(r8), pointer :: irrig_volr0_l(:) + real(r8), pointer :: irrig_volr0_r(:) + real(r8), pointer :: irrig_flux_l(:) + real(r8), pointer :: irrig_flux_r(:) character(len=*), parameter :: subname='(med_phases_prep_rof_mod: med_phases_prep_rof_irrig)' !--------------------------------------------------------------- @@ -539,7 +592,7 @@ subroutine med_phases_prep_rof_irrig(gcomp, rc) ! flux on the rof grid. ! First extract accumulated irrigation flux from land - call fldbun_getdata1d(is_local%wrap%FBImpAccum(complnd,complnd), trim(irrig_flux_field), irrig_flux_l, rc) + call fldbun_getdata1d(FBlndAccum2rof_l, trim(irrig_flux_field), irrig_flux_l, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! Fill in values for irrig_normalized_l and irrig_volr0_l @@ -584,12 +637,12 @@ subroutine med_phases_prep_rof_irrig(gcomp, rc) field_normdst=field_lfrac_rof, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ! Convert to a total irrigation flux on the ROF grid, and put this in the pre-merge FBImpAccum(complnd,comprof) + ! Convert to a total irrigation flux on the ROF grid, and put this in the pre-merge FBlndAccum2rof_r call field_getdata1d(field_rofIrrig, irrig_normalized_r, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call field_getdata1d(field_rofIrrig0, irrig_volr0_r, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call fldbun_getdata1d(is_local%wrap%FBImpAccum(complnd,comprof), trim(irrig_flux_field), irrig_flux_r, rc) + call fldbun_getdata1d(FBlndAccum2rof_r, trim(irrig_flux_field), irrig_flux_r, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call field_getdata1d(field_rofIrrig0, irrig_volr0_r, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return diff --git a/mediator/med_phases_prep_wav_mod.F90 b/mediator/med_phases_prep_wav_mod.F90 index 9d5e51f54..8ff29e432 100644 --- a/mediator/med_phases_prep_wav_mod.F90 +++ b/mediator/med_phases_prep_wav_mod.F90 @@ -80,7 +80,7 @@ subroutine med_phases_prep_wav(gcomp, rc) end do ! auto merges to create FBExp(compwav) - call med_merge_auto(compwav, & + call med_merge_auto(& is_local%wrap%med_coupling_active(:,compwav), & is_local%wrap%FBExp(compwav), & is_local%wrap%FBFrac(compwav), & diff --git a/mediator/med_phases_restart_mod.F90 b/mediator/med_phases_restart_mod.F90 index 642816420..e2e00c474 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_constants_mod , only : SecPerDay => med_constants_SecPerDay - use med_utils_mod , only : chkerr => med_utils_ChkErr - use med_internalstate_mod , only : mastertask, logunit, InternalState - use med_time_mod , only : med_time_AlarmInit - use esmFlds , only : ncomps, compname, compocn - use perf_mod , only : t_startf, t_stopf + 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 @@ -21,6 +22,10 @@ module med_phases_restart_mod private :: med_phases_restart_alarm_init + logical :: write_restart_at_endofrun = .false. + logical :: whead(2) = (/.true. , .false./) + logical :: wdata(2) = (/.false., .true. /) + character(*), parameter :: u_FILE_u = & __FILE__ @@ -34,16 +39,15 @@ subroutine med_phases_restart_alarm_init(gcomp, rc) ! Initialize mediator restart file alarms (module variables) ! -------------------------------------- - use ESMF , only : ESMF_GridComp, ESMF_GridCompGet - use ESMF , only : ESMF_Clock, ESMF_ClockGet, ESMF_ClockAdvance, ESMF_ClockSet - use ESMF , only : ESMF_Time - use ESMF , only : ESMF_TimeInterval, ESMF_TimeIntervalGet - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LOGMSG_ERROR - use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE - use ESMF , only : operator(==), operator(-) - use ESMF , only : ESMF_ALARMLIST_ALL, ESMF_Alarm, ESMF_AlarmSet - use NUOPC , only : NUOPC_CompAttributeGet - use NUOPC_Model, only : NUOPC_ModelGet + use ESMF , only : ESMF_GridComp, ESMF_GridCompGet + use ESMF , only : ESMF_Clock, ESMF_ClockGet, ESMF_ClockAdvance, ESMF_ClockSet + use ESMF , only : ESMF_Time, ESMF_TimeInterval, ESMF_TimeIntervalGet + use ESMF , only : ESMF_Alarm, ESMF_AlarmSet + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LOGMSG_ERROR + use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE + use NUOPC , only : NUOPC_CompAttributeGet + use NUOPC_Model , only : NUOPC_ModelGet + use med_time_mod , only : med_time_AlarmInit ! input/output variables type(ESMF_GridComp) :: gcomp @@ -60,42 +64,33 @@ 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)' !--------------------------------------- rc = ESMF_SUCCESS - ! ----------------------------- ! Get model clock - ! ----------------------------- - call NUOPC_ModelGet(gcomp, modelClock=mclock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! get current time - call ESMF_ClockGet(mclock, currTime=mCurrTime, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! ----------------------------- - ! Set alarm for instantaneous mediator restart output - ! ----------------------------- - + ! Determine restart frequency call NUOPC_CompAttributeGet(gcomp, name='restart_option', value=restart_option, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeGet(gcomp, name='restart_n', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) restart_n + ! Set alarm for instantaneous mediator restart output + call ESMF_ClockGet(mclock, currTime=mCurrTime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call med_time_alarmInit(mclock, alarm, option=restart_option, opt_n=restart_n, & reftime=mcurrTime, alarmname='alarm_restart', rc=rc) - call ESMF_AlarmSet(alarm, clock=mclock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - !-------------------------------- - ! Advance model clock to trigger alarms then reset model clock back to currtime - !-------------------------------- - + ! Advance model clock to trigger alarm then reset model clock back to currtime call ESMF_ClockGet(mclock, currTime=mCurrTime, timeStep=mtimestep, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeIntervalGet(mtimestep, s=timestep_length, rc=rc) @@ -105,23 +100,26 @@ subroutine med_phases_restart_alarm_init(gcomp, rc) call ESMF_ClockSet(mclock, currTime=mcurrtime, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! ----------------------------- - ! Write mediator diagnostic output - ! ----------------------------- + ! Handle end of run restart + call NUOPC_CompAttributeGet(gcomp, name="write_restart_at_endofrun", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + if (trim(cvalue) .eq. '.true.') write_restart_at_endofrun = .true. + end if + ! Write mediator diagnostic output if (mastertask) then write(logunit,*) - write(logunit,100) trim(subname)//" restart clock timestep = ",timestep_length - write(logunit,100) trim(subname)//" set restart alarm with option "//& + write(logunit,'(a,2x,i8)') trim(subname)//" restart clock timestep = ",timestep_length + write(logunit,'(a,2x,i8)') trim(subname)//" set restart alarm with option "//& trim(restart_option)//" and frequency ",restart_n -100 format(a,2x,i8) + write(logunit,'(a)') trim(subname)//" write_restart_at_endofrun : ", write_restart_at_endofrun write(logunit,*) end if end subroutine med_phases_restart_alarm_init !=============================================================================== - subroutine med_phases_restart_write(gcomp, rc) ! Write mediator restart @@ -130,14 +128,17 @@ subroutine med_phases_restart_write(gcomp, rc) use ESMF , only : ESMF_TimeInterval, ESMF_CalKind_Flag, ESMF_MAXSTR use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_FAILURE use ESMF , only : ESMF_LOGMSG_ERROR, operator(==), operator(-) - use ESMF , only : ESMF_GridCompGet, ESMF_VMGet, ESMF_ClockGet, ESMF_ClockGetNextTime + use ESMF , only : ESMF_GridCompGet, ESMF_ClockGet, ESMF_ClockGetNextTime use ESMF , only : ESMF_TimeGet, ESMF_ClockGetAlarm, ESMF_ClockPrint, ESMF_TimeIntervalGet use ESMF , only : ESMF_AlarmIsRinging, ESMF_AlarmRingerOff, ESMF_FieldBundleIsCreated use ESMF , only : ESMF_Calendar use NUOPC , only : NUOPC_CompAttributeGet use NUOPC_Model, only : NUOPC_ModelGet + use med_io_mod , only : med_io_define_time, med_io_write_time use med_io_mod , only : med_io_write, med_io_wopen, med_io_enddef use med_io_mod , only : med_io_close, med_io_date2yyyymmdd, med_io_sec2hms + use med_phases_history_mod, only : auxcomp + use med_constants_mod , only : SecPerDay => med_constants_SecPerDay ! Input/output variables type(ESMF_GridComp) :: gcomp @@ -149,13 +150,14 @@ 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 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 @@ -164,7 +166,7 @@ subroutine med_phases_restart_write(gcomp, rc) integer :: next_tod ! Starting time-of-day (s) integer :: nx,ny ! global grid size integer :: yr,mon,day,sec ! time units - real(R8) :: dayssince ! Time interval since start time + real(R8) :: days_since ! Time interval since start time integer :: unitn ! unit number character(ESMF_MAXSTR) :: time_units ! units of time variable character(ESMF_MAXSTR) :: case_name ! case name @@ -177,8 +179,6 @@ subroutine med_phases_restart_write(gcomp, rc) integer :: freq_n ! freq_n setting relative to freq_option logical :: alarmIsOn ! generic alarm flag real(R8) :: tbnds(2) ! CF1.0 time bounds - logical :: whead,wdata ! for writing restart/restart cdf files - integer :: iam ! vm stuff character(ESMF_MAXSTR) :: tmpstr logical :: isPresent logical :: first_time = .true. @@ -198,16 +198,8 @@ subroutine med_phases_restart_write(gcomp, rc) nullify(is_local%wrap) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_VMGet(vm, localPet=iam, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(gcomp, name='case_name', value=case_name, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(gcomp, name='inst_suffix', isPresent=isPresent, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if(isPresent) then @@ -216,7 +208,6 @@ subroutine med_phases_restart_write(gcomp, rc) else cpl_inst_tag = "" endif - call NUOPC_CompAttributeGet(gcomp, name='restart_dir', isPresent=isPresent, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if(isPresent) then @@ -238,39 +229,38 @@ subroutine med_phases_restart_write(gcomp, rc) call NUOPC_ModelGet(gcomp, modelClock=clock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - !--------------------------------------- - ! --- Restart Alarm - !--------------------------------------- - + ! Restart Alarm call ESMF_ClockGetAlarm(clock, alarmname='alarm_restart', alarm=alarm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (ESMF_AlarmIsRinging(alarm, rc=rc)) then if (ChkErr(rc,__LINE__,u_FILE_u)) return alarmIsOn = .true. call ESMF_AlarmRingerOff( alarm, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - 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 - call ESMF_ClockGetNextTime(clock, nextTime=nexttime, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockGet(clock, calendar=calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeGet(currtime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return write(currtimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec if (dbug_flag > 1) then call ESMF_LogWrite(trim(subname)//": currtime = "//trim(currtimestr), ESMF_LOGMSG_INFO) endif - call ESMF_TimeGet(nexttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return write(nexttimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec @@ -285,7 +275,7 @@ subroutine med_phases_restart_write(gcomp, rc) endif timediff = nexttime - starttime call ESMF_TimeIntervalGet(timediff, d=day, s=sec, rc=rc) - dayssince = day + sec/real(SecPerDay,R8) + days_since = day + sec/real(SecPerDay,R8) call ESMF_TimeGet(starttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -305,15 +295,15 @@ subroutine med_phases_restart_write(gcomp, rc) curr_tod = sec !--------------------------------------- - ! --- Restart File + ! Restart File ! Use nexttimestr rather than currtimestr here since that is the time at the end of ! the timestep and is preferred for restart file names !--------------------------------------- - write(restart_file,"(6a)") trim(restart_dir)//trim(case_name),'.cpl', & - trim(cpl_inst_tag),'.r.',trim(nexttimestr),'.nc' + write(restart_file,"(6a)") trim(restart_dir)//trim(case_name),'.cpl', trim(cpl_inst_tag),'.r.',& + trim(nexttimestr),'.nc' - if (iam == 0) then + if (mastertask) then restart_pfile = "rpointer.cpl"//cpl_inst_tag call ESMF_LogWrite(trim(subname)//" write rpointer file = "//trim(restart_pfile), ESMF_LOGMSG_INFO) open(newunit=unitn, file=restart_pfile, form='FORMATTED') @@ -322,129 +312,148 @@ subroutine med_phases_restart_write(gcomp, rc) endif call ESMF_LogWrite(trim(subname)//": write "//trim(restart_file), ESMF_LOGMSG_INFO) - call med_io_wopen(restart_file, vm, iam, clobber=.true.) + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_io_wopen(restart_file, vm, clobber=.true.) do m = 1,2 - if (m == 1) then - whead = .true. - wdata = .false. - else if (m == 2) then - whead = .false. - wdata = .true. - endif - if (wdata) then + if (m == 2) then call med_io_enddef(restart_file) end if - tbnds = dayssince + tbnds = days_since call ESMF_LogWrite(trim(subname)//": time "//trim(time_units), ESMF_LOGMSG_INFO) - if (tbnds(1) >= tbnds(2)) then - call med_io_write(restart_file, iam=iam, & - time_units=time_units, calendar=calendar, time_val=dayssince, & - whead=whead, wdata=wdata, rc=rc) + if (whead(m)) then + call ESMF_ClockGet(clock, calendar=calendar, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_io_define_time(time_units, calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call med_io_write(restart_file, iam=iam, & - time_units=time_units, calendar=calendar, time_val=dayssince, & - whead=whead, wdata=wdata, tbnds=tbnds, rc=rc) + call med_io_write_time(days_since, tbnds=(/days_since,days_since/), nt=1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - endif + end if ! Write out next ymd/tod in place of curr ymd/tod because the ! restart represents the time at end of the current timestep ! and that is where we want to start the next run. - - call med_io_write(restart_file, iam, start_ymd, 'start_ymd', whead=whead, wdata=wdata, rc=rc) - 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_ymd, 'start_ymd', whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_write(restart_file, iam, next_ymd , 'curr_ymd' , whead=whead, wdata=wdata, rc=rc) + call med_io_write(restart_file, start_tod, 'start_tod', whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_write(restart_file, iam, next_tod , 'curr_tod' , whead=whead, wdata=wdata, rc=rc) + call med_io_write(restart_file, next_ymd , 'curr_ymd' , whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call med_io_write(restart_file, iam, is_local%wrap%FBExpAccumCnt, dname='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', & - whead=whead, wdata=wdata, rc=rc) + call med_io_write(restart_file, next_tod , 'curr_tod' , whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return do n = 1,ncomps if (is_local%wrap%comp_present(n)) then nx = is_local%wrap%nx(n) ny = is_local%wrap%ny(n) - ! Write import field bundles if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(n,n),rc=rc)) then - !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) + call med_io_write(restart_file, is_local%wrap%FBimp(n,n), whead(m), wdata(m), nx, ny, & + nt=1, pre=trim(compname(n))//'Imp', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif - ! Write export field bundles if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(n),rc=rc)) then - !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%FBexp(n), & - nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre=trim(compname(n))//'Exp', rc=rc) + call med_io_write(restart_file, is_local%wrap%FBexp(n), whead(m), wdata(m), nx, ny, & + nt=1, pre=trim(compname(n))//'Exp', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif - ! Write fraction field bundles if (ESMF_FieldBundleIsCreated(is_local%wrap%FBfrac(n),rc=rc)) then - !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) + call med_io_write(restart_file, is_local%wrap%FBfrac(n), whead(m), wdata(m), nx, ny, & + nt=1, pre=trim(compname(n))//'Frac', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif + end if + enddo - ! 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 - endif + ! Write export accumulation to ocn + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBExpAccumOcn)) then + nx = is_local%wrap%nx(compocn) + ny = is_local%wrap%ny(compocn) + call med_io_write(restart_file, 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=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif - ! 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 - 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 - endif - enddo + ! 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, 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=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + ! 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, 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, ocnAccum2glc_cnt, 'ocnImpAccum2glc_cnt', whead(m), wdata(m), 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 nx = is_local%wrap%nx(compocn) ny = is_local%wrap%ny(compocn) - call med_io_write(restart_file, iam, is_local%wrap%FBMed_ocnalb_o, & - nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre='MedOcnAlb_o', rc=rc) + call med_io_write(restart_file, is_local%wrap%FBMed_ocnalb_o, whead(m), wdata(m), nx, ny, & + nt=1, pre='MedOcnAlb_o', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - enddo + ! Write auxiliary files accumulation - + ! For now assume that any time averaged history file has only + ! one time sample - this will be generalized in the future + do nc = 2,ncomps + do nf = 1,auxcomp(nc)%num_auxfiles + if (auxcomp(nc)%files(nf)%doavg .and. auxcomp(nc)%files(nf)%accumcnt > 0) then + nx = is_local%wrap%nx(nc) + ny = is_local%wrap%ny(nc) + call med_io_write(restart_file, auxcomp(nc)%files(nf)%FBaccum, & + whead(m), wdata(m), nx, ny, & + nt=1, pre=trim(compname(nc))//trim(auxcomp(nc)%files(nf)%auxname), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_io_write(restart_file, auxcomp(nc)%files(nf)%accumcnt, & + trim(compname(nc))//trim(auxcomp(nc)%files(nf)%auxname)//'_accumcnt', & + whead(m), wdata(m), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end do + end do + + enddo ! end of whead/wdata loop ! Close file - call med_io_close(restart_file, iam, rc=rc) + call med_io_close(restart_file, vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif !--------------------------------------- !--- clean up !--------------------------------------- - + lasttimewritten = currtime if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif @@ -453,7 +462,6 @@ subroutine med_phases_restart_write(gcomp, rc) end subroutine med_phases_restart_write !=============================================================================== - subroutine med_phases_restart_read(gcomp, rc) ! Read mediator restart @@ -461,14 +469,14 @@ subroutine med_phases_restart_read(gcomp, rc) use ESMF , only : ESMF_GridComp, ESMF_VM, ESMF_Clock, ESMF_Time, ESMF_MAXSTR use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_FAILURE use ESMF , only : ESMF_LOGMSG_ERROR, ESMF_VMBroadCast - use ESMF , only : ESMF_GridCompGet, ESMF_VMGet, ESMF_ClockGet, ESMF_ClockPrint + use ESMF , only : ESMF_GridCompGet, ESMF_ClockGet, ESMF_ClockPrint use ESMF , only : ESMF_FieldBundleIsCreated, ESMF_TimeGet use NUOPC , only : NUOPC_CompAttributeGet use med_io_mod , only : med_io_read ! Input/output variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc ! Local variables type(ESMF_VM) :: vm @@ -476,76 +484,56 @@ subroutine med_phases_restart_read(gcomp, rc) type(ESMF_Time) :: currtime character(len=CS) :: currtimestr type(InternalState) :: is_local - integer :: i,j,m,n,n1,ncnt + integer :: i,j,m,n integer :: ierr, unitn integer :: yr,mon,day,sec ! time units - integer :: iam ! vm stuff character(ESMF_MAXSTR) :: case_name ! case name character(ESMF_MAXSTR) :: restart_file ! Local path to restart filename character(ESMF_MAXSTR) :: restart_pfile ! Local path to restart pointer filename character(ESMF_MAXSTR) :: cpl_inst_tag ! instance tag logical :: isPresent - character(len=*), parameter :: sp_str = 'str_undefined' character(len=*), parameter :: subname='(med_phases_restart_read)' !--------------------------------------- call t_startf('MED:'//subname) call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) rc = ESMF_SUCCESS - !--------------------------------------- - ! --- Get the internal state - !--------------------------------------- - + ! Get the internal state nullify(is_local%wrap) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMGet(vm, localPet=iam, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - + ! Get case name and inst suffix call NUOPC_CompAttributeGet(gcomp, name='case_name', value=case_name, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(gcomp, name='inst_suffix', isPresent=isPresent, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if(isPresent) then + if (isPresent) then call NUOPC_CompAttributeGet(gcomp, name='inst_suffix', value=cpl_inst_tag, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else cpl_inst_tag = "" endif - !--------------------------------------- - ! --- Get the clock info - !--------------------------------------- - + ! Get the clock info call ESMF_GridCompGet(gcomp, clock=clock) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockGet(clock, currtime=currtime, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeGet(currtime,yy=yr, mm=mon, dd=day, s=sec, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return write(currtimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec if (dbug_flag > 1) then call ESMF_LogWrite(trim(subname)//": currtime = "//trim(currtimestr), ESMF_LOGMSG_INFO) endif - if (iam==0) then + if (mastertask) then call ESMF_ClockPrint(clock, options="currTime", preString="-------->"//trim(subname)//" mediating for: ", rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif - !--------------------------------------- - ! --- Restart File - !--------------------------------------- - ! Get the restart file name from the pointer file - restart_pfile = "rpointer.cpl"//cpl_inst_tag - if (iam == 0) then + if (mastertask) then call ESMF_LogWrite(trim(subname)//" read rpointer file = "//trim(restart_pfile), ESMF_LOGMSG_INFO) open(newunit=unitn, file=restart_pfile, form='FORMATTED', status='old', iostat=ierr) if (ierr < 0) then @@ -562,54 +550,64 @@ subroutine med_phases_restart_read(gcomp, rc) close(unitn) call ESMF_LogWrite(trim(subname)//' restart file from rpointer = '//trim(restart_file), ESMF_LOGMSG_INFO) endif + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_VMBroadCast(vm, restart_file, len(restart_file), 0, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(trim(subname)//": read "//trim(restart_file), ESMF_LOGMSG_INFO) ! Now read in the restart file - - call med_io_read(restart_file, vm, iam, is_local%wrap%FBExpAccumCnt, dname='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) - 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) - 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) - 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%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->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) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + 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) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + 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 @@ -623,7 +621,6 @@ subroutine med_phases_restart_read(gcomp, rc) end subroutine med_phases_restart_read !=============================================================================== - subroutine ymd2date(year,month,day,date) ! Converts year, month, day to coded-date ! NOTE: this calendar has a year zero (but no day or month zero) diff --git a/mediator/med_time_mod.F90 b/mediator/med_time_mod.F90 index 09dbaffb9..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 @@ -15,9 +15,9 @@ module med_time_mod use ESMF , only : operator(<), operator(/=), operator(+) use ESMF , only : operator(-), operator(*) , operator(>=) use ESMF , only : operator(<=), operator(>), operator(==) - use NUOPC , only : NUOPC_CompAttributeGet use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_utils_mod , only : chkerr => med_utils_ChkErr + use med_internalstate_mod, only : mastertask, logunit implicit none private ! default private @@ -38,6 +38,7 @@ module med_time_mod optMonthly = "monthly" , & optYearly = "yearly" , & optDate = "date" , & + optEnd = "end" , & optGLCCouplingPeriod = "glc_coupling_period" ! Module data @@ -50,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 @@ -64,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 @@ -82,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): ' @@ -154,6 +156,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 +179,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 +233,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 @@ -246,12 +254,32 @@ subroutine med_time_alarmInit( clock, alarm, option, & enddo endif + if (mastertask) then + write(logunit,*) + write(logunit,'(a)') trim(subname) //' creating alarm '// trim(lalarmname) + end if + alarm = ESMF_AlarmCreate( name=lalarmname, clock=clock, ringTime=NextAlarm, & ringInterval=AlarmInterval, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Advance model clock to trigger alarm then reset model clock back to currtime + if (present(advance_clock)) then + if (advance_clock) then + call ESMF_AlarmSet(alarm, clock=clock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockGet(clock, currTime=CurrTime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockAdvance(clock,rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockSet(clock, currTime=currtime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end if + end subroutine med_time_alarmInit + !=============================================================================== subroutine med_time_date2ymd (date, year, month, day) ! input/output variables @@ -262,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 @@ -270,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 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