diff --git a/.github/pull_request_template.md b/.github/pull_request_template.md index 36cc6403f..438a2f450 100644 --- a/.github/pull_request_template.md +++ b/.github/pull_request_template.md @@ -6,16 +6,13 @@ Contributors other than yourself, if any: CMEPS Issues Fixed (include github issue #): -Are changes expected to change answers? - - [ ] bit for bit - - [ ] different at roundoff level - - [ ] more substantial +Are changes expected to change answers? (specify if bfb, different at roundoff, more substantial) Any User Interface Changes (namelist or namelist defaults changes)? - - [ ] Yes - - [ ] No -Testing performed if application target is CESM:(either UFS-S2S or CESM testing is required): +### Testing performed + +Testing performed if application target is CESM: - [ ] (recommended) CIME_DRIVER=nuopc scripts_regression_tests.py - machines: - details (e.g. failed tests): @@ -39,16 +36,14 @@ Testing performed if application target is UFS-HAFS: - description: - details (e.g. failed tests): -Hashes used for testing: +### Hashes used for testing: + - [ ] CESM: - repository to check out: https://github.com/ESCOMP/CESM.git - - branch: - - hash: + - branch/hash: - [ ] UFS-coupled, then umbrella repostiory to check out and associated hash: - repository to check out: - - branch: - - hash: + - branch/hash: - [ ] UFS-HAFS, then umbrella repostiory to check out and associated hash: - repository to check out: - - branch: - - hash: + - branch/hash: diff --git a/cesm/nuopc_cap_share/shr_fire_emis_mod.F90 b/cesm/nuopc_cap_share/shr_fire_emis_mod.F90 index 30931271e..47e9cf117 100644 --- a/cesm/nuopc_cap_share/shr_fire_emis_mod.F90 +++ b/cesm/nuopc_cap_share/shr_fire_emis_mod.F90 @@ -42,7 +42,6 @@ module shr_fire_emis_mod character(len=name_len) :: name ! emissions component name (in fire emissions input table) integer :: index real(r8), pointer :: emis_factors(:) ! function of plant-function-type (PFT) - real(r8) :: coeff ! emissions component coeffecient real(r8) :: molec_weight ! molecular weight of the fire emissions compound (g/mole) type(shr_fire_emis_comp_t), pointer :: next_emiscomp ! points to next member in the linked list endtype shr_fire_emis_comp_t @@ -55,6 +54,7 @@ module shr_fire_emis_mod type shr_fire_emis_mechcomp_t character(len=16) :: name ! compound name type(shr_fire_emis_comp_ptr), pointer :: emis_comps(:) ! an array of pointers to fire emis components + real(r8), pointer :: coeffs(:) ! coeffecients to emissions components integer :: n_emis_comps ! number of fire emis compounds that make up the emissions for this mechanis compound end type shr_fire_emis_mechcomp_t @@ -96,7 +96,7 @@ subroutine shr_fire_emis_readnl( NLFileName, emis_nflds ) ! corresponding chemical tracers. ! !------------------------------------------------------------------------- - + ! input/output variables character(len=*), intent(in) :: NLFileName ! name of namelist file integer , intent(out) :: emis_nflds @@ -125,12 +125,12 @@ subroutine shr_fire_emis_readnl( NLFileName, emis_nflds ) ! If other processes have already initialized megan - then the info will just be re-initialized call ESMF_VMGetCurrent(vm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return call ESMF_VMGet(vm, localPet=localPet, mpiCommunicator=mpicom, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - ! Note the following still needs to be called on all processors since the mpi_bcast is a collective + ! Note the following still needs to be called on all processors since the mpi_bcast is a collective ! call on all the pes of mpicom if (localPet==0) then inquire( file=trim(NLFileName), exist=exists) @@ -205,9 +205,12 @@ subroutine shr_fire_emis_init( specifier ) endif shr_fire_emis_mechcomps(i)%n_emis_comps = item%n_terms allocate(shr_fire_emis_mechcomps(i)%emis_comps(item%n_terms)) + allocate(shr_fire_emis_mechcomps(i)%coeffs(item%n_terms)) + + shr_fire_emis_mechcomps(i)%coeffs(:) = item%coeffs(:) do j = 1,item%n_terms - shr_fire_emis_mechcomps(i)%emis_comps(j)%ptr => add_emis_comp( item%vars(j), item%coeffs(j) ) + shr_fire_emis_mechcomps(i)%emis_comps(j)%ptr => add_emis_comp( item%vars(j) ) enddo shr_fire_emis_mechcomps_n = shr_fire_emis_mechcomps_n+1 @@ -224,10 +227,9 @@ end subroutine shr_fire_emis_init !------------------------------------------------------------------------- - function add_emis_comp( name, coeff ) result(emis_comp) + function add_emis_comp( name ) result(emis_comp) character(len=*), intent(in) :: name - real(r8), intent(in) :: coeff type(shr_fire_emis_comp_t), pointer :: emis_comp emis_comp => get_emis_comp_by_name(shr_fire_emis_linkedlist, name) @@ -245,7 +247,6 @@ function add_emis_comp( name, coeff ) result(emis_comp) emis_comp%index = shr_fire_emis_comps_n+1 emis_comp%name = trim(name) - emis_comp%coeff = coeff nullify(emis_comp%next_emiscomp) call add_emis_comp_to_list(emis_comp) diff --git a/cime_config/buildexe b/cime_config/buildexe index f02d0a399..f2a0c905c 100755 --- a/cime_config/buildexe +++ b/cime_config/buildexe @@ -37,7 +37,6 @@ def _main_func(): cime_model = case.get_value("MODEL") num_esp = case.get_value("NUM_COMP_INST_ESP") ocn_model = case.get_value("COMP_OCN") - atm_model = case.get_value("COMP_ATM") gmake_args = get_standard_makefile_args(case) esmf_aware_threading = case.get_value("ESMF_AWARE_THREADING") @@ -63,7 +62,7 @@ def _main_func(): else: skip_mediator = False - if ocn_model == 'mom' or atm_model == "ufsatm": + if ocn_model == 'mom': gmake_args += "USE_FMS=TRUE" comp_classes = case.get_values("COMP_CLASSES") diff --git a/cime_config/buildnml b/cime_config/buildnml index 11c20e276..2bc7c82b9 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -223,21 +223,21 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): # End if pause is active #-------------------------------- - # (1) Specify input data list file + # Specify input data list file #-------------------------------- data_list_path = os.path.join(case.get_case_root(), "Buildconf", "cpl.input_data_list") if os.path.exists(data_list_path): os.remove(data_list_path) #-------------------------------- - # (2) Write namelist file drv_in and initial input dataset list. + # Write namelist file drv_in and initial input dataset list. #-------------------------------- namelist_file = os.path.join(confdir, "drv_in") drv_namelist_groups = ["papi_inparm", "pio_default_inparm", "prof_inparm", "debug_inparm"] nmlgen.write_output_file(namelist_file, data_list_path=data_list_path, groups=drv_namelist_groups) #-------------------------------- - # (3) Write nuopc.runconfig file and add to input dataset list. + # Write nuopc.runconfig file and add to input dataset list. #-------------------------------- # Determine valid components @@ -291,7 +291,7 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): nmlgen.write_nuopc_config_file(nuopc_config_file, data_list_path=data_list_path) #-------------------------------- - # (3.1) Update nuopc.runconfig file if component needs it + # Update nuopc.runconfig file if component needs it #-------------------------------- # Read nuopc.runconfig @@ -330,12 +330,12 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): f.write(line) #-------------------------------- - # (4) Write nuopc.runseq + # Write nuopc.runseq #-------------------------------- _create_runseq(case, coupling_times, valid_comps) #-------------------------------- - # (5) Write drv_flds_in + # Write drv_flds_in #-------------------------------- # In thte following, all values come simply from the infiles - no default values need to be added # FIXME - do want to add the possibility that will use a user definition file for drv_flds_in @@ -567,7 +567,6 @@ def buildnml(case, caseroot, component): files.set_value("COMP_ROOT_DIR_CPL", comp_root_dir_cpl) definition_file = [files.get_value("NAMELIST_DEFINITION_FILE", {"component": "cpl"})] - fd_dir = os.path.dirname(definition_file[0]) user_definition = os.path.join(user_xml_dir, "namelist_definition_drv.xml") if os.path.isfile(user_definition): definition_file = [user_definition] @@ -606,15 +605,12 @@ def buildnml(case, caseroot, component): for filename in glob.glob(os.path.join(confdir, "*modelio*")): shutil.copy(filename, rundir) - # copy fd_cesm.yaml to rundir - fd_dir = os.path.join(os.path.dirname(__file__),os.pardir,"mediator") - coupling_mode = case.get_value('COUPLING_MODE') - if coupling_mode == 'cesm': - filename = os.path.join(fd_dir,"fd_cesm.yaml") - elif 'nems' in coupling_mode or coupling_mode == 'hafs': - filename = os.path.join(fd_dir,"fd_nems.yaml") + # copy fd_cesm.yaml to rundir - look in user_xml_dir first + user_yaml_file = os.path.join(user_xml_dir, "fd_cesm.yaml") + if os.path.isfile(user_yaml_file): + filename = user_yaml_file else: - expect(False, "coupling mode currently only supports cesm") + filename = os.path.join(os.path.dirname(__file__), os.pardir, "mediator", "fd_cesm.yaml") shutil.copy(filename, os.path.join(rundir, "fd.yaml")) ############################################################################### diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index 49bc7d0d8..aeb7770fc 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -28,7 +28,7 @@ char - cesm,nems_orig,nems_orig_data,nems_frac,hafs + cesm cesm run_coupling env_run.xml @@ -1685,6 +1685,20 @@ $CIMEROOT/machines/config_machines.xml + + char + UNSET + run_din + env_run.xml + + On some systems the filesystem of DIN_LOC_ROOT is not available on compute nodes and + data must be staged to a temporary location. If this variable is defined it will + be used as the root directory of an inputdata staging area. + Default values for the target machine are in the + $CIMEROOT/machines/config_machines.xml + + + char UNSET diff --git a/cime_config/config_component_ufs.xml b/cime_config/config_component_ufs.xml deleted file mode 100644 index bb32df7b5..000000000 --- a/cime_config/config_component_ufs.xml +++ /dev/null @@ -1,567 +0,0 @@ - - - - - - - - - 1972-2004 - 2002-2003 - 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 - Biogeochemistry intercomponent - with diagnostic CO2 - with prognostic CO2 - - - - char - https://doi.org/10.5065/D67H1H0V - run_metadata - env_case.xml - run DOI - - - - logical - TRUE,FALSE - FALSE - run_flags - env_run.xml - logical to save timing files in rundir - - - - integer - 0 - run_flags - env_run.xml - Determines number of times profiler is called over the model run period. - This sets values for tprof_option and tprof_n that determine the timing output file frequency - - - - - integer - 2 - run_flags - env_run.xml - - integer indicating maximum detail level to profile. This xml - variable is used to set the namelist variable - timing_detail_limit. This namelist variable is used by perf_mod - (in $CIMEROOT/src/share/timing/perf_mod.F90) to turn timers off - and on depending on calls to the routine t_adj_detailf. If in the - code a statement appears like t_adj_detailf(+1), then the current - timer detail level is incremented by 1 and compared to the - time_detail_limit obtained from the namelist. If the limit is - exceeded then the timer is turned off. - - - - - integer - 4 - run_flags - env_run.xml - Maximum code stack depth of enabled timers. - - - - logical - TRUE,FALSE - FALSE - run_data_archive - env_run.xml - Logical to archive all interim restart files, not just those at eor - If TRUE, perform short term archiving on all interim restart files, - not just those at the end of the run. By default, this value is TRUE. - The restart files are saved under the specific component directory - ($DOUT_S_ROOT/$CASE/$COMPONENT/rest rather than the top-level $DOUT_S_ROOT/$CASE/rest directory). - Interim restart files are created using the REST_N and REST_OPTION variables. - This is for expert users ONLY and requires expert knowledge. - 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 - none - - CO2A - none - CO2A - CO2A - CO2A - CO2C - CO2C - - run_coupling - env_run.xml - Activates additional CO2-related fields to be exchanged between components. Possible values are: - - CO2A: sets the driver namelist variable flds_co2a = .true.; this adds - prognostic CO2 and diagnostic CO2 at the lowest model level to be sent from - the atmosphere to the land and ocean. - - CO2B: sets the driver namelist variable flds_co2b = .true.; this adds - prognostic CO2 and diagnostic CO2 at the lowest model level to be sent from - the atmosphere just to the land, and the surface upward flux of CO2 to be - sent from the land back to the atmosphere - - CO2C: sets the driver namelist variable flds_co2c = .true.; this adds - prognostic CO2 and diagnostic CO2 at the lowest model level to be sent from - the atmosphere to the land and ocean, and the surface upward flux of CO2 - to be sent from the land and the open ocean back to the atmosphere. - - The namelist variables flds_co2a, flds_co2b and flds_co2c are in the - namelist group cpl_flds_inparm. - - - - - char - - - - - - run_component_cpl - env_case.xml - User mods to apply to specific compset matches. - - - - char - hour,day,year,decade - run_coupling - env_run.xml - day - - year - hour - - Base period associated with NCPL coupling frequency. - This xml variable is only used to set the driver namelist variables, - atm_cpl_dt, lnd_cpl_dt, ocn_cpl_dt, ice_cpl_dt, glc_cpl_dt, rof_cpl_dt, wav_cpl_dt, and esp_dt. - - - - integer - 48 - - 144 - 288 - 288 - 72 - 48 - - - 24 - 24 - 24 - 24 - 24 - 24 - 48 - 48 - 1 - 96 - 96 - 96 - 96 - 192 - 192 - 192 - 192 - 384 - 384 - 384 - 144 - 72 - 144 - 288 - 48 - 48 - 24 - 24 - 1 - - - - run_coupling - env_run.xml - Number of atm coupling intervals per NCPL_BASE_PERIOD. - This is used to set the driver namelist atm_cpl_dt, equal to basedt/ATM_NCPL, - where basedt is equal to NCPL_BASE_PERIOD in seconds. - - - - integer - $ATM_NCPL - - 1 - - run_coupling - env_run.xml - Number of land coupling intervals per NCPL_BASE_PERIOD. - This is used to set the driver namelist atm_cpl_dt, equal to basedt/LND_NCPL, - where basedt is equal to NCPL_BASE_PERIOD in seconds. - - - - integer - $ATM_NCPL - - 1 - - run_coupling - env_run.xml - Number of ice coupling intervals per NCPL_BASE_PERIOD. - This is used to set the driver namelist ice_cpl_dt, equal to basedt/ICE_NCPL - where basedt is equal to NCPL_BASE_PERIOD in seconds. - - - - integer - $ATM_NCPL - - 24 - 24 - 4 - 24 - 24 - - - - - 1 - - run_coupling - env_run.xml - Number of ocn coupling intervals per NCPL_BASE_PERIOD. - Thisn is used to set the driver namelist ocn_cpl_dt, equal to basedt/OCN_NCPL - where basedt is equal to NCPL_BASE_PERIOD in seconds. - - - - integer - 1 - - 1 - $ATM_NCPL - $ATM_NCPL - 1 - - run_coupling - env_run.xml - Number of glc coupling intervals per NCPL_BASE_PERIOD. - - - - char - glc_coupling_period,yearly - yearly - run_coupling - env_run.xml - Period at which coupler averages fields sent to GLC. - This supports doing the averaging to GLC less frequently than GLC is called - (i.e., separating the averaging frequency from the calling frequency). - This is useful because there are benefits to only averaging the GLC inputs - as frequently as they are really needed (yearly for CISM), but GLC needs to - still be called more frequently than that in order to support mid-year restarts. - - Setting GLC_AVG_PERIOD to 'glc_coupling_period' means that the averaging is - done exactly when the GLC is called (governed by GLC_NCPL). - - IMPORTANT: In order to restart mid-year when running with CISM, you MUST specify GLC_AVG_PERIOD = 'yearly'. - If using GLC_AVG_PERIOD = 'glc_coupling_period' with CISM, you can only restart on year boundaries. - - - - - integer - 8 - - $ATM_NCPL - $ATM_NCPL - $ATM_NCPL - $ATM_NCPL - 8 - 8 - $ATM_NCPL - 1 - $ATM_NCPL - - run_coupling - env_run.xml - Number of rof coupling intervals per NCPL_BASE_PERIOD. - This is used to set the driver namelist rof_cpl_dt, equal to basedt/ROF_NCPL - where basedt is equal to NCPL_BASE_PERIOD in seconds. - - - - integer - $ATM_NCPL - run_coupling - env_run.xml - Number of wav coupling intervals per NCPL_BASE_PERIOD. - This is used to set the driver namelist wav_cpl_dt, equal to basedt/WAV_NCPL - where basedt is equal to NCPL_BASE_PERIOD in seconds. - - - - - - logical - TRUE,FALSE - FALSE - - TRUE - TRUE - TRUE - FALSE - - run_component_cpl - env_run.xml - - Only used for compsets with DATM and POP (currently C, G and J): - If true, compute albedos to work with daily avg SW down - If false (default), albedos are computed with the assumption that downward - solar radiation from the atm component has a diurnal cycle and zenith-angle - dependence. This is normally the case when using an active atm component - If true, albedos are computed with the assumption that downward - solar radiation from the atm component is a daily average quantity and - does not have a zenith-angle dependence. This is often the case when - using a data atm component. Only used for compsets with DATM and POP (currently C, G and J). - NOTE: This should really depend on the datm forcing and not the compset per se. - So, for example, whether it is set in a J compset should depend on - what datm forcing is used. - - - - - char - off,ocn - off - - ocn - off - - run_component_cpl - env_run.xml - - Only used for compsets with DATM and POP (currently C, G and J): - If ocn, ocn provides EP balance factor for precipitation. - Provides EP balance factor for precip for POP. A factor computed by - POP is applied to precipitation so that precipitation balances - evaporation and ocn global salinity does not drift. This is intended - for use when coupling POP to a DATM. Only used for C, G and J compsets. - Default is off - - - - - char - TIGHT,RASM - TIGHT - - RASM - RASM - RASM - RASM - RASM - RASM - RASM - RASM - - 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. - - - - - 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 - never - - nmonths - - run_drv_history - env_run.xml - Sets driver average history file frequency (like REST_OPTION) - - - char - - -999 - - 1 - - run_drv_history - env_run.xml - Sets driver average history file frequency (like REST_N) - - - integer - - -999 - run_drv_history - env_run.xml - yyyymmdd format, sets driver average history date (like REST_DATE) - - - - logical - TRUE,FALSE - FALSE - - TRUE - TRUE - TRUE - - run_budgets - env_run.xml - logical that turns on diagnostic budgets for driver - - - - real - - 284.7 - - 367.0 - 284.7 - - run_co2 - env_run.xml - - Mechanism for setting the CO2 value in ppmv for - CLM if CLM_CO2_TYPE is constant or for - POP if OCN_CO2_TYPE is constant. - - - - - logical - TRUE,FALSE - FALSE - - TRUE - TRUE - - run_flags - env_run.xml - Turn on the passing of water isotope fields through the coupler - - - - integer - 1,3,5,10,36 - 10 - run_glc - env_run.xml - Number of glacier elevation classes used in CLM. - Used by both CLM and the coupler (even if CISM is not running, and only SGLC is used). - - - - logical - TRUE,FALSE - FALSE - - TRUE - - TRUE - - run_glc - env_run.xml - Whether the glacier component feeds back to the rest of the system - This affects: - (1) Whether CLM updates its areas based on glacier areas sent from GLC - (2) Whether GLC sends fluxes (e.g., calving fluxes) to the coupler - Note that this is set to TRUE by default for TG compsets - even though there are - no feedbacks for TG compsets, this enables extra coupler diagnostics for these - compsets. - - - - char - minus1p8,linear_salt,mushy - mushy - run_physics - env_run.xml - Freezing point calculation for salt water. - - - - diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index a38cfed1c..02c8f44ce 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -40,11 +40,10 @@ char expdef DRIVER_attributes - cesm,ufs + cesm cime model - cesm - ufs + cesm @@ -346,6 +345,7 @@ char mapping + abs ALLCOMP_attributes MESH for model mask (used to create masks and fractions at run time if different than model mesh) @@ -2270,11 +2270,9 @@ flds ALLCOMP_attributes - Previously, new fields that were needed to be passed between components - for certain compsets were specified by cpp-variables. This has been - modified to now be use cases. This use cases are specified in the - namelist cpl_flds_inparm and are currently triggered by the xml variable CCSM_BGC. - If CCSM_BGC is set to 'CO2A', then flds_co2a will be set to .true. + Pass CO2 from ATM to surface components + Set this by setting the xml variable BGC_MODE. + If BGC_MODE is set to 'CO2A', then flds_co2a will be set to .true. .false. @@ -2287,11 +2285,9 @@ flds ALLCOMP_attributes - Previously, new fields that were needed to be passed between components - for certain compsets were specified by cpp-variables. This has been - modified to now be use cases. This use cases are specified in the - namelist cpl_flds_inparm and are currently triggered by the xml variable CCSM_BGC. - If CCSM_BGC is set to 'CO2B', then flds_co2b will be set to .true. + Pass CO2 from ATM to LND and back from LND to ATM + Set this by setting the xml variable BGC_MODE. + If BGC_MODE is set to 'CO2B', then flds_co2b will be set to .true. .false. @@ -2304,11 +2300,9 @@ flds ALLCOMP_attributes - Previously, new fields that were needed to be passed between components - for certain compsets were specified by cpp-variables. This has been - modified to now be use cases. This use cases are specified in the - namelist cpl_flds_inparm and are currently triggered by the xml variable CCSM_BGC. - If CCSM_BGC is set to 'CO2C', then flds_co2c will be set to .true. + Pass CO2 from ATM to surface (OCN/LND) and back from them to ATM + Set this by setting the xml variable BGC_MODE. + If BGC_MODE is set to 'CO2C', then flds_co2c will be set to .true. .false. @@ -2343,6 +2337,19 @@ + + logical + flds + ALLCOMP_attributes + + Pass channel depths from river component to land component. This is needed for the hillslope + model in CTSM. + + + .false. + + + integer flds @@ -3813,6 +3820,7 @@ char mapping + abs ATM_attributes MESH description of atm grid @@ -3872,6 +3880,7 @@ char mapping + abs ICE_attributes MESH description of ice grid @@ -3898,6 +3907,7 @@ char mapping + abs ALLCOMP_attributes MESH description of glc grid @@ -3924,6 +3934,7 @@ char mapping + abs LND_attributes MESH description of lnd grid @@ -3950,6 +3961,7 @@ char mapping + abs OCN_attributes MESH description of ocn grid @@ -3976,6 +3988,7 @@ char mapping + abs ROF_attributes MESH description of rof grid @@ -4002,6 +4015,7 @@ char mapping + abs WAV_attributes MESH description of wav grid diff --git a/cime_config/runseq/runseq_general.py b/cime_config/runseq/runseq_general.py index 7bfa3aaa6..2b7f0cc0a 100644 --- a/cime_config/runseq/runseq_general.py +++ b/cime_config/runseq/runseq_general.py @@ -110,7 +110,8 @@ def gen_runseq(case, coupling_times): runseq.add_action("MED med_phases_prep_ice" , med_to_ice) runseq.add_action("MED -> ICE :remapMethod=redist" , med_to_ice) - runseq.add_action("MED med_phases_prep_wav" , med_to_wav) + runseq.add_action("MED med_phases_prep_wav_accum" , med_to_wav) + runseq.add_action("MED med_phases_prep_wav_avg" , med_to_wav) runseq.add_action("MED -> WAV :remapMethod=redist" , med_to_wav) runseq.add_action("MED med_phases_prep_rof" , med_to_rof and not rof_outer_loop) diff --git a/mediator/esmFlds.F90 b/mediator/esmFlds.F90 index c2bc91c5b..36dda2519 100644 --- a/mediator/esmFlds.F90 +++ b/mediator/esmFlds.F90 @@ -1,111 +1,17 @@ module esmflds 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 : ncomps, compname, compocn, compatm + use med_internalstate_mod, only : mapfcopy, mapnames, mapunset implicit none private - !----------------------------------------------- - ! Set components - !----------------------------------------------- - - integer, public, parameter :: compmed = 1 - integer, public, parameter :: compatm = 2 - integer, public, parameter :: complnd = 3 - integer, public, parameter :: compocn = 4 - integer, public, parameter :: compice = 5 - integer, public, parameter :: comprof = 6 - integer, public, parameter :: compwav = 7 - integer, public, parameter :: compglc1 = 8 - integer, public, parameter :: compglc2 = 9 - integer, public, parameter :: ncomps = 9 - - character(len=*), public, parameter :: compname(ncomps) = & - (/'med ',& - 'atm ',& - 'lnd ',& - 'ocn ',& - 'ice ',& - 'rof ',& - 'wav ',& - 'glc1',& - 'glc2'/) - - integer, public, parameter :: max_icesheets = 2 - integer, public :: compglc(max_icesheets) = (/compglc1,compglc2/) - integer, public :: num_icesheets ! obtained from attribute - logical, public :: ocn2glc_coupling ! obtained from attribute - logical, public :: 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. - - !----------------------------------------------- - ! Set mappers - !----------------------------------------------- - - integer , public, parameter :: mapunset = 0 - integer , public, parameter :: mapbilnr = 1 - integer , public, parameter :: mapconsf = 2 - integer , public, parameter :: mapconsd = 3 - integer , public, parameter :: mappatch = 4 - integer , public, parameter :: mapfcopy = 5 - integer , public, parameter :: mapnstod = 6 ! nearest source to destination - integer , public, parameter :: mapnstod_consd = 7 ! nearest source to destination followed by conservative dst - integer , public, parameter :: mapnstod_consf = 8 ! nearest source to destination followed by conservative frac - integer , public, parameter :: mappatch_uv3d = 9 ! rotate u,v to 3d cartesian space, map from src->dest, then rotate back - integer , public, parameter :: mapbilnr_uv3d = 10 ! rotate u,v to 3d cartesian space, map from src->dest, then rotate back - integer , public, parameter :: map_rof2ocn_ice = 11 ! custom smoothing map to map ice from rof->ocn (cesm only) - integer , public, parameter :: map_rof2ocn_liq = 12 ! custom smoothing map to map liq from rof->ocn (cesm only) - integer , public, parameter :: map_glc2ocn_liq = 13 ! custom smoothing map to map liq from glc->ocn (cesm only) - integer , public, parameter :: map_glc2ocn_ice = 14 ! custom smoothing map to map ice from glc->ocn (cesm only) - integer , public, parameter :: mapfillv_bilnr = 15 ! fill value followed by bilinear - integer , public, parameter :: mapbilnr_nstod = 16 ! bilinear with nstod extrapolation - integer , public, parameter :: mapconsf_aofrac = 17 ! conservative with aofrac normalization (ufs only) - integer , public, parameter :: nmappers = 17 - - character(len=*) , public, parameter :: mapnames(nmappers) = & - (/'bilnr ',& - 'consf ',& - 'consd ',& - 'patch ',& - 'fcopy ',& - 'nstod ',& - 'nstod_consd ',& - 'nstod_consf ',& - 'patch_uv3d ',& - 'bilnr_uv3d ',& - 'rof2ocn_ice ',& - 'rof2ocn_liq ',& - 'glc2ocn_ice ',& - 'glc2ocn_liq ',& - 'fillv_bilnr ',& - 'bilnr_nstod ',& - 'consf_aofrac'/) - - !----------------------------------------------- - ! Set coupling mode - !----------------------------------------------- - - character(len=CS), public :: coupling_mode ! valid values are [cesm,nems_orig,nems_frac,nems_orig_data,hafs] - - !----------------------------------------------- - ! Name of model components - !----------------------------------------------- - - character(len=CS), public :: med_name = '' - character(len=CS), public :: atm_name = '' - character(len=CS), public :: lnd_name = '' - character(len=CS), public :: ocn_name = '' - character(len=CS), public :: ice_name = '' - character(len=CS), public :: rof_name = '' - character(len=CS), public :: wav_name = '' - character(len=CS), public :: glc_name = '' - !----------------------------------------------- ! PUblic methods !----------------------------------------------- + public :: med_fldList_init1 public :: med_fldList_AddFld public :: med_fldList_AddMap public :: med_fldList_AddMrg @@ -125,14 +31,14 @@ module esmflds character(CS) :: shortname ! Mapping fldsFr data - for mediator import fields - integer :: mapindex(ncomps) = mapunset - character(CS) :: mapnorm(ncomps) = 'unset' - character(CX) :: mapfile(ncomps) = 'unset' + integer , allocatable :: mapindex(:) + character(CS), allocatable :: mapnorm(:) + character(CX), allocatable :: mapfile(:) ! Merging fldsTo data - for mediator export fields - character(CS) :: merge_fields(ncomps) = 'unset' - character(CS) :: merge_types(ncomps) = 'unset' - character(CS) :: merge_fracnames(ncomps) = 'unset' + character(CS), allocatable :: merge_fields(:) + character(CS), allocatable :: merge_types(:) + character(CS), allocatable :: merge_fracnames(:) end type med_fldList_entry_type ! The above would be the field name to merge from @@ -154,8 +60,8 @@ module esmflds !----------------------------------------------- ! Instantiate derived types !----------------------------------------------- - type (med_fldList_type), public :: fldListTo(ncomps) ! advertise fields to components - type (med_fldList_type), public :: fldListFr(ncomps) ! advertise fields from components + type (med_fldList_type), allocatable, public :: fldListTo(:) ! advertise fields to components + type (med_fldList_type), allocatable, public :: fldListFr(:) ! advertise fields from components type (med_fldList_type), public :: fldListMed_aoflux type (med_fldList_type), public :: fldListMed_ocnalb @@ -169,8 +75,13 @@ module esmflds contains !================================================================================ - subroutine med_fldList_AddFld(flds, stdname, shortname) + subroutine med_fldlist_init1() + allocate(fldlistTo(ncomps)) + allocate(fldlistFr(ncomps)) + end subroutine med_fldlist_init1 + !================================================================================ + subroutine med_fldList_AddFld(flds, stdname, shortname) ! ---------------------------------------------- ! Add an entry to to the flds array ! Use pointers to create an extensible allocatable array. @@ -190,6 +101,7 @@ subroutine med_fldList_AddFld(flds, stdname, shortname) ! local variables integer :: n,oldsize,id logical :: found + integer :: mapsize, mrgsize type(med_fldList_entry_type), pointer :: newflds(:) character(len=*), parameter :: subname='(med_fldList_AddFld)' ! ---------------------------------------------- @@ -211,6 +123,9 @@ subroutine med_fldList_AddFld(flds, stdname, shortname) ! create new entry if fldname is not in original list + mapsize = ncomps + mrgsize = ncomps + if (.not. found) then ! 1) allocate newfld to be size (one element larger than input flds) @@ -220,12 +135,27 @@ subroutine med_fldList_AddFld(flds, stdname, shortname) do n = 1,oldsize newflds(n)%stdname = flds(n)%stdname newflds(n)%shortname = flds(n)%shortname + + allocate(newflds(n)%mapindex(mapsize)) + allocate(newflds(n)%mapnorm(mapsize)) + allocate(newflds(n)%mapfile(mapsize)) + allocate(newflds(n)%merge_fields(mrgsize)) + allocate(newflds(n)%merge_types(mrgsize)) + allocate(newflds(n)%merge_fracnames(mrgsize)) + newflds(n)%mapindex(:) = flds(n)%mapindex(:) newflds(n)%mapnorm(:) = flds(n)%mapnorm(:) newflds(n)%mapfile(:) = flds(n)%mapfile(:) newflds(n)%merge_fields(:) = flds(n)%merge_fields(:) newflds(n)%merge_types(:) = flds(n)%merge_types(:) newflds(n)%merge_fracnames(:) = flds(n)%merge_fracnames(:) + + deallocate(flds(n)%mapindex) + deallocate(flds(n)%mapnorm) + deallocate(flds(n)%mapfile) + deallocate(flds(n)%merge_fields) + deallocate(flds(n)%merge_types) + deallocate(flds(n)%merge_fracnames) end do ! 3) deallocate / nullify flds @@ -244,6 +174,18 @@ subroutine med_fldList_AddFld(flds, stdname, shortname) else flds(id)%shortname = trim(stdname) end if + allocate(flds(id)%mapindex(mapsize)) + allocate(flds(id)%mapnorm(mapsize)) + allocate(flds(id)%mapfile(mapsize)) + allocate(flds(id)%merge_fields(mrgsize)) + allocate(flds(id)%merge_types(mrgsize)) + allocate(flds(id)%merge_fracnames(mrgsize)) + flds(id)%mapindex(:) = mapunset + flds(id)%mapnorm(:) = 'unset' + flds(id)%mapfile(:) = 'unset' + flds(id)%merge_fields(:) = 'unset' + flds(id)%merge_types(:) = 'unset' + flds(id)%merge_fracnames(:) = 'unset' end if end subroutine med_fldList_AddFld @@ -639,11 +581,11 @@ subroutine med_fldList_GetFldInfo_merging(fldList, fldindex, compsrc, merge_fiel ! Get field merge info ! ---------------------------------------------- type(med_fldList_type) , intent(in) :: fldList - integer , intent(in) :: fldindex - integer , intent(in) :: compsrc - character(len=*) , intent(out) :: merge_field - character(len=*) , intent(out) :: merge_type - character(len=*) , intent(out) :: merge_fracname + integer , intent(in) :: fldindex + integer , intent(in) :: compsrc + character(len=*) , intent(out) :: merge_field + character(len=*) , intent(out) :: merge_type + character(len=*) , intent(out) :: merge_fracname ! local variables character(len=*), parameter :: subname='(med_fldList_GetFldInfo_merging)' @@ -652,6 +594,7 @@ subroutine med_fldList_GetFldInfo_merging(fldList, fldindex, compsrc, merge_fiel merge_field = fldList%flds(fldindex)%merge_fields(compsrc) merge_type = fldList%flds(fldindex)%merge_types(compsrc) merge_fracname = fldList%flds(fldindex)%merge_fracnames(compsrc) + end subroutine med_fldList_GetFldInfo_merging !================================================================================ diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 2bb45a90d..a1b1a4897 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -49,12 +49,13 @@ module esmFldsExchange_cesm_mod 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 + logical :: mapuv_with_cart3d ! Map U/V vector wind fields from ATM to OCN/ICE by rotating in Cartesian 3D space and then back + logical :: flds_i2o_per_cat ! Ice thickness category fields passed to OCN + logical :: flds_co2a ! Pass CO2 from ATM to surface components + logical :: flds_co2b ! Pass CO2 from ATM to LND and back from LND to ATM + logical :: flds_co2c ! Pass CO2 from ATM to surface (OCN/LND) and back from them to ATM + logical :: flds_wiso ! Pass water isotop fields + logical :: flds_r2l_stream_channel_depths ! Pass channel depths from ROF to LND character(*), parameter :: u_FILE_u = & __FILE__ @@ -71,17 +72,16 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) use med_utils_mod , only : chkerr => med_utils_chkerr use med_methods_mod , only : fldchk => med_methods_FB_FldChk use med_internalstate_mod , only : InternalState, logunit, mastertask + use med_internalstate_mod , only : compmed, compatm, complnd, compocn + use med_internalstate_mod , only : compice, comprof, compwav, compglc, ncomps + use med_internalstate_mod , only : mapbilnr, mapconsf, mapconsd, mappatch, mappatch_uv3d, mapbilnr_nstod + use med_internalstate_mod , only : mapfcopy, mapnstod, mapnstod_consd, mapnstod_consf + use med_internalstate_mod , only : coupling_mode + use med_internalstate_mod , only : map_glc2ocn_ice, map_glc2ocn_liq, map_rof2ocn_ice, map_rof2ocn_liq use esmFlds , only : addfld => med_fldList_AddFld use esmFlds , only : addmap => med_fldList_AddMap use esmFlds , only : addmrg => med_fldList_AddMrg - use esmflds , only : compmed, compatm, complnd, compocn - use esmflds , only : compice, comprof, compwav, ncomps - use esmflds , only : compglc, num_icesheets, ocn2glc_coupling ! compglc is an array of integers - use esmflds , only : mapbilnr, mapconsf, mapconsd, mappatch, mappatch_uv3d, mapbilnr_nstod - use esmflds , only : mapfcopy, mapnstod, mapnstod_consd, mapnstod_consf - use esmflds , only : map_glc2ocn_ice, map_glc2ocn_liq, map_rof2ocn_ice, map_rof2ocn_liq use esmflds , only : fldListTo, fldListFr, fldListMed_aoflux, fldListMed_ocnalb - use esmFlds , only : coupling_mode ! input/output parameters: type(ESMF_GridComp) :: gcomp @@ -102,11 +102,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! Get the internal state !--------------------------------------- - if (phase /= 'advertise') then - nullify(is_local%wrap) - call ESMF_GridCompGetInternalState(gcomp, is_local, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end if + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return if (phase == 'advertise') then @@ -200,25 +198,24 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) flds_i2o_per_cat - ! are multiple ocean depths for temperature and salinity sent from the ocn to glc? - call NUOPC_CompAttributeGet(gcomp, name='ocn2glc_coupling', value=cvalue, rc=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 + ! are water isotope exchanges enabled? + call NUOPC_CompAttributeGet(gcomp, name='flds_r2l_stream_channel_depths', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) flds_r2l_stream_channel_depths ! write diagnostic output if (mastertask) then - 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 + 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_co2c + 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)//' flds_r2l_stream_channel_depths = ',flds_r2l_stream_channel_depths + write(logunit,'(a,l7)') trim(subname)//' mapuv_with_cart3d = ',mapuv_with_cart3d end if end if @@ -247,7 +244,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addfld(fldListFr(complnd)%flds, 'Sl_lfrin') call addfld(fldListFr(compocn)%flds, 'So_omask') call addfld(fldListFr(compice)%flds, 'Si_imask') - do ns = 1,num_icesheets + do ns = 1,is_local%wrap%num_icesheets call addfld(fldlistFr(compglc(ns))%flds, 'Sg_area') end do else @@ -716,7 +713,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! fields from med->lnd are in multiple elevation classes if (phase == 'advertise') then - do ns = 1, num_icesheets + do ns = 1, is_local%wrap%num_icesheets call addfld(fldListFr(compglc(ns))%flds, 'Sg_icemask') ! ice sheet grid coverage call addfld(fldListFr(compglc(ns))%flds, 'Sg_icemask_coupled_fluxes') call addfld(fldListFr(compglc(ns))%flds, 'Sg_ice_covered') ! fraction of glacier area @@ -732,7 +729,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! custom merge in med_phases_prep_lnd for Sg_icemask and Sg_icemask_coupled_fluxes ! custom map merge in med_phases_prep_lnd for Sg_ice_covered_elev, Sg_topo_elev and Flgg_hflx_elev if ( fldchk(is_local%wrap%FBExp(complnd), 'Sg_icemask', rc=rc)) then - do ns = 1, num_icesheets + do ns = 1, is_local%wrap%num_icesheets if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Sg_icemask', rc=rc)) then call addmap(fldListFr(compglc(ns))%flds, 'Sg_icemask', & complnd, mapconsd, 'one', 'unset') @@ -740,7 +737,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end do end if if ( fldchk(is_local%wrap%FBExp(complnd), 'Sg_icemask_coupled_fluxes', rc=rc)) then - do ns = 1, num_icesheets + do ns = 1, is_local%wrap%num_icesheets if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Sg_icemask_coupled_fluxes', rc=rc)) then call addmap(fldListFr(compglc(ns))%flds, 'Sg_icemask_coupled_fluxes', & complnd, mapconsd, 'one', 'unset') @@ -2098,13 +2095,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! 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 + do ns = 1, is_local%wrap%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 + do ns = 1, is_local%wrap%num_icesheets call addfld(fldListFr(compglc(ns))%flds, 'Fogg_rofi') end do call addfld(fldListFr(comprof)%flds, 'Forr_rofi') @@ -2126,7 +2123,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if ! liquid from glc to ocean - do ns = 1, num_icesheets + do ns = 1, is_local%wrap%num_icesheets if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Fogg_rofl' , rc=rc)) then ! TODO: this custom map needs to be different for every ice sheet - how will this be handled? call addmap(fldListFr(compglc(ns))%flds, 'Fogg_rofl', compocn, map_glc2ocn_liq, 'one' , glc2ocn_liq_rmap) @@ -2145,7 +2142,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) 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 + do ns = 1, is_local%wrap%num_icesheets 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) @@ -2157,13 +2154,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (flds_wiso) then if (phase == 'advertise') then - do ns = 1, num_icesheets + do ns = 1, is_local%wrap%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 + do ns = 1, is_local%wrap%num_icesheets call addfld(fldListFr(compglc(ns))%flds, 'Fogg_rofi_wiso') end do call addfld(fldListFr(comprof)%flds, 'Forr_rofi_wiso') @@ -2187,7 +2184,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if ! liquid from glc to ocean - do ns = 1, num_icesheets + do ns = 1, is_local%wrap%num_icesheets 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_wiso', compocn, map_glc2ocn_liq, 'one' , glc2ocn_liq_rmap) @@ -2207,7 +2204,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) 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 + do ns = 1, is_local%wrap%num_icesheets 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_wiso', compocn, map_glc2ocn_ice, 'one', glc2ocn_ice_rmap) @@ -2741,7 +2738,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! --------------------------------------------------------------------- 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 + do ns = 1, is_local%wrap%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 @@ -2751,7 +2748,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) 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 + do ns = 1, is_local%wrap%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') @@ -2762,7 +2759,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (flds_wiso) then if (phase == 'advertise') then call addfld(fldListFr(comprof)%flds, 'Firr_rofi_wiso') ! water flux into sea ice due to runoff (frozen) - do ns = 1, num_icesheets + do ns = 1, is_local%wrap%num_icesheets 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_wiso') ! total frozen water flux into sea ice @@ -2773,7 +2770,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) 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 + do ns = 1, is_local%wrap%num_icesheets 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', & @@ -2994,13 +2991,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addfld(fldListFr(complnd)%flds, 'Sl_tsrf_elev') ! surface temperature of glacier (1->glc_nec+1) call addfld(fldListFr(complnd)%flds, 'Sl_topo_elev') ! surface heights of glacier (1->glc_nec+1) call addfld(fldListFr(complnd)%flds, 'Flgl_qice_elev') ! glacier ice flux (1->glc_nec+1) - do ns = 1,num_icesheets + do ns = 1,is_local%wrap%num_icesheets call addfld(fldListTo(compglc(ns))%flds, 'Sl_tsrf') call addfld(fldListTo(compglc(ns))%flds, 'Flgl_qice') end do else ! custom mapping, accumulation and merging will be done in prep_glc_mod.F90 - do ns = 1,num_icesheets + do ns = 1,is_local%wrap%num_icesheets if ( fldchk(is_local%wrap%FBImp(complnd,complnd) , 'Flgl_qice_elev', rc=rc)) then call addmap(FldListFr(complnd)%flds, 'Flgl_qice_elev', compglc(ns), mapbilnr, 'lfrac', 'unset') end if @@ -3017,18 +3014,18 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) !----------------------------- ! to glc: from ocn !----------------------------- - if (ocn2glc_coupling) then + if (is_local%wrap%ocn2glc_coupling) then if (phase == 'advertise') then call addfld(fldListFr(compocn)%flds, 'So_t_depth') call addfld(fldListFr(compocn)%flds, 'So_s_depth') - do ns = 1,num_icesheets + do ns = 1,is_local%wrap%num_icesheets call addfld(fldListTo(compglc(ns))%flds, 'So_t_depth') call addfld(fldListTo(compglc(ns))%flds, 'So_s_depth') end do else ! custom mapping, accumulation and merging will be done in prep_glc_mod.F90 ! the following is used to create the route handle - do ns = 1,num_icesheets + do ns = 1,is_local%wrap%num_icesheets if ( fldchk(is_local%wrap%FBImp(compocn,compocn) , 'So_t_depth', rc=rc)) then call addmap(FldListFr(compocn)%flds, 'So_t_depth', compglc(ns), mapbilnr, 'none', 'unset') end if diff --git a/mediator/esmFldsExchange_hafs_mod.F90 b/mediator/esmFldsExchange_hafs_mod.F90 index 5f8537221..bfa23dc25 100644 --- a/mediator/esmFldsExchange_hafs_mod.F90 +++ b/mediator/esmFldsExchange_hafs_mod.F90 @@ -2,19 +2,19 @@ module esmFldsExchange_hafs_mod use ESMF use NUOPC - use med_utils_mod, only : chkerr => med_utils_chkerr - use med_kind_mod, only : CX=>SHR_KIND_CX - use med_kind_mod, only : CS=>SHR_KIND_CS - use med_kind_mod, only : CL=>SHR_KIND_CL - use med_kind_mod, only : R8=>SHR_KIND_R8 - use esmflds, only : compmed - use esmflds, only : compatm - use esmflds, only : compocn - use esmflds, only : compwav - use esmflds, only : ncomps - use esmflds, only : fldListTo - use esmflds, only : fldListFr - use esmFlds, only : coupling_mode + use med_utils_mod , only : chkerr => med_utils_chkerr + use med_kind_mod , only : CX=>SHR_KIND_CX + use med_kind_mod , only : CS=>SHR_KIND_CS + use med_kind_mod , only : CL=>SHR_KIND_CL + use med_kind_mod , only : R8=>SHR_KIND_R8 + use med_internalstate_mod , only : compmed + use med_internalstate_mod , only : compatm + use med_internalstate_mod , only : compocn + use med_internalstate_mod , only : compwav + use med_internalstate_mod , only : ncomps + use med_internalstate_mod , only : coupling_mode + use esmflds , only : fldListTo + use esmflds , only : fldListFr !--------------------------------------------------------------------- ! This is a mediator specific routine that determines ALL possible @@ -88,7 +88,7 @@ end subroutine esmFldsExchange_hafs subroutine esmFldsExchange_hafs_advt(gcomp, phase, rc) - use esmFlds , only : addfld => med_fldList_AddFld + use esmFlds, only : addfld => med_fldList_AddFld ! input/output parameters: type(ESMF_GridComp) :: gcomp @@ -172,7 +172,7 @@ subroutine esmFldsExchange_hafs_advt(gcomp, phase, rc) ! --------------------------------------------------------------------- if (hafs_attr%atm_present .and. hafs_attr%wav_present) then allocate(S_flds(1)) - S_flds = (/'Sw_zo'/) ! wave_z0_roughness_length + S_flds = (/'Sw_z0'/) ! wave_z0_roughness_length do n = 1,size(S_flds) fldname = trim(S_flds(n)) call addfld(fldListFr(compwav)%flds, trim(fldname)) @@ -294,13 +294,13 @@ subroutine esmFldsExchange_hafs_init(gcomp, phase, rc) use med_methods_mod , only : fldchk => med_methods_FB_FldChk use med_internalstate_mod , only : InternalState + use med_internalstate_mod , only : mapbilnr, mapconsf, mapconsd, mappatch + use med_internalstate_mod , only : mapfcopy, mapnstod, mapnstod_consd + use med_internalstate_mod , only : mapfillv_bilnr + use med_internalstate_mod , only : mapnstod_consf use esmFlds , only : med_fldList_type use esmFlds , only : addmap => med_fldList_AddMap use esmFlds , only : addmrg => med_fldList_AddMrg - use esmflds , only : mapbilnr, mapconsf, mapconsd, mappatch - use esmflds , only : mapfcopy, mapnstod, mapnstod_consd - use esmflds , only : mapfillv_bilnr - use esmflds , only : mapnstod_consf ! input/output parameters: type(ESMF_GridComp) :: gcomp @@ -385,7 +385,7 @@ subroutine esmFldsExchange_hafs_init(gcomp, phase, rc) ! --------------------------------------------------------------------- if (hafs_attr%atm_present .and. hafs_attr%wav_present) then allocate(S_flds(1)) - S_flds = (/'Sw_zo'/) ! wave_z0_roughness_length + S_flds = (/'Sw_z0'/) ! wave_z0_roughness_length do n = 1,size(S_flds) fldname = trim(S_flds(n)) if (fldchk(is_local%wrap%FBExp(compatm),trim(fldname),rc=rc) .and. & diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90 index f6d88ab46..81def7650 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -24,17 +24,18 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) use NUOPC 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_internalstate_mod , only : InternalState + use med_internalstate_mod , only : mastertask, logunit + use med_internalstate_mod , only : compmed, compatm, compocn, compice, comprof, compwav, ncomps + use med_internalstate_mod , only : mapbilnr, mapconsf, mapconsd, mappatch + use med_internalstate_mod , only : mapfcopy, mapnstod, mapnstod_consd, mapnstod_consf + use med_internalstate_mod , only : mapconsf_aofrac + use med_internalstate_mod , only : coupling_mode, mapnames use esmFlds , only : med_fldList_type use esmFlds , only : addfld => med_fldList_AddFld use esmFlds , only : addmap => med_fldList_AddMap use esmFlds , only : addmrg => med_fldList_AddMrg - use esmflds , only : compmed, compatm, compocn, compice, comprof, ncomps - use esmflds , only : mapbilnr, mapconsf, mapconsd, mappatch - use esmflds , only : mapfcopy, mapnstod, mapnstod_consd, mapnstod_consf - use esmflds , only : mapconsf_aofrac - use esmflds , only : coupling_mode, mapnames use esmflds , only : fldListTo, fldListFr, fldListMed_aoflux, fldListMed_ocnalb - use med_internalstate_mod , only : mastertask, logunit ! input/output parameters: type(ESMF_GridComp) :: gcomp @@ -42,6 +43,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) integer , intent(inout) :: rc ! local variables: + type(InternalState) :: is_local integer :: i, n, maptype character(len=CX) :: msgString character(len=CL) :: cvalue @@ -52,6 +54,10 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) rc = ESMF_SUCCESS + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Set maptype according to coupling_mode if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_orig_data') then maptype = mapnstod_consf @@ -159,6 +165,16 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) call addmap(fldListFr(compocn)%flds, 'So_t', compatm, maptype, 'ofrac', 'unset') call addmrg(fldListTo(compatm)%flds, 'So_t', mrg_from=compocn, mrg_fld='So_t', mrg_type='copy') + ! temporary conditional to avoid conflicts of advertised fields + ! when waves are passing through connectors + if (is_local%wrap%comp_present(compwav)) then + ! to atm: surface roughness length from wav + call addfld(fldListFr(compwav)%flds, 'Sw_z0') + call addfld(fldListTo(compatm)%flds, 'Sw_z0') + call addmap(fldListFr(compwav)%flds, 'Sw_z0', compatm, mapnstod_consf, 'one', 'unset') + call addmrg(fldListTo(compatm)%flds, 'Sw_z0', mrg_from=compwav, mrg_fld='Sw_z0', mrg_type='copy') + end if + !===================================================================== ! FIELDS TO OCEAN (compocn) !===================================================================== @@ -291,6 +307,23 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) end do deallocate(flds) + ! temporary conditional to avoid conflicts of advertised fields + ! when waves are passing through connectors + if (is_local%wrap%comp_present(compwav)) then + ! to ocn: partitioned stokes drift from wav + allocate(flds(6)) + flds = (/'Sw_ustokes1', 'Sw_ustokes2', 'Sw_ustokes3', & + 'Sw_vstokes1', 'Sw_vstokes2', 'Sw_vstokes3'/) + do n = 1,size(flds) + fldname = trim(flds(n)) + call addfld(fldListTo(compocn)%flds, trim(fldname)) + call addfld(fldListFr(compwav)%flds, trim(fldname)) + call addmap(fldListFr(compwav)%flds, trim(fldname), compocn, mapfcopy, 'unset', 'unset') + call addmrg(fldListTo(compocn)%flds, trim(fldname), mrg_from=compwav, mrg_fld=trim(fldname), mrg_type='copy') + end do + deallocate(flds) + end if + !===================================================================== ! FIELDS TO ICE (compice) !===================================================================== @@ -353,6 +386,46 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) end do deallocate(flds) + !===================================================================== + ! FIELDS TO WAV (compwav) + !===================================================================== + + ! temporary conditional to avoid conflicts of advertised fields + ! when waves are passing through connectors + if (is_local%wrap%comp_present(compwav)) then + ! to wav - 10m winds and bottom temperature from atm + allocate(flds(3)) + flds = (/'Sa_u10m', 'Sa_v10m', 'Sa_tbot'/) + do n = 1,size(flds) + fldname = trim(flds(n)) + call addfld(fldListFr(compatm)%flds, trim(fldname)) + call addfld(fldListTo(compwav)%flds, trim(fldname)) + call addmap(fldListFr(compatm)%flds, trim(fldname), compwav, mapnstod_consf, 'one', 'unset') + call addmrg(fldListTo(compwav)%flds, trim(fldname), mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') + end do + deallocate(flds) + + ! to wav: sea ice fraction + call addfld(fldListTo(compwav)%flds, 'Si_ifrac') + call addfld(fldListFr(compice)%flds, 'Si_ifrac') + call addmap(fldListFr(compice)%flds, 'Si_ifrac', compwav, mapfcopy , 'unset', 'unset') + call addmrg(fldListTo(compwav)%flds, 'Si_ifrac', mrg_from=compice, mrg_fld='Si_ifrac', mrg_type='copy') + + ! to wav: zonal sea water velocity from ocn + ! to wav: meridional sea water velocity from ocn + ! to wav: surface temperature from ocn + allocate(flds(3)) + flds = (/'So_u', 'So_v', 'So_t'/) + do n = 1,size(flds) + fldname = trim(flds(n)) + call addfld(fldListTo(compwav)%flds, trim(fldname)) + call addfld(fldListFr(compocn)%flds, trim(fldname)) + call addmap(fldListFr(compocn)%flds, trim(fldname), compwav, mapfcopy , 'unset', 'unset') + call addmrg(fldListTo(compwav)%flds, trim(fldname), mrg_from=compocn, mrg_fld=trim(fldname), mrg_type='copy') + end do + deallocate(flds) + end if + end subroutine esmFldsExchange_nems end module esmFldsExchange_nems_mod diff --git a/mediator/med.F90 b/mediator/med.F90 index 8e8c4fdf1..4ac79c4cf 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -41,24 +41,19 @@ module MED use med_methods_mod , only : clock_timeprint => med_methods_clock_timeprint 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 - use esmFlds , only : ncomps, compname - 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 ! compglc is an array - use esmFlds , only : ocn2glc_coupling, lnd2glc_coupling, accum_lnd2glc + use med_internalstate_mod , only : InternalState, med_internalstate_init, med_internalstate_coupling + use med_internalstate_mod , only : logunit, mastertask + use med_internalstate_mod , only : ncomps, compname + use med_internalstate_mod , only : compmed, compatm, compocn, compice, complnd, comprof, compwav, compglc + use med_internalstate_mod , only : coupling_mode 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 - use esmFlds , only : med_name, atm_name, lnd_name, ocn_name - use esmFlds , only : ice_name, rof_name, wav_name, glc_name + use esmFlds , only : fldListFr, fldListTo, med_fldList_Realize use esmFldsExchange_nems_mod , only : esmFldsExchange_nems use esmFldsExchange_cesm_mod , only : esmFldsExchange_cesm use esmFldsExchange_hafs_mod , only : esmFldsExchange_hafs + use med_phases_profile_mod , only : med_phases_profile_finalize implicit none private @@ -76,15 +71,12 @@ module MED private med_grid_write private med_finalize - character(len=*), parameter :: grid_arbopt = "grid_reg" ! grid_reg or grid_arb character(len=*), parameter :: u_FILE_u = & __FILE__ + logical :: profile_memory = .false. - character(len=8) :: atm_present, lnd_present - character(len=8) :: ice_present, rof_present - character(len=8) :: glc_present, med_present - character(len=8) :: ocn_present, wav_present + logical, allocatable :: compDone(:) ! component done flag !----------------------------------------------------------------------------- contains @@ -109,7 +101,8 @@ subroutine SetServices(gcomp, rc) use med_phases_prep_atm_mod , only: med_phases_prep_atm use med_phases_prep_ice_mod , only: med_phases_prep_ice use med_phases_prep_lnd_mod , only: med_phases_prep_lnd - use med_phases_prep_wav_mod , only: med_phases_prep_wav + use med_phases_prep_wav_mod , only: med_phases_prep_wav_accum + use med_phases_prep_wav_mod , only: med_phases_prep_wav_avg use med_phases_prep_glc_mod , only: med_phases_prep_glc use med_phases_prep_rof_mod , only: med_phases_prep_rof use med_phases_prep_ocn_mod , only: med_phases_prep_ocn_accum @@ -351,10 +344,20 @@ subroutine SetServices(gcomp, rc) !------------------ call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_prep_wav"/), userRoutine=mediator_routine_Run, rc=rc) + phaseLabelList=(/"med_phases_prep_wav_accum"/), userRoutine=mediator_routine_Run, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_phases_prep_wav", specRoutine=med_phases_prep_wav, rc=rc) + specPhaseLabel="med_phases_prep_wav_accum", specRoutine=med_phases_prep_wav_accum, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_TimestampExport, & + specPhaselabel="med_phases_prep_wav_accum", specRoutine=NUOPC_NoOp, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & + phaseLabelList=(/"med_phases_prep_wav_avg"/), userRoutine=mediator_routine_Run, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & + specPhaseLabel="med_phases_prep_wav_avg", specRoutine=med_phases_prep_wav_avg, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & @@ -547,7 +550,6 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_METHOD_INITIALIZE use NUOPC , only : NUOPC_CompFilterPhaseMap, NUOPC_CompAttributeGet use med_internalstate_mod, only : mastertask, logunit, diagunit - use esmFlds, only : dststatus_print type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState @@ -630,13 +632,6 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) write(msgString,'(A,i6)') trim(subname)//': Mediator dbug_flag is ',dbug_flag call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - ! Obtain dststatus_print setting if present - call NUOPC_CompAttributeGet(gcomp, name='dststatus_print', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) dststatus_print=(trim(cvalue)=="true") - write(msgString,*) trim(subname)//': Mediator dststatus_print is ',dststatus_print - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - ! Switch to IPDv03 by filtering all other phaseMap entries call NUOPC_CompFilterPhaseMap(gcomp, ESMF_METHOD_INITIALIZE, acceptStringList=(/"IPDv03p"/), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -659,6 +654,8 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) use ESMF , only : ESMF_END_ABORT, ESMF_Finalize, ESMF_MAXSTR use NUOPC , only : NUOPC_AddNamespace, NUOPC_Advertise, NUOPC_AddNestedState use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_CompAttributeSet, NUOPC_CompAttributeAdd + use esmFlds, only : med_fldlist_init1 + use med_phases_history_mod, only : med_phases_history_init ! input/output variables type(ESMF_GridComp) :: gcomp @@ -675,9 +672,7 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) character(len=8) :: cnum type(InternalState) :: is_local integer :: stat - character(len=CS) :: attrList(8) - character(len=ESMF_MAXSTR) :: mesh_glc - character(len=*),parameter :: subname=' (InitializeIPDv03p1) ' + character(len=*),parameter :: subname=' (Advertise Fields) ' !----------------------------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -685,7 +680,7 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) if (profile_memory) call ESMF_VMLogMemInfo("Entering "//trim(subname)) !------------------ - ! Allocate memory for the internal state and set it in the Component. + ! Allocate memory for the internal state !------------------ allocate(is_local%wrap, stat=stat) @@ -697,6 +692,14 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) call ESMF_GridCompSetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_internalstate_init(gcomp, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + !------------------ + ! Allocate memory for history module variables + !------------------ + call med_phases_history_init() + !------------------ ! add a namespace (i.e. nested state) for each import and export component state in the mediator's InternalState !------------------ @@ -735,23 +738,8 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) call NUOPC_AddNamespace(exportState, namespace="WAV", nestedStateName="WavExp", & nestedState=is_local%wrap%NStateExp(compwav), rc=rc) - ! Only create nested states for active ice sheets - call NUOPC_CompAttributeGet(gcomp, name='mesh_glc', value=mesh_glc, isPresent=isPresent, isSet=isSet, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - num_icesheets = 0 - if (isPresent .and. isSet) then - ! determine number of ice sheets - search in mesh_glc for colon deliminted strings - if (len_trim(cvalue) > 0) then - do n = 1, len_trim(mesh_glc) - if (mesh_glc(n:n) == ':') num_icesheets = num_icesheets + 1 - end do - num_icesheets = num_icesheets + 1 - endif - if (mastertask) then - write(logunit,'(a,i8)') trim(subname)//' number of ice sheets is ',num_icesheets - end if - end if - do ns = 1,num_icesheets + ! Only create nested states for active land-ice sheets + do ns = 1,is_local%wrap%num_icesheets write(cnum,'(i0)') ns call NUOPC_AddNestedState(importState, CplSet="GLC"//trim(cnum), & nestedState=is_local%wrap%NStateImp(compglc(ns)), rc=rc) @@ -783,6 +771,10 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) write(logunit,*) end if + ! Initialize memory for fldlistTo and fldlistFr - this is need for the calls below for the + ! advertise phase + call med_fldlist_init1() + if (trim(coupling_mode) == 'cesm') then call esmFldsExchange_cesm(gcomp, phase='advertise', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -802,112 +794,6 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) ! Determine component present indices !------------------ - call NUOPC_CompAttributeAdd(gcomp, & - attrList=(/'atm_present','lnd_present','ocn_present','ice_present',& - 'rof_present','wav_present','glc_present','med_present'/), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - med_present = "false" - atm_present = "false" - lnd_present = "false" - ocn_present = "false" - ice_present = "false" - rof_present = "false" - wav_present = "false" - glc_present = "false" - - ! Note that the present flag is set to true if the component is not stub - call NUOPC_CompAttributeGet(gcomp, name='ATM_model', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - if (trim(cvalue) /= 'satm') atm_present = "true" - atm_name = trim(cvalue) - end if - - call NUOPC_CompAttributeGet(gcomp, name='LND_model', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - if (trim(cvalue) /= 'slnd') lnd_present = "true" - lnd_name = trim(cvalue) - end if - - call NUOPC_CompAttributeGet(gcomp, name='OCN_model', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - if (trim(cvalue) /= 'socn') ocn_present = "true" - ocn_name = trim(cvalue) - end if - - call NUOPC_CompAttributeGet(gcomp, name='ICE_model', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - if (trim(cvalue) /= 'sice') ice_present = "true" - ice_name = trim(cvalue) - end if - - call NUOPC_CompAttributeGet(gcomp, name='ROF_model', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - if (trim(cvalue) /= 'srof') rof_present = "true" - rof_name = trim(cvalue) - end if - - call NUOPC_CompAttributeGet(gcomp, name='WAV_model', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - if (trim(cvalue) /= 'swav') wav_present = "true" - wav_name = trim(cvalue) - end if - - call NUOPC_CompAttributeGet(gcomp, name='GLC_model', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - if (trim(cvalue) /= 'sglc') glc_present = "true" - glc_name = trim(cvalue) - end if - - call NUOPC_CompAttributeGet(gcomp, name='MED_model', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - med_name = trim(cvalue) - end if - - call NUOPC_CompAttributeGet(gcomp, name='mediator_present', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - med_present = trim(cvalue) - end if - - call NUOPC_CompAttributeSet(gcomp, name="atm_present", value=atm_present, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeSet(gcomp, name="lnd_present", value=lnd_present, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeSet(gcomp, name="ocn_present", value=ocn_present, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeSet(gcomp, name="ice_present", value=ice_present, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeSet(gcomp, name="rof_present", value=rof_present, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeSet(gcomp, name="wav_present", value=trim(wav_present), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeSet(gcomp, name="glc_present", value=trim(glc_present), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeSet(gcomp, name="med_present", value=med_present, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - if (mastertask) then - write(logunit,*) - if (trim(atm_present).eq."true") write(logunit,*) "atm_name="//trim(atm_name) - if (trim(lnd_present).eq."true") write(logunit,*) "lnd_name="//trim(lnd_name) - if (trim(ocn_present).eq."true") write(logunit,*) "ocn_name="//trim(ocn_name) - if (trim(ice_present).eq."true") write(logunit,*) "ice_name="//trim(ice_name) - if (trim(rof_present).eq."true") write(logunit,*) "rof_name="//trim(rof_name) - if (trim(wav_present).eq."true") write(logunit,*) "wav_name="//trim(wav_name) - if (trim(glc_present).eq."true") write(logunit,*) "glc_name="//trim(glc_name) - if (trim(med_present).eq."true") write(logunit,*) "med_name="//trim(med_name) - write(logunit,*) - end if - call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldName", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return is_local%wrap%flds_scalar_name = trim(cvalue) @@ -948,44 +834,40 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) do ncomp = 1,ncomps if (ncomp /= compmed) then if (mastertask) write(logunit,*) - if (ESMF_StateIsCreated(is_local%wrap%NStateImp(ncomp))) then - nflds = med_fldList_GetNumFlds(fldListFr(ncomp)) - do n = 1,nflds - call med_fldList_GetFldInfo(fldListFr(ncomp), n, stdname, shortname) - if (mastertask) then - write(logunit,'(a)') trim(subname)//':Fr_'//trim(compname(ncomp))//': '//trim(shortname) - end if - if (trim(shortname) == is_local%wrap%flds_scalar_name) then - transferOffer = 'will provide' - else - transferOffer = 'cannot provide' - end if - call NUOPC_Advertise(is_local%wrap%NStateImp(ncomp), & - standardName=stdname, shortname=shortname, name=shortname, & - TransferOfferGeomObject=transferOffer, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(subname//':Fr_'//trim(compname(ncomp))//': '//trim(shortname), ESMF_LOGMSG_INFO) - end do - end if - if (ESMF_StateIsCreated(is_local%wrap%NStateExp(ncomp))) then - nflds = med_fldList_GetNumFlds(fldListTo(ncomp)) - do n = 1,nflds - call med_fldList_GetFldInfo(fldListTo(ncomp), n, stdname, shortname) - if (mastertask) then - write(logunit,'(a)') trim(subname)//':To_'//trim(compname(ncomp))//': '//trim(shortname) - end if - if (trim(shortname) == is_local%wrap%flds_scalar_name) then - transferOffer = 'will provide' - else - transferOffer = 'cannot provide' - end if - call NUOPC_Advertise(is_local%wrap%NStateExp(ncomp), & - standardName=stdname, shortname=shortname, name=shortname, & - TransferOfferGeomObject=transferOffer, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(subname//':To_'//trim(compname(ncomp))//': '//trim(shortname), ESMF_LOGMSG_INFO) - end do - end if + nflds = med_fldList_GetNumFlds(fldListFr(ncomp)) + do n = 1,nflds + call med_fldList_GetFldInfo(fldListFr(ncomp), n, stdname, shortname) + if (mastertask) then + write(logunit,'(a)') trim(subname)//':Fr_'//trim(compname(ncomp))//': '//trim(shortname) + end if + if (trim(shortname) == is_local%wrap%flds_scalar_name) then + transferOffer = 'will provide' + else + transferOffer = 'cannot provide' + end if + call NUOPC_Advertise(is_local%wrap%NStateImp(ncomp), & + standardName=stdname, shortname=shortname, name=shortname, & + TransferOfferGeomObject=transferOffer, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(subname//':Fr_'//trim(compname(ncomp))//': '//trim(shortname), ESMF_LOGMSG_INFO) + end do + nflds = med_fldList_GetNumFlds(fldListTo(ncomp)) + do n = 1,nflds + call med_fldList_GetFldInfo(fldListTo(ncomp), n, stdname, shortname) + if (mastertask) then + write(logunit,'(a)') trim(subname)//':To_'//trim(compname(ncomp))//': '//trim(shortname) + end if + if (trim(shortname) == is_local%wrap%flds_scalar_name) then + transferOffer = 'will provide' + else + transferOffer = 'cannot provide' + end if + call NUOPC_Advertise(is_local%wrap%NStateExp(ncomp), & + standardName=stdname, shortname=shortname, name=shortname, & + TransferOfferGeomObject=transferOffer, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(subname//':To_'//trim(compname(ncomp))//': '//trim(shortname), ESMF_LOGMSG_INFO) + end do end if end do ! end of ncomps loop @@ -1016,7 +898,7 @@ subroutine InitializeIPDv03p3(gcomp, importState, exportState, clock, rc) type(InternalState) :: is_local type(ESMF_VM) :: vm integer :: n - character(len=*),parameter :: subname=' (InitializeIPDv03p3) ' + character(len=*),parameter :: subname=' (Realize Fields with Transfer Provide) ' !----------------------------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -1077,7 +959,7 @@ subroutine InitializeIPDv03p4(gcomp, importState, exportState, clock, rc) ! local variables type(InternalState) :: is_local integer :: n1,n2 - character(len=*),parameter :: subname=' (InitalizeIPDv03p4) ' + character(len=*),parameter :: subname=' (Modify Decomp of Mesh/Grid) ' !----------------------------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -1405,7 +1287,7 @@ subroutine InitializeIPDv03p5(gcomp, importState, exportState, clock, rc) ! local variables type(InternalState) :: is_local integer :: n1,n2 - character(len=*),parameter :: subname=' (module_MED:InitializeIPDv03p5) ' + character(len=*),parameter :: subname=' (Realize Fields with Transfer Accept) ' !----------------------------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -1477,7 +1359,7 @@ subroutine completeFieldInitialization(State,rc) integer, allocatable :: ungriddedLBound(:), ungriddedUBound(:) logical :: isPresent logical :: meshcreated - character(len=*),parameter :: subname=' (module_MED:completeFieldInitialization) ' + character(len=*),parameter :: subname=' (Complete Field Initialization) ' !----------------------------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -1627,6 +1509,7 @@ subroutine DataInitialize(gcomp, rc) 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_wav_mod , only : med_phases_prep_wav_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 @@ -1665,16 +1548,14 @@ subroutine DataInitialize(gcomp, rc) character(ESMF_MAXSTR),allocatable :: fieldNameList(:) 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=' (DataInitialize) ' + character(len=*), parameter :: subname=' (Data Initialization) ' !----------------------------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -1703,168 +1584,12 @@ subroutine DataInitialize(gcomp, rc) if (first_call) then - !---------------------------------------------------------- - ! Initialize mediator present flags - !---------------------------------------------------------- + ! Allocate module variable + allocate(compDone(ncomps)) - if (mastertask) then - write(logunit,'(a)') trim(subname) // "Initializing present flags" - end if - - do n1 = 1,ncomps - cname = trim(compname(n1)) - if (cname(1:3) == 'glc') then - ! Special logic for glc since there can be multiple ice sheets - call ESMF_AttributeGet(gcomp, name="glc_present", value=cvalue, & - convention="NUOPC", purpose="Instance", rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - do ns = 1,max_icesheets - if (ns <= num_icesheets) then - if (trim(cvalue) == 'true') then - is_local%wrap%comp_present(compglc(ns)) = .true. - else - is_local%wrap%comp_present(compglc(ns)) = .false. - end if - end if - end do - else - call ESMF_AttributeGet(gcomp, name=trim(compname(n1))//"_present", value=cvalue, & - convention="NUOPC", purpose="Instance", rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (trim(cvalue) == "true") then - is_local%wrap%comp_present(n1) = .true. - else - is_local%wrap%comp_present(n1) = .false. - end if - end if - if (mastertask) then - write(msgString,'(A,L4)') trim(subname)//' comp_present(comp'//trim(compname(n1))//') = ',& - is_local%wrap%comp_present(n1) - write(logunit,'(a)') trim(subname) // trim(msgString) - end if - end do - - !---------------------------------------------------------- - ! Check for active coupling interactions - ! must be allowed, bundles created, and both sides have some fields - !---------------------------------------------------------- - - ! This defines the med_coupling_allowed is a starting point for what is - ! allowed in this coupled system. It will be revised further after the system - ! starts, but any coupling set to false will never be allowed. - ! are allowed, just update the table below. - - if (mastertask) then - write(logunit,'(a)') trim(subname) // "Initializing active coupling flags" - end if - - ! Initialize med_coupling_allowed - med_coupling_allowed(:,:) = .false. - - ! to atmosphere - med_coupling_allowed(complnd,compatm) = .true. - med_coupling_allowed(compice,compatm) = .true. - med_coupling_allowed(compocn,compatm) = .true. - med_coupling_allowed(compwav,compatm) = .true. - - ! to land - med_coupling_allowed(compatm,complnd) = .true. - med_coupling_allowed(comprof,complnd) = .true. - do ns = 1,num_icesheets - med_coupling_allowed(compglc(ns),complnd) = .true. - end do - - ! to ocean - med_coupling_allowed(compatm,compocn) = .true. - med_coupling_allowed(compice,compocn) = .true. - med_coupling_allowed(comprof,compocn) = .true. - med_coupling_allowed(compwav,compocn) = .true. - do ns = 1,num_icesheets - med_coupling_allowed(compglc(ns),compocn) = .true. - end do - - ! to ice - med_coupling_allowed(compatm,compice) = .true. - med_coupling_allowed(compocn,compice) = .true. - med_coupling_allowed(comprof,compice) = .true. - med_coupling_allowed(compwav,compice) = .true. - do ns = 1,num_icesheets - med_coupling_allowed(compglc(ns),compice) = .true. - end do - - ! to river - med_coupling_allowed(complnd,comprof) = .true. - - ! to wave - med_coupling_allowed(compatm,compwav) = .true. - med_coupling_allowed(compocn,compwav) = .true. - med_coupling_allowed(compice,compwav) = .true. - - ! to land-ice - do ns = 1,num_icesheets - med_coupling_allowed(complnd,compglc(ns)) = .true. - med_coupling_allowed(compocn,compglc(ns)) = .true. - end do - - ! initialize med_coupling_active table - is_local%wrap%med_coupling_active(:,:) = .false. - do n1 = 1,ncomps - if (is_local%wrap%comp_present(n1) .and. ESMF_StateIsCreated(is_local%wrap%NStateImp(n1),rc=rc)) then - call State_GetNumFields(is_local%wrap%NStateImp(n1), cntn1, rc=rc) ! Import Field Count - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (cntn1 > 0) then - do n2 = 1,ncomps - if (is_local%wrap%comp_present(n2) .and. ESMF_StateIsCreated(is_local%wrap%NStateExp(n2),rc=rc) .and. & - med_coupling_allowed(n1,n2)) then - call State_GetNumFields(is_local%wrap%NStateExp(n2), cntn2, rc=rc) ! Import Field Count - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (cntn2 > 0) then - is_local%wrap%med_coupling_active(n1,n2) = .true. - endif - endif - enddo - end if - endif - enddo - - ! 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. - end do - end if - - ! create tables of allowed and active coupling flags - ! - the rows are the destination of coupling - ! - the columns are the source of coupling - ! - So, the second column indicates which models the atm is coupled to. - ! - And the second row indicates which models are coupled to the atm. - if (mastertask) then - write(logunit,*) ' ' - write(logunit,'(A)') trim(subname)//' Allowed coupling flags' - write(logunit,'(2x,A10,20(A5))') '|from to->',(compname(n2),n2=1,ncomps) - do n1 = 1,ncomps - write(msgString,'(2x,a1,A,5x,20(L5))') '|',trim(compname(n1)), & - (med_coupling_allowed(n1,n2),n2=1,ncomps) - do n2 = 1,len_trim(msgString) - if (msgString(n2:n2) == 'F') msgString(n2:n2)='-' - enddo - write(logunit,'(A)') trim(msgString) - enddo - - write(logunit,*) ' ' - write(logunit,'(A)') subname//' Active coupling flags' - write(logunit,'(2x,A10,20(A5))') '|from to->',(compname(n2),n2=1,ncomps) - do n1 = 1,ncomps - write(msgString,'(2x,a1,A,5x,20(L5))') '|',trim(compname(n1)), & - (is_local%wrap%med_coupling_active(n1,n2),n2=1,ncomps) - do n2 = 1,len_trim(msgString) - if (msgString(n2:n2) == 'F') msgString(n2:n2)='-' - enddo - write(logunit,'(A)') trim(msgString) - enddo - write(logunit,*) ' ' - endif + ! Determine active coupling logical flags + call med_internalstate_coupling(gcomp, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return !---------------------------------------------------------- ! Create field bundles FBImp, FBExp @@ -2010,6 +1735,9 @@ subroutine DataInitialize(gcomp, rc) ! Determine mapping and merging info for field exchanges in mediator !--------------------------------------- + ! Initialize memory for fldlistFr(:)%flds(:) and fldlistTo(:)%flds(:) - this is needed for + ! call below for the initialize phase + if (trim(coupling_mode) == 'cesm') then call esmFldsExchange_cesm(gcomp, phase='initialize', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -2069,29 +1797,19 @@ subroutine DataInitialize(gcomp, rc) end if !--------------------------------------- - ! Initialize glc module field bundles here if appropriate + ! Initialize wav export accumulation field bundle !--------------------------------------- - 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 ( is_local%wrap%comp_present(compwav) .and. & + ESMF_StateIsCreated(is_local%wrap%NStateImp(compwav),rc=rc) .and. & + ESMF_StateIsCreated(is_local%wrap%NStateExp(compwav),rc=rc)) then + call med_phases_prep_wav_init(gcomp, 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 + + !--------------------------------------- + ! Initialize glc module field bundles here if appropriate + !--------------------------------------- + if (is_local%wrap%lnd2glc_coupling .or. is_local%wrap%ocn2glc_coupling .or. is_local%wrap%accum_lnd2glc) then call med_phases_prep_glc_init(gcomp, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -2107,7 +1825,6 @@ subroutine DataInitialize(gcomp, rc) !--------------------------------------- ! Set the data initialize flag to false !--------------------------------------- - call NUOPC_CompAttributeSet(gcomp, name="InitializeDataComplete", value="false", rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -2226,7 +1943,7 @@ subroutine DataInitialize(gcomp, rc) deallocate(fieldNameList) if (.not. compDone(compatm)) then ! atmdone is not true - if (trim(lnd_present) == 'true') then + if (is_local%wrap%comp_present(complnd)) then ! map initial lnd->atm call med_phases_post_lnd(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -2363,44 +2080,45 @@ subroutine DataInitialize(gcomp, rc) !--------------------------------------- ! Call post routines as part of initialization !--------------------------------------- - if (trim(atm_present) == 'true') then - ! map atm->ocn, atm->ice, atm->lnd + if (is_local%wrap%comp_present(compatm)) then + ! map atm->ocn, atm->ice, atm->lnd, atm->wav call med_phases_post_atm(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - if (trim(ice_present) == 'true') then - ! call set ice_frac and map ice->atm and ice->ocn + if (is_local%wrap%comp_present(compice)) then + ! call set ice_frac and map ice->ocn and ice->wav call med_phases_post_ice(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - if (trim(glc_present) == 'true') then + if (allocated(compglc)) then ! map initial glc->lnd, glc->ocn and glc->ice call med_phases_post_glc(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - if (trim(lnd_present) == 'true') then + if (is_local%wrap%comp_present(complnd)) then ! map initial lnd->atm call med_phases_post_lnd(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - if (trim(ocn_present) == 'true') then - ! map initial ocn->ice + if (is_local%wrap%comp_present(compocn)) then + ! map initial ocn->ice, ocn->wav call med_phases_post_ocn(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - if (trim(rof_present) == 'true') then + if (is_local%wrap%comp_present(comprof)) then ! map initial rof->lnd, rof->ocn and rof->ice call med_phases_post_rof(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - if (trim(wav_present) == 'true') then - ! map initial wav->ocn and wav->ice + if (is_local%wrap%comp_present(compwav)) then + ! map initial wav->ocn, wav->ice, wav->atm call med_phases_post_wav(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if call med_phases_profile(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + else ! Not all done call NUOPC_CompAttributeSet(gcomp, name="InitializeDataComplete", value="false", rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -2444,7 +2162,7 @@ subroutine SetRunClock(gcomp, rc) logical, save :: stopalarmcreated=.false. integer :: alarmcount - character(len=*),parameter :: subname=' (module_MED:SetRunClock) ' + character(len=*),parameter :: subname=' (Set Run Clock) ' !----------------------------------------------------------- rc = ESMF_SUCCESS @@ -2602,7 +2320,7 @@ subroutine med_grid_write(grid, fileName, rc) type(ESMF_ArrayBundle) :: arrayBundle integer :: tileCount logical :: isPresent - character(len=*), parameter :: subname=' (module_MED_map:med_grid_write) ' + character(len=*), parameter :: subname=' (Grid Write) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index 8f15f625e..ca8583803 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -617,7 +617,7 @@ subroutine med_phases_diag_atm(gcomp, rc) ! Compute global atm input/output flux diagnostics ! ------------------------------------------------------------------ - use esmFlds, only : compatm + use med_internalstate_mod, only : compatm ! input/output variables type(ESMF_GridComp) :: gcomp @@ -946,7 +946,7 @@ subroutine med_phases_diag_lnd( gcomp, rc) ! Compute global lnd input/output flux diagnostics ! ------------------------------------------------------------------ - use esmFlds, only : complnd + use med_internalstate_mod, only : complnd ! intput/output variables type(ESMF_GridComp) :: gcomp @@ -1147,7 +1147,7 @@ subroutine med_phases_diag_rof( gcomp, rc) ! Compute global river input/output ! ------------------------------------------------------------------ - use esmFlds, only : comprof + use med_internalstate_mod, only : comprof ! input/output variables type(ESMF_GridComp) :: gcomp @@ -1308,7 +1308,7 @@ subroutine med_phases_diag_glc( gcomp, rc) ! Compute global glc output ! ------------------------------------------------------------------ - use esmFlds, only : compglc, num_icesheets + use med_internalstate_mod, only : compglc ! input/output variables type(ESMF_GridComp) :: gcomp @@ -1337,7 +1337,7 @@ subroutine med_phases_diag_glc( gcomp, rc) ic = c_glc_recv ip = period_inst - do ns = 1,num_icesheets + do ns = 1,is_local%wrap%num_icesheets areas => is_local%wrap%mesh_info(compglc(ns))%areas call diag_glc(is_local%wrap%FBImp(compglc(ns),compglc(ns)), 'Fogg_rofl', f_watr_roff, ic, areas, budget_local, minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1389,7 +1389,7 @@ subroutine med_phases_diag_ocn( gcomp, rc) ! Compute global ocn input from mediator ! ------------------------------------------------------------------ - use esmFlds, only : compocn, compatm + use med_internalstate_mod, only : compocn, compatm ! input/output variables type(ESMF_GridComp) :: gcomp @@ -1627,7 +1627,7 @@ subroutine med_phases_diag_ice_ice2med( gcomp, rc) ! Compute global ice input/output flux diagnostics ! ------------------------------------------------------------------ - use esmFlds, only : compice + use med_internalstate_mod, only : compice ! input/output variables type(ESMF_GridComp) :: gcomp @@ -1825,7 +1825,7 @@ subroutine med_phases_diag_ice_med2ice( gcomp, rc) ! Compute global ice input/output flux diagnostics ! ------------------------------------------------------------------ - use esmFlds, only : compice + use med_internalstate_mod, only : compice ! input/output variables type(ESMF_GridComp) :: gcomp diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index 7b7b7ca4d..5b7944c7d 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -97,19 +97,19 @@ module med_fraction_mod ! !----------------------------------------------------------------------------- - use med_kind_mod , only : CX =>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 - use med_constants_mod , only : dbug_flag => med_constants_dbug_flag - use med_constants_mod , only : czero => med_constants_czero - use med_utils_mod , only : chkErr => med_utils_ChkErr - use med_methods_mod , only : fldbun_diagnose => med_methods_FB_diagnose - use med_methods_mod , only : fldbun_fldchk => med_methods_FB_fldchk - 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_init => med_methods_FB_init - use med_methods_mod , only : fldbun_reset => med_methods_FB_reset - use med_map_mod , only : med_map_field - use esmFlds , only : ncomps, max_icesheets, num_icesheets + 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 : czero => med_constants_czero + use med_utils_mod , only : chkErr => med_utils_ChkErr + use med_methods_mod , only : fldbun_diagnose => med_methods_FB_diagnose + use med_methods_mod , only : fldbun_fldchk => med_methods_FB_fldchk + 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_init => med_methods_FB_init + use med_methods_mod , only : fldbun_reset => med_methods_FB_reset + use med_map_mod , only : med_map_field + use med_internalstate_mod , only : ncomps implicit none private @@ -119,7 +119,7 @@ module med_fraction_mod public med_fraction_set integer, parameter :: nfracs = 5 - character(len=6) :: fraclist(nfracs,ncomps) + character(len=6),allocatable :: fraclist(:,:) character(len=6),parameter,dimension(4) :: fraclist_a = (/'ifrac ','ofrac ','lfrac ','aofrac'/) character(len=6),parameter,dimension(4) :: fraclist_o = (/'ifrac ','ofrac ','ifrad ','ofrad '/) character(len=6),parameter,dimension(2) :: fraclist_i = (/'ifrac ','ofrac '/) @@ -148,13 +148,13 @@ subroutine med_fraction_init(gcomp, rc) use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleIsCreated, ESMF_FieldBundleDestroy use ESMF , only : ESMF_FieldBundleGet use ESMF , only : ESMF_Field, ESMF_FieldGet - use esmFlds , only : coupling_mode - use esmFlds , only : compatm, compocn, compice, complnd - use esmFlds , only : comprof, compglc, compwav, compname - use esmFlds , only : mapfcopy, mapconsd, mapnstod_consd + use med_internalstate_mod , only : coupling_mode + use med_internalstate_mod , only : compatm, compocn, compice, complnd + use med_internalstate_mod , only : comprof, compglc, compwav, compname + use med_internalstate_mod , only : mapfcopy, mapconsd, mapnstod_consd + use med_internalstate_mod , only : InternalState, logunit, mastertask use med_map_mod , only : med_map_routehandles_init, med_map_rh_is_created use med_methods_mod , only : State_getNumFields => med_methods_State_getNumFields - use med_internalstate_mod , only : InternalState, logunit, mastertask use perf_mod , only : t_startf, t_stopf ! input/output variables @@ -198,6 +198,9 @@ subroutine med_fraction_init(gcomp, rc) if (first_call) then + ! allocate module variable + allocate(fraclist(nfracs,ncomps)) + !--------------------------------------- ! Initialize the fraclist arrays !--------------------------------------- @@ -209,7 +212,7 @@ subroutine med_fraction_init(gcomp, rc) fraclist(1:size(fraclist_l),complnd) = fraclist_l fraclist(1:size(fraclist_r),comprof) = fraclist_r fraclist(1:size(fraclist_w),compwav) = fraclist_w - do ns = 1,num_icesheets + do ns = 1,is_local%wrap%num_icesheets fraclist(1:size(fraclist_g),compglc(ns)) = fraclist_g end do @@ -523,7 +526,7 @@ subroutine med_fraction_init(gcomp, rc) ! Set 'gfrac' and 'lfrac' for FBFrac(compglc) !--------------------------------------- - do ns = 1,num_icesheets + do ns = 1,is_local%wrap%num_icesheets if (is_local%wrap%comp_present(compglc(ns))) then ! Set 'gfrac' in FBFrac(compglc(ns)) @@ -643,9 +646,9 @@ subroutine med_fraction_set(gcomp, rc) use ESMF , only : ESMF_Field, ESMF_FieldGet use ESMF , only : ESMF_FieldBundleGet, ESMF_FieldBundleIsCreated use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS - use esmFlds , only : compatm, compocn, compice, compname - use esmFlds , only : mapfcopy, mapconsd, mapnstod_consd - use esmFlds , only : coupling_mode + use med_internalstate_mod , only : compatm, compocn, compice, compname + use med_internalstate_mod , only : mapfcopy, mapconsd, mapnstod_consd + use med_internalstate_mod , only : coupling_mode use med_internalstate_mod , only : InternalState use med_map_mod , only : med_map_RH_is_created use perf_mod , only : t_startf, t_stopf diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index bc5287a61..8286118a9 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -4,28 +4,88 @@ module med_internalstate_mod ! Mediator Internal State Datatype. !----------------------------------------------------------------------------- - use ESMF , only : ESMF_RouteHandle, ESMF_FieldBundle, ESMF_State, ESMF_Field - use ESMF , only : ESMF_VM - use esmFlds , only : ncomps, nmappers + use ESMF , only : ESMF_RouteHandle, ESMF_FieldBundle, ESMF_State, ESMF_Field, ESMF_VM + use ESMF , only : ESMF_GridComp, ESMF_MAXSTR, ESMF_LOGMSG_INFO, ESMF_LOGWRITE 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 implicit none private + ! public routines + public :: med_internalstate_init + public :: med_internalstate_coupling + integer, public :: logunit ! logunit for mediator log output integer, public :: diagunit ! diagunit for budget output (med master only) - integer, public :: loglevel ! loglevel for mediator log output logical, public :: mastertask=.false. ! is this the mastertask integer, public :: med_id ! needed currently in med_io_mod and set in esm.F90 - ! Active coupling definitions (will be initialize in med.F90) - logical, public :: med_coupling_allowed(ncomps, ncomps) + ! Components + integer, public :: compmed = 1 + integer, public :: compatm = 2 + integer, public :: complnd = 3 + integer, public :: compocn = 4 + integer, public :: compice = 5 + integer, public :: comprof = 6 + integer, public :: compwav = 7 + integer, public :: ncomps = 7 ! this will be incremented if the size of compglc is > 0 + integer, public, allocatable :: compglc(:) - type, public :: mesh_info_type - real(r8), pointer :: areas(:) => null() - real(r8), pointer :: lats(:) => null() - real(r8), pointer :: lons(:) => null() - end type mesh_info_type + ! Generic component name (e.g. atm, ocn...) + character(len=CS), public, allocatable :: compname(:) + + ! Specific component name (e.g. datm, mom6, etc...) + character(len=CS), public :: med_name = '' + character(len=CS), public :: atm_name = '' + character(len=CS), public :: lnd_name = '' + character(len=CS), public :: ocn_name = '' + character(len=CS), public :: ice_name = '' + character(len=CS), public :: rof_name = '' + character(len=CS), public :: wav_name = '' + character(len=CS), public :: glc_name = '' + + ! Coupling mode + character(len=CS), public :: coupling_mode ! valid values are [cesm,nems_orig,nems_frac,nems_orig_data,hafs] + + ! Mapping + integer , public, parameter :: mapunset = 0 + integer , public, parameter :: mapbilnr = 1 + integer , public, parameter :: mapconsf = 2 + integer , public, parameter :: mapconsd = 3 + integer , public, parameter :: mappatch = 4 + integer , public, parameter :: mapfcopy = 5 + integer , public, parameter :: mapnstod = 6 ! nearest source to destination + integer , public, parameter :: mapnstod_consd = 7 ! nearest source to destination followed by conservative dst + integer , public, parameter :: mapnstod_consf = 8 ! nearest source to destination followed by conservative frac + integer , public, parameter :: mappatch_uv3d = 9 ! rotate u,v to 3d cartesian space, map from src->dest, then rotate back + integer , public, parameter :: mapbilnr_uv3d = 10 ! rotate u,v to 3d cartesian space, map from src->dest, then rotate back + integer , public, parameter :: map_rof2ocn_ice = 11 ! custom smoothing map to map ice from rof->ocn (cesm only) + integer , public, parameter :: map_rof2ocn_liq = 12 ! custom smoothing map to map liq from rof->ocn (cesm only) + integer , public, parameter :: map_glc2ocn_liq = 13 ! custom smoothing map to map liq from glc->ocn (cesm only) + integer , public, parameter :: map_glc2ocn_ice = 14 ! custom smoothing map to map ice from glc->ocn (cesm only) + integer , public, parameter :: mapfillv_bilnr = 15 ! fill value followed by bilinear + integer , public, parameter :: mapbilnr_nstod = 16 ! bilinear with nstod extrapolation + integer , public, parameter :: mapconsf_aofrac = 17 ! conservative with aofrac normalization (ufs only) + integer , public, parameter :: nmappers = 17 + character(len=*) , public, parameter :: mapnames(nmappers) = & + (/'bilnr ',& + 'consf ',& + 'consd ',& + 'patch ',& + 'fcopy ',& + 'nstod ',& + 'nstod_consd ',& + 'nstod_consf ',& + 'patch_uv3d ',& + 'bilnr_uv3d ',& + 'rof2ocn_ice ',& + 'rof2ocn_liq ',& + 'glc2ocn_ice ',& + 'glc2ocn_liq ',& + 'fillv_bilnr ',& + 'bilnr_nstod ',& + 'consf_aofrac'/) type, public :: packed_data_type integer, allocatable :: fldindex(:) ! size of number of packed fields @@ -36,67 +96,81 @@ module med_internalstate_mod type(ESMF_Field) :: field_fracdst end type packed_data_type + logical, public :: dststatus_print = .false. + + ! Mesh info + type, public :: mesh_info_type + real(r8), pointer :: areas(:) => null() + real(r8), pointer :: lats(:) => null() + real(r8), pointer :: lons(:) => null() + end type mesh_info_type + ! private internal state to keep instance data type InternalStateStruct - ! NState_Imp and NState_Exp are the standard NUOPC coupling datatypes - ! FBImp and FBExp are the internal mediator datatypes - ! NState_Exp(n) = FBExp(n), copied in the connector prep phase - ! FBImp(n,n) = NState_Imp(n), copied in connector post phase - ! FBImp(n,k) is the FBImp(n,n) interpolated to grid k - ! RH(n,k,m) is a RH from grid n to grid k, map type m - - ! Present/Active logical flags - logical :: comp_present(ncomps) ! comp present flag - logical :: med_coupling_active(ncomps,ncomps) ! computes the active coupling + ! Present/allowed coupling/active coupling logical flags + logical, pointer :: comp_present(:) ! comp present flag + logical, pointer :: med_coupling_active(:,:) ! computes the active coupling + integer :: num_icesheets ! obtained from attribute + logical :: ocn2glc_coupling = .false. ! obtained from attribute + logical :: lnd2glc_coupling = .false. + logical :: accum_lnd2glc = .false. ! Mediator vm - type(ESMF_VM) :: vm + type(ESMF_VM) :: vm ! Global nx,ny dimensions of input arrays (needed for mediator history output) - integer :: nx(ncomps), ny(ncomps) + integer, pointer :: nx(:), ny(:) ! Import/Export Scalars - character(len=CL) :: flds_scalar_name = '' - integer :: flds_scalar_num = 0 - integer :: flds_scalar_index_nx = 0 - integer :: flds_scalar_index_ny = 0 - integer :: flds_scalar_index_nextsw_cday = 0 - integer :: flds_scalar_index_precip_factor = 0 - real(r8) :: flds_scalar_precip_factor = 1._r8 ! actual value of precip factor from ocn + character(len=CL) :: flds_scalar_name = '' + integer :: flds_scalar_num = 0 + integer :: flds_scalar_index_nx = 0 + integer :: flds_scalar_index_ny = 0 + integer :: flds_scalar_index_nextsw_cday = 0 + integer :: flds_scalar_index_precip_factor = 0 + real(r8) :: flds_scalar_precip_factor = 1._r8 ! actual value of precip factor from ocn + ! NState_Imp and NState_Exp are the standard NUOPC coupling datatypes + ! FBImp and FBExp are the internal mediator datatypes + ! NState_Exp(n) = FBExp(n), copied in the connector prep phase + ! FBImp(n,n) = NState_Imp(n), copied in connector post phase + ! FBImp(n,k) is the FBImp(n,n) interpolated to grid k ! Import/export States and field bundles (the field bundles have the scalar fields removed) - type(ESMF_State) :: NStateImp(ncomps) ! Import data from various component, on their grid - type(ESMF_State) :: NStateExp(ncomps) ! Export data to various component, on their grid - 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 + type(ESMF_State) , pointer :: NStateImp(:) ! Import data from various component, on their grid + type(ESMF_State) , pointer :: NStateExp(:) ! Export data to various component, on their grid + type(ESMF_FieldBundle) , pointer :: FBImp(:,:) ! Import data from various components interpolated to various grids + type(ESMF_FieldBundle) , pointer :: FBExp(:) ! Export data for various components, on their grid ! 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_ocnalb_o ! Ocn albedo on ocn grid + type(ESMF_FieldBundle) :: FBMed_ocnalb_a ! Ocn albedo on atm grid + type(packed_data_type), pointer :: packed_data_ocnalb_o2a(:) ! packed data for mapping ocn->atm ! Mediator field bundles and other info for atm/ocn flux computation + character(len=CS) :: aoflux_grid ! 'ogrid', 'agrid' or 'xgrid' 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' + type(packed_data_type), pointer :: packed_data_aoflux_o2a(:) ! packed data for mapping ocn->atm ! Mapping - type(ESMF_RouteHandle) :: RH(ncomps,ncomps,nmappers) ! Routehandles for pairs of components and different mappers - type(ESMF_Field) :: field_NormOne(ncomps,ncomps,nmappers) ! Unity static normalization - type(packed_data_type) :: packed_data(ncomps,ncomps,nmappers) ! Packed data structure needed to efficiently map field bundles + ! RH(n,k,m) is a RH from grid n to grid k, map type m + type(ESMF_RouteHandle) , pointer :: RH(:,:,:) ! Routehandles for pairs of components and different mappers + type(ESMF_Field) , pointer :: field_NormOne(:,:,:) ! Unity static normalization + type(packed_data_type) , pointer :: packed_data(:,:,:) ! 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), pointer :: FBfrac(:) ! Fraction data for various components, on their grid ! Accumulators for export field bundles - type(ESMF_FieldBundle) :: FBExpAccumOcn ! Accumulator for various components export on their grid - integer :: ExpAccumOcnCnt = 0 ! Accumulator counter for each FBExpAccum + type(ESMF_FieldBundle) :: FBExpAccumOcn ! Accumulator for Ocn export on Ocn grid + integer :: ExpAccumOcnCnt = 0 ! Accumulator counter for FBExpAccumOcn + type(ESMF_FieldBundle) :: FBExpAccumWav ! Accumulator for Wav export on Wav grid + integer :: ExpAccumWavCnt = 0 ! Accumulator counter for FBExpAccumWav ! Component Mesh info - type(mesh_info_type) :: mesh_info(ncomps) - type(ESMF_FieldBundle) :: FBArea(ncomps) ! needed for mediator history writes + type(mesh_info_type) , pointer :: mesh_info(:) + type(ESMF_FieldBundle) , pointer :: FBArea(:) ! needed for mediator history writes end type InternalStateStruct @@ -104,4 +178,377 @@ module med_internalstate_mod type(InternalStateStruct), pointer :: wrap end type InternalState + character(len=*), parameter :: u_FILE_u = & + __FILE__ + +!===================================================================== +contains +!===================================================================== + + subroutine med_internalstate_init(gcomp, rc) + + use ESMF , only : ESMF_LogFoundAllocError, ESMF_AttributeGet + use NUOPC_Comp , only : NUOPC_CompAttributeGet + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer , intent(out) :: rc + + ! local variables + type(InternalState) :: is_local + logical :: ispresent, isset + integer :: n, ns, n1, n2 + integer :: stat + logical :: glc_present + character(len=8) :: cnum + character(len=CS) :: cvalue + character(len=CL) :: cname + character(len=ESMF_MAXSTR) :: mesh_glc + character(len=CX) :: msgString + character(len=3) :: name + integer :: num_icesheets + character(len=*),parameter :: subname=' (internalstate init) ' + !----------------------------------------------------------- + + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Determine if glc is present + call NUOPC_CompAttributeGet(gcomp, name='GLC_model', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + num_icesheets = 0 + if (isPresent .and. isSet) then + if (trim(cvalue) /= 'sglc') then + call NUOPC_CompAttributeGet(gcomp, name='mesh_glc', value=mesh_glc, isPresent=isPresent, isSet=isSet, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + glc_name = trim(cvalue) + if (isPresent .and. isSet) then + ! determine number of ice sheets - search in mesh_glc for colon deliminted strings + if (len_trim(cvalue) > 0) then + do n = 1, len_trim(mesh_glc) + if (mesh_glc(n:n) == ':') num_icesheets = num_icesheets + 1 + end do + num_icesheets = num_icesheets + 1 + endif + if (mastertask) then + write(logunit,'(a,i8)') trim(subname)//' number of ice sheets is ',num_icesheets + end if + end if + ! now determing the number of multiple ice sheets and increment ncomps accordingly + allocate(compglc(num_icesheets)) + compglc(:) = 0 + do ns = 1,num_icesheets + ncomps = ncomps + 1 + compglc(ns) = ncomps + end do + end if + end if + + ! Determine present flags starting with glc component + allocate(is_local%wrap%comp_present(ncomps)) + is_local%wrap%comp_present(:) = .false. + if (num_icesheets > 0) then + do ns = 1,num_icesheets + is_local%wrap%comp_present(compglc(ns)) = .true. + end do + end if + is_local%wrap%num_icesheets = num_icesheets + + call NUOPC_CompAttributeGet(gcomp, name='mediator_present', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) is_local%wrap%comp_present(compmed) + end if + call NUOPC_CompAttributeGet(gcomp, name='MED_model', value=med_name, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompAttributeGet(gcomp, name='ATM_model', value=atm_name, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + if (trim(atm_name) /= 'satm') is_local%wrap%comp_present(compatm) = .true. + end if + call NUOPC_CompAttributeGet(gcomp, name='LND_model', value=lnd_name, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + if (trim(lnd_name) /= 'slnd') is_local%wrap%comp_present(complnd) = .true. + end if + call NUOPC_CompAttributeGet(gcomp, name='OCN_model', value=ocn_name, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + if (trim(ocn_name) /= 'socn') is_local%wrap%comp_present(compocn) = .true. + end if + call NUOPC_CompAttributeGet(gcomp, name='ICE_model', value=ice_name, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + if (trim(ice_name) /= 'sice') is_local%wrap%comp_present(compice) = .true. + end if + call NUOPC_CompAttributeGet(gcomp, name='ROF_model', value=rof_name, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + if (trim(rof_name) /= 'srof') is_local%wrap%comp_present(comprof) = .true. + end if + call NUOPC_CompAttributeGet(gcomp, name='WAV_model', value=wav_name, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + if (trim(wav_name) /= 'swav') is_local%wrap%comp_present(compwav) = .true. + end if + + ! Allocate memory now that ncomps is determined + allocate(is_local%wrap%med_coupling_active(ncomps,ncomps)) + allocate(is_local%wrap%nx(ncomps)) + allocate(is_local%wrap%ny(ncomps)) + allocate(is_local%wrap%NStateImp(ncomps)) + allocate(is_local%wrap%NStateExp(ncomps)) + allocate(is_local%wrap%FBImp(ncomps,ncomps)) + allocate(is_local%wrap%FBExp(ncomps)) + allocate(is_local%wrap%packed_data_ocnalb_o2a(nmappers)) + allocate(is_local%wrap%packed_data_aoflux_o2a(nmappers)) + allocate(is_local%wrap%RH(ncomps,ncomps,nmappers)) + allocate(is_local%wrap%field_NormOne(ncomps,ncomps,nmappers)) + allocate(is_local%wrap%packed_data(ncomps,ncomps,nmappers)) + allocate(is_local%wrap%FBfrac(ncomps)) + allocate(is_local%wrap%FBArea(ncomps)) + allocate(is_local%wrap%mesh_info(ncomps)) + + ! Determine component names + allocate(compname(ncomps)) + compname(compmed) = 'med' + compname(compatm) = 'atm' + compname(complnd) = 'lnd' + compname(compocn) = 'ocn' + compname(compice) = 'ice' + compname(comprof) = 'rof' + compname(compwav) = 'wav' + do ns = 1,is_local%wrap%num_icesheets + write(cnum,'(i0)') ns + compname(compglc(ns)) = 'glc' // trim(cnum) + end do + + if (mastertask) then + ! Write out present flags + write(logunit,*) + do n1 = 1,ncomps + name = trim(compname(n1)) ! this trims the ice sheets index from the glc name + write(msgString,'(A,L4)') trim(subname)//' comp_present(comp'//name//') = ',& + is_local%wrap%comp_present(n1) + write(logunit,'(a)') trim(msgString) + end do + + ! Write out model names if they are present + write(logunit,*) + if (is_local%wrap%comp_present(compatm)) write(logunit,'(a)') trim(subname) // " atm model= "//trim(atm_name) + if (is_local%wrap%comp_present(complnd)) write(logunit,'(a)') trim(subname) // " lnd model= "//trim(lnd_name) + if (is_local%wrap%comp_present(compocn)) write(logunit,'(a)') trim(subname) // " ocn model= "//trim(ocn_name) + if (is_local%wrap%comp_present(compice)) write(logunit,'(a)') trim(subname) // " ice model= "//trim(ice_name) + if (is_local%wrap%comp_present(comprof)) write(logunit,'(a)') trim(subname) // " rof model= "//trim(rof_name) + if (is_local%wrap%comp_present(compwav)) write(logunit,'(a)') trim(subname) // " wav model= "//trim(wav_name) + if (is_local%wrap%comp_present(compmed)) write(logunit,'(a)') trim(subname) // " med model= "//trim(med_name) + if (is_local%wrap%num_icesheets > 0) then + if (is_local%wrap%comp_present(compglc(1))) write(logunit,'(a)') trim(subname) // " glc model= "//trim(glc_name) + end if + write(logunit,*) + end if + + ! Obtain dststatus_print setting if present + call NUOPC_CompAttributeGet(gcomp, name='dststatus_print', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) dststatus_print=(trim(cvalue)=="true") + write(msgString,*) trim(subname)//': Mediator dststatus_print is ',dststatus_print + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + + end subroutine med_internalstate_init + + !===================================================================== + subroutine med_internalstate_coupling(gcomp, rc) + + !---------------------------------------------------------- + ! Check for active coupling interactions + ! must be allowed, bundles created, and both sides have some fields + ! This is called from med.F90 in the DataInitialize routine + !---------------------------------------------------------- + + use ESMF , only : ESMF_StateIsCreated + use NUOPC , only : NUOPC_CompAttributeGet + use med_methods_mod , only : State_getNumFields => med_methods_State_getNumFields + + ! input/output variables + type(ESMF_GridComp) , intent(inout) :: gcomp + integer , intent(out) :: rc + + ! local variables + type(InternalState) :: is_local + integer :: n1, n2, ns + integer :: cntn1, cntn2 + logical, allocatable :: med_coupling_allowed(:,:) + character(len=CL) :: cvalue + character(len=CX) :: msgString + logical :: isPresent, isSet + character(len=*),parameter :: subname=' (internalstate allowed coupling) ' + !----------------------------------------------------------- + + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! This defines the med_coupling_allowed a starting point for what is + ! allowed in this coupled system. It will be revised further after the system + ! starts, but any coupling set to false will never be allowed. + ! are allowed, just update the table below. + + if (mastertask) then + write(logunit,'(a)') trim(subname) // "Initializing active coupling flags" + end if + + ! Initialize med_coupling_allowed + allocate(med_coupling_allowed(ncomps,ncomps)) + med_coupling_allowed(:,:) = .false. + is_local%wrap%med_coupling_active(:,:) = .false. + + ! to atmosphere + med_coupling_allowed(complnd,compatm) = .true. + med_coupling_allowed(compice,compatm) = .true. + med_coupling_allowed(compocn,compatm) = .true. + med_coupling_allowed(compwav,compatm) = .true. + + ! to land + med_coupling_allowed(compatm,complnd) = .true. + med_coupling_allowed(comprof,complnd) = .true. + do ns = 1,is_local%wrap%num_icesheets + med_coupling_allowed(compglc(ns),complnd) = .true. + end do + + ! to ocean + med_coupling_allowed(compatm,compocn) = .true. + med_coupling_allowed(compice,compocn) = .true. + med_coupling_allowed(comprof,compocn) = .true. + med_coupling_allowed(compwav,compocn) = .true. + do ns = 1,is_local%wrap%num_icesheets + med_coupling_allowed(compglc(ns),compocn) = .true. + end do + + ! to ice + med_coupling_allowed(compatm,compice) = .true. + med_coupling_allowed(compocn,compice) = .true. + med_coupling_allowed(comprof,compice) = .true. + med_coupling_allowed(compwav,compice) = .true. + do ns = 1,is_local%wrap%num_icesheets + med_coupling_allowed(compglc(ns),compice) = .true. + end do + + ! to river + med_coupling_allowed(complnd,comprof) = .true. + + ! to wave + med_coupling_allowed(compatm,compwav) = .true. + med_coupling_allowed(compocn,compwav) = .true. + med_coupling_allowed(compice,compwav) = .true. + + ! to land-ice + call NUOPC_CompAttributeGet(gcomp, name='ocn2glc_coupling', value=cvalue, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + ! are multiple ocean depths for temperature and salinity sent from the ocn to glc? + read(cvalue,*) is_local%wrap%ocn2glc_coupling + else + is_local%wrap%ocn2glc_coupling = .false. + end if + do ns = 1,is_local%wrap%num_icesheets + med_coupling_allowed(complnd,compglc(ns)) = .true. + med_coupling_allowed(compocn,compglc(ns)) = is_local%wrap%ocn2glc_coupling + end do + + ! initialize med_coupling_active table + is_local%wrap%med_coupling_active(:,:) = .false. + do n1 = 1,ncomps + if (is_local%wrap%comp_present(n1) .and. ESMF_StateIsCreated(is_local%wrap%NStateImp(n1),rc=rc)) then + call State_GetNumFields(is_local%wrap%NStateImp(n1), cntn1, rc=rc) ! Import Field Count + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (cntn1 > 0) then + do n2 = 1,ncomps + if (is_local%wrap%comp_present(n2) .and. ESMF_StateIsCreated(is_local%wrap%NStateExp(n2),rc=rc) .and. & + med_coupling_allowed(n1,n2)) then + call State_GetNumFields(is_local%wrap%NStateExp(n2), cntn2, rc=rc) ! Import Field Count + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (cntn2 > 0) is_local%wrap%med_coupling_active(n1,n2) = .true. + endif + enddo + end if + endif + enddo + + ! create tables of allowed and active coupling flags + ! - the rows are the destination of coupling + ! - the columns are the source of coupling + ! - So, the second column indicates which models the atm is coupled to. + ! - And the second row indicates which models are coupled to the atm. + if (mastertask) then + write(logunit,*) ' ' + write(logunit,'(A)') trim(subname)//' Allowed coupling flags' + write(logunit,'(2x,A10,20(A5))') '|from to -> ',(compname(n2),n2=1,ncomps) + do n1 = 1,ncomps + write(msgString,'(2x,a1,A,5x,20(L5))') '|',trim(compname(n1)), & + (med_coupling_allowed(n1,n2),n2=1,ncomps) + do n2 = 1,len_trim(msgString) + if (msgString(n2:n2) == 'F') msgString(n2:n2)='-' + enddo + write(logunit,'(A)') trim(msgString) + enddo + + write(logunit,*) ' ' + write(logunit,'(A)') subname//' Active coupling flags' + write(logunit,'(2x,A10,20(A5))') '|from to -> ',(compname(n2),n2=1,ncomps) + do n1 = 1,ncomps + write(msgString,'(2x,a1,A,5x,20(L5))') '|',trim(compname(n1)), & + (is_local%wrap%med_coupling_active(n1,n2),n2=1,ncomps) + do n2 = 1,len_trim(msgString) + if (msgString(n2:n2) == 'F') msgString(n2:n2)='-' + enddo + write(logunit,'(A)') trim(msgString) + enddo + write(logunit,*) ' ' + endif + + ! Determine lnd2glc_coupling flag + do ns = 1,is_local%wrap%num_icesheets + if (is_local%wrap%med_coupling_active(complnd,compglc(ns))) then + is_local%wrap%lnd2glc_coupling = .true. + exit + end if + end do + + ! Determine accum_lnd2glc flag + if (is_local%wrap%lnd2glc_coupling) then + is_local%wrap%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,*) is_local%wrap%accum_lnd2glc + end if + end if + + ! Determine ocn2glc_coupling flag + do ns = 1,is_local%wrap%num_icesheets + if (is_local%wrap%med_coupling_active(compocn,compglc(ns))) then + is_local%wrap%ocn2glc_coupling = .true. + exit + end if + end do + if (.not. is_local%wrap%ocn2glc_coupling) then + ! Reset ocn2glc active coupling based in input attribute + do ns = 1,is_local%wrap%num_icesheets + is_local%wrap%med_coupling_active(compocn,compglc(ns)) = .false. + end do + end if + + ! Dealloate memory + deallocate(med_coupling_allowed) + + end subroutine med_internalstate_coupling + end module med_internalstate_mod diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 6b713398a..5921d927e 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -75,16 +75,17 @@ 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_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 + 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 + use med_internalstate_mod , only : mapunset, compname, compocn, compatm + use med_internalstate_mod , only : ncomps, nmappers, compname, mapnames, mapfcopy ! input/output variables type(ESMF_GridComp) :: gcomp @@ -324,25 +325,25 @@ end subroutine med_map_routehandles_initfrom_fieldbundle !================================================================================ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, routehandles, mapfile, rc) - use ESMF , only : ESMF_RouteHandle, ESMF_RouteHandlePrint, ESMF_Field, ESMF_MAXSTR - use ESMF , only : ESMF_PoleMethod_Flag, ESMF_POLEMETHOD_ALLAVG, ESMF_POLEMETHOD_NONE - use ESMF , only : ESMF_FieldSMMStore, ESMF_FieldRedistStore, ESMF_FieldRegridStore - use ESMF , only : ESMF_RouteHandleIsCreated, ESMF_RouteHandleCreate - use ESMF , only : ESMF_REGRIDMETHOD_BILINEAR, ESMF_REGRIDMETHOD_PATCH - use ESMF , only : ESMF_REGRIDMETHOD_CONSERVE, ESMF_NORMTYPE_DSTAREA, ESMF_NORMTYPE_FRACAREA - use ESMF , only : ESMF_UNMAPPEDACTION_IGNORE, ESMF_REGRIDMETHOD_NEAREST_STOD - use ESMF , only : ESMF_EXTRAPMETHOD_NEAREST_STOD - use ESMF , only : ESMF_Mesh, ESMF_MeshLoc, ESMF_MESHLOC_ELEMENT, ESMF_TYPEKIND_I4 - use ESMF , only : ESMF_MeshGet, ESMF_DistGridGet, ESMF_DistGrid, ESMF_TYPEKIND_R8 - use ESMF , only : ESMF_FieldGet, ESMF_FieldCreate, ESMF_FieldWrite, ESMF_FieldDestroy - use esmFlds , only : mapbilnr, mapconsf, mapconsd, mappatch, mappatch_uv3d, mapbilnr_uv3d, mapfcopy - use esmFlds , only : mapunset, mapnames, nmappers - use esmFlds , only : mapnstod, mapnstod_consd, mapnstod_consf, mapnstod_consd - use esmFlds , only : mapfillv_bilnr, mapbilnr_nstod, mapconsf_aofrac - use esmFlds , only : ncomps, compatm, compice, compocn, compwav, compname - use esmFlds , only : coupling_mode, dststatus_print - use esmFlds , only : atm_name - use med_constants_mod , only : ispval_mask => med_constants_ispval_mask + use ESMF , only : ESMF_RouteHandle, ESMF_RouteHandlePrint, ESMF_Field, ESMF_MAXSTR + use ESMF , only : ESMF_PoleMethod_Flag, ESMF_POLEMETHOD_ALLAVG, ESMF_POLEMETHOD_NONE + use ESMF , only : ESMF_FieldSMMStore, ESMF_FieldRedistStore, ESMF_FieldRegridStore + use ESMF , only : ESMF_RouteHandleIsCreated, ESMF_RouteHandleCreate + use ESMF , only : ESMF_REGRIDMETHOD_BILINEAR, ESMF_REGRIDMETHOD_PATCH + use ESMF , only : ESMF_REGRIDMETHOD_CONSERVE, ESMF_NORMTYPE_DSTAREA, ESMF_NORMTYPE_FRACAREA + use ESMF , only : ESMF_UNMAPPEDACTION_IGNORE, ESMF_REGRIDMETHOD_NEAREST_STOD + use ESMF , only : ESMF_EXTRAPMETHOD_NEAREST_STOD + use ESMF , only : ESMF_Mesh, ESMF_MeshLoc, ESMF_MESHLOC_ELEMENT, ESMF_TYPEKIND_I4 + use ESMF , only : ESMF_MeshGet, ESMF_DistGridGet, ESMF_DistGrid, ESMF_TYPEKIND_R8 + use ESMF , only : ESMF_FieldGet, ESMF_FieldCreate, ESMF_FieldWrite, ESMF_FieldDestroy + use med_internalstate_mod , only : mapbilnr, mapconsf, mapconsd, mappatch, mappatch_uv3d, mapbilnr_uv3d, mapfcopy + use med_internalstate_mod , only : mapunset, mapnames, nmappers + use med_internalstate_mod , only : mapnstod, mapnstod_consd, mapnstod_consf, mapnstod_consd + use med_internalstate_mod , only : mapfillv_bilnr, mapbilnr_nstod, mapconsf_aofrac + use med_internalstate_mod , only : ncomps, compatm, compice, compocn, compwav, compname + use med_internalstate_mod , only : coupling_mode, dststatus_print + use med_internalstate_mod , only : atm_name + use med_constants_mod , only : ispval_mask => med_constants_ispval_mask ! input/output variables integer , intent(in) :: n1 @@ -402,18 +403,19 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, polemethod = ESMF_POLEMETHOD_NONE ! todo: remove this when ESMF tripolar mapping fix is in place. endif else if (coupling_mode(1:4) == 'nems') then - if (n1 == compatm .and. (n2 == compocn .or. n2 == compice)) then + if ( (n1 == compocn .or. n1 == compice .or. n1 == compwav) .and. & + (n2 == compocn .or. n2 == compice .or. n2 == compwav) ) then + srcMaskValue = 0 + dstMaskValue = 0 + else if (n1 == compatm .and. (n2 == compocn .or. n2 == compice .or. n2 == compwav)) then srcMaskValue = 1 dstMaskValue = 0 if (atm_name(1:4).eq.'datm') then - srcMaskValue = 0 + srcMaskValue = 0 endif - else if (n2 == compatm .and. (n1 == compocn .or. n1 == compice)) then + else if (n2 == compatm .and. (n1 == compocn .or. n1 == compice .or. n1 == compwav)) then srcMaskValue = 0 dstMaskValue = 1 - else if ((n1 == compocn .and. n2 == compice) .or. (n1 == compice .and. n2 == compocn)) then - srcMaskValue = 0 - dstMaskValue = 0 else ! TODO: what should the condition be here? dstMaskValue = ispval_mask @@ -433,14 +435,16 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, srcMaskValue = 0 dstMaskValue = ispval_mask elseif (n1 == compatm .and. n2 == compwav) then - dstMaskValue = 1 + dstMaskValue = 0 elseif (n1 == compwav .and. n2 == compatm) then - srcMaskValue = 1 + srcMaskValue = 0 dstMaskValue = ispval_mask endif end if - write(string,'(a)') trim(compname(n1))//' to '//trim(compname(n2)) + write(string,'(a,i10,a,i10)') trim(compname(n1))//' to '//trim(compname(n2))//' srcMask = ', & + srcMaskValue,' dstMask = ',dstMaskValue + call ESMF_LogWrite(trim(string), ESMF_LOGMSG_INFO) ! Create route handle if (mapindex == mapfcopy) then @@ -680,9 +684,9 @@ end function med_map_RH_is_created_RH3d logical function med_map_RH_is_created_RH1d(RHs,mapindex,rc) - use ESMF , only : ESMF_RouteHandle, ESMF_RouteHandleIsCreated - use esmFlds , only : mapconsd, mapconsf, mapnstod - use esmFlds , only : mapnstod_consd, mapnstod_consf + use ESMF , only : ESMF_RouteHandle, ESMF_RouteHandleIsCreated + use med_internalstate_mod , only : mapconsd, mapconsf, mapnstod + use med_internalstate_mod , only : mapnstod_consd, mapnstod_consf ! input/output varaibes type(ESMF_RouteHandle) , intent(in) :: RHs(:) @@ -730,8 +734,9 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & fldsSrc, FBSrc, FBDst, packed_data, rc) use ESMF - use esmFlds , only : med_fldList_entry_type, nmappers - use esmFlds , only : ncomps, compatm, compice, compocn, compname, mapnames + use esmFlds , only : med_fldList_entry_type + use med_internalstate_mod , only : nmappers + use med_internalstate_mod , only : ncomps, compatm, compice, compocn, compname, mapnames use med_internalstate_mod , only : packed_data_type ! input/output variables @@ -933,8 +938,8 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, field_normOne, packed_d use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet use ESMF , only : ESMF_FieldBundleIsCreated use ESMF , only : ESMF_FieldRedist, ESMF_RouteHandle - use esmFlds , only : nmappers, mapfcopy - use esmFlds , only : mappatch_uv3d, mappatch, mapbilnr_uv3d, mapbilnr + use med_internalstate_mod , only : nmappers, mapfcopy + use med_internalstate_mod , only : mappatch_uv3d, mappatch, mapbilnr_uv3d, mapbilnr use med_internalstate_mod , only : packed_data_type ! input/output variables @@ -1262,18 +1267,18 @@ subroutine med_map_field(field_src, field_dst, routehandles, maptype, fldname, r ! map the source field to the destination field !--------------------------------------------------- - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS - use ESMF , only : ESMF_LOGMSG_ERROR, ESMF_FAILURE, ESMF_MAXSTR - use ESMF , only : ESMF_KIND_R8 - use ESMF , only : ESMF_Field, ESMF_FieldRegrid - use ESMF , only : ESMF_FieldFill - use ESMF , only : ESMF_TERMORDER_SRCSEQ, ESMF_Region_Flag, ESMF_REGION_TOTAL - use ESMF , only : ESMF_REGION_SELECT - use ESMF , only : ESMF_RouteHandle - use esmFlds , only : mapnstod_consd, mapnstod_consf, mapnstod_consd, mapnstod - use esmFlds , only : mapconsd, mapconsf - use esmFlds , only : mapfillv_bilnr - use med_methods_mod , only : Field_diagnose => med_methods_Field_diagnose + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS + use ESMF , only : ESMF_LOGMSG_ERROR, ESMF_FAILURE, ESMF_MAXSTR + use ESMF , only : ESMF_KIND_R8 + use ESMF , only : ESMF_Field, ESMF_FieldRegrid + use ESMF , only : ESMF_FieldFill + use ESMF , only : ESMF_TERMORDER_SRCSEQ, ESMF_Region_Flag, ESMF_REGION_TOTAL + use ESMF , only : ESMF_REGION_SELECT + use ESMF , only : ESMF_RouteHandle + use med_internalstate_mod , only : mapnstod_consd, mapnstod_consf, mapnstod_consd, mapnstod + use med_internalstate_mod , only : mapconsd, mapconsf + use med_internalstate_mod , only : mapfillv_bilnr + use med_methods_mod , only : Field_diagnose => med_methods_Field_diagnose ! input/output variables type(ESMF_Field) , intent(in) :: field_src diff --git a/mediator/med_merge_mod.F90 b/mediator/med_merge_mod.F90 index c226b1ab9..bd1aa4f80 100644 --- a/mediator/med_merge_mod.F90 +++ b/mediator/med_merge_mod.F90 @@ -5,13 +5,12 @@ 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_internalstate_mod , only : logunit, compmed, compname use med_constants_mod , only : dbug_flag => med_constants_dbug_flag 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 use med_methods_mod , only : FB_GetFldPtr => med_methods_FB_GetFldPtr - use esmFlds , only : compmed, compname use esmFlds , only : med_fldList_type use esmFlds , only : med_fldList_GetNumFlds use esmFlds , only : med_fldList_GetFldInfo diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index d8aa7acdd..2b28164ac 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -16,7 +16,8 @@ module med_phases_aofluxes_mod 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_REGRIDMETHOD_CONSERVE_2ND, ESMF_REGRIDMETHOD_CONSERVE + use ESMF , only : ESMF_REGRIDMETHOD_PATCH, ESMF_REGRIDMETHOD_BILINEAR 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 @@ -24,10 +25,10 @@ module med_phases_aofluxes_mod 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, mastertask, logunit + use med_internalstate_mod , only : compatm, compocn, coupling_mode, mapconsd, mapconsf, mapfcopy 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 esmFlds , only : compatm, compocn, coupling_mode, mapconsd, mapconsf, mapfcopy use perf_mod , only : t_startf, t_stopf implicit none @@ -39,6 +40,10 @@ module med_phases_aofluxes_mod public :: med_phases_aofluxes_init_fldbuns public :: med_phases_aofluxes_run + public :: med_aofluxes_map_ogrid2agrid_output + public :: med_aofluxes_map_xgrid2agrid_output + public :: med_aofluxes_map_xgrid2ogrid_output + public :: med_aofluxes_map_agrid2ogrid_output !-------------------------------------------------------------------------- ! Private routines @@ -48,6 +53,9 @@ module med_phases_aofluxes_mod private :: med_aofluxes_init_ogrid private :: med_aofluxes_init_agrid private :: med_aofluxes_init_xgrid + private :: med_aofluxes_map_ogrid2xgrid_input + private :: med_aofluxes_map_agrid2xgrid_input + private :: med_aofluxes_map_ogrid2agrid_input private :: med_aofluxes_update private :: set_aoflux_in_pointers private :: set_aoflux_out_pointers @@ -79,8 +87,11 @@ module med_phases_aofluxes_mod 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(ESMF_RouteHandle) :: rh_agrid2xgrid_bilinr ! atm->xgrid mapping bilinear + type(ESMF_RouteHandle) :: rh_agrid2xgrid_patch ! atm->xgrid mapping patch + type(ESMF_XGrid) :: xgrid + type(ESMF_Field) :: field_o + type(ESMF_Field) :: field_x type aoflux_in_type ! input: ocn @@ -139,9 +150,11 @@ module med_phases_aofluxes_mod 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 : med_fldList_GetNumFlds + use esmFlds , only : med_fldList_GetFldNames use esmFlds , only : fldListMed_aoflux use med_methods_mod , only : FB_init => med_methods_FB_init + use med_internalstate_mod, only : compname ! input/output variables type(ESMF_GridComp) :: gcomp @@ -310,13 +323,13 @@ subroutine med_aofluxes_init(gcomp, aoflux_in, aoflux_out, rc) 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 #ifdef CESMCOUPLED use shr_flux_mod , only : shr_flux_adjust_constants #else use flux_atmocn_mod , only : flux_adjust_constants #endif + !----------------------------------------------------------------------- ! Initialize pointers to the module variables !----------------------------------------------------------------------- @@ -655,7 +668,7 @@ subroutine med_aofluxes_init_agrid(gcomp, aoflux_in, aoflux_out, rc) routehandles=is_local%wrap%RH(compocn,compatm,:), maptype=maptype, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldDestroy(field_src, rc=rc, noGarbage=.true.) + call ESMF_FieldDestroy(field_src, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if @@ -679,20 +692,13 @@ subroutine med_aofluxes_init_xgrid(gcomp, aoflux_in, aoflux_out, rc) 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) :: field_a + type(ESMF_Field) :: field_o 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(:) + real(r8), pointer :: dataptr(:) integer :: fieldcount character(ESMF_MAXSTR),allocatable :: fieldNameList(:) character(len=*),parameter :: subname=' (med_aofluxes_init_xgrid) ' @@ -726,6 +732,13 @@ subroutine med_aofluxes_init_xgrid(gcomp, aoflux_in, aoflux_out, rc) storeOverlay=.true., rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + ! create module field on exchange grid and set its initial value to 1 + field_x = ESMF_FieldCreate(xgrid, typekind=ESMF_TYPEKIND_R8, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(field_x, farrayptr=dataptr, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + dataptr(:) = 1.0_r8 + ! ------------------------ ! input fields from atm and ocn on xgrid ! ------------------------ @@ -763,17 +776,33 @@ subroutine med_aofluxes_init_xgrid(gcomp, aoflux_in, aoflux_out, rc) ! 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) + ! create temporary field + field_a = ESMF_FieldCreate(atm_mesh, ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldRegridStore(xgrid, lfield_a, lfield_x, routehandle=rh_agrid2xgrid, rc=rc) + call ESMF_FieldGet(field_a, farrayptr=dataptr, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldRegridStore(xgrid, lfield_x, lfield_a, routehandle=rh_xgrid2agrid, rc=rc) + dataptr(:) = 1.0_r8 + + ! create agrid->xgrid route handles + call ESMF_FieldRegridStore(xgrid, field_a, field_x, routehandle=rh_agrid2xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldRegridStore(xgrid, lfield_a, lfield_x, routehandle=rh_agrid2xgrid_2ndord, & + call ESMF_FieldRegridStore(xgrid, field_a, field_x, routehandle=rh_agrid2xgrid_2ndord, & regridmethod=ESMF_REGRIDMETHOD_CONSERVE_2ND, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldRegridStore(field_a, field_x, routehandle=rh_agrid2xgrid_bilinr, & + regridmethod=ESMF_REGRIDMETHOD_BILINEAR, dstMaskValues=(/0/), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldRegridStore(field_a, field_x, routehandle=rh_agrid2xgrid_patch, & + regridmethod=ESMF_REGRIDMETHOD_PATCH, dstMaskValues=(/0/), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! create xgrid->zgrid route handle + call ESMF_FieldRegridStore(xgrid, field_x, field_a, routehandle=rh_xgrid2agrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! destroy temporary field + call ESMF_FieldDestroy(field_a, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return ! ------------------------ ! create the routehandles ocn->xgrid and xgrid->ocn @@ -781,17 +810,20 @@ subroutine med_aofluxes_init_xgrid(gcomp, aoflux_in, aoflux_out, rc) ! 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) + field_o = ESMF_FieldCreate(ocn_mesh, ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, 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) + call ESMF_FieldGet(field_o, farrayptr=dataptr, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldRegridStore(xgrid, lfield_o, lfield_x, routehandle=rh_ogrid2xgrid, rc=rc) + dataptr(:) = 1.0_r8 + call ESMF_FieldRegridStore(xgrid, field_o, field_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) + call ESMF_FieldRegridStore(xgrid, field_x, field_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, & + ! call ESMF_FieldRegridStore(xgrid, field_o, field_x, routehandle=rh_ogrid2xgrid_2ndord, & ! regridmethod=ESMF_REGRIDMETHOD_CONSERVE_2ND, rc=rc) ! if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldDestroy(field_o, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return ! ------------------------ ! setup the compute mask - default compute everywhere for exchange grid @@ -800,58 +832,6 @@ subroutine med_aofluxes_init_xgrid(gcomp, aoflux_in, aoflux_out, rc) 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 !=============================================================================== @@ -888,7 +868,6 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) integer :: n,i,nf ! indices real(r8), pointer :: data_normdst(:) real(r8), pointer :: data_dst(:) - integer :: maptype character(*),parameter :: subName = '(med_aofluxes_update) ' !----------------------------------------------------------------------- @@ -910,86 +889,16 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) else if (is_local%wrap%aoflux_grid == 'agrid') then - ! 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 - - ! 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 - - ! 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 + call med_aofluxes_map_ogrid2agrid_input(gcomp, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return 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 + call med_aofluxes_map_agrid2xgrid_input(gcomp, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call med_aofluxes_map_ogrid2xgrid_input(gcomp, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - ! 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 !---------------------------------- @@ -1057,53 +966,87 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) 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 + ! mapping aoflux from ogrid to agrid is done in med_phases_prep_atm + ! which is called from med_phases_prep_atm (since need to use updated ocean fractions) 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 + call med_aofluxes_map_agrid2ogrid_output(gcomp, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return end if else if (is_local%wrap%aoflux_grid == 'xgrid') then - do nf = 1,size(fldnames_aof_out) + ! mapping aoflux from xgrid to agrid is done in med_aofluxes_map_xgrid2agrid_output + ! which is called from med_phases_prep_atm (since need to use updated ocean fractions) + call med_aofluxes_map_xgrid2ogrid_output(gcomp, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - ! 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 + end if - ! 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) + call t_stopf('MED:'//subname) + + end subroutine med_aofluxes_update + + !================================================================================ + subroutine med_aofluxes_map_ogrid2agrid_input(gcomp, rc) + + ! aoflux is on agrid and this maps the ogrid input to the agrid + + use med_map_mod, only : med_map_RH_is_created + + ! Arguments + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + ! + ! Local variables + type(InternalState) :: is_local + type(ESMF_Field) :: field_src + type(ESMF_Field) :: field_dst + real(r8), pointer :: data_normdst(:) + real(r8), pointer :: data_dst(:) + integer :: nf,n + integer :: maptype + character(*),parameter :: subName = '(med_aofluxes_map_ogrid2agrid_output) ' + !----------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! 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 + + ! 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 + + ! 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 @@ -1114,19 +1057,290 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) data_dst(n) = data_dst(n)/data_normdst(n) end if end do + 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, & + end subroutine med_aofluxes_map_ogrid2agrid_input + + !================================================================================ + subroutine med_aofluxes_map_agrid2xgrid_input(gcomp, rc) + + ! Map input atm to xgrid + + ! Arguments + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + ! + ! Local variables + type(InternalState) :: is_local + type(ESMF_Field) :: field_src + type(ESMF_Field) :: field_dst + integer :: nf + character(*),parameter :: subName = '(med_aofluxes_map_ogrid2agrid_output) ' + !----------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + 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 + 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_patch, & termorderflag=ESMF_TERMORDER_SRCSEQ, zeroregion=ESMF_REGION_TOTAL, rc=rc) - end do + else + call ESMF_FieldRegrid(field_src, field_dst, routehandle=rh_agrid2xgrid_bilinr, & + termorderflag=ESMF_TERMORDER_SRCSEQ, zeroregion=ESMF_REGION_TOTAL, rc=rc) + end if + end do + + end subroutine med_aofluxes_map_agrid2xgrid_input + + !================================================================================ + subroutine med_aofluxes_map_ogrid2xgrid_input(gcomp, rc) + + ! Map input ocn to xgrid + + ! Arguments + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + ! + ! Local variables + type(InternalState) :: is_local + type(ESMF_Field) :: field_src + type(ESMF_Field) :: field_dst + integer :: nf + character(*),parameter :: subName = '(med_aofluxes_map_ogrid2agrid_output) ' + !----------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + 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 subroutine med_aofluxes_map_ogrid2xgrid_input + + !================================================================================ + subroutine med_aofluxes_map_ogrid2agrid_output(gcomp, rc) + + use med_map_mod, only : med_map_field_packed + + ! Arguments + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + ! + ! Local variables + type(InternalState) :: is_local + character(*),parameter :: subName = '(med_aofluxes_map_ogrid2agrid_output) ' + !----------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + 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 + + end subroutine med_aofluxes_map_ogrid2agrid_output + + !================================================================================ + subroutine med_aofluxes_map_agrid2ogrid_output(gcomp, rc) + + ! map aoflux from agrid to ogrid + use med_map_mod , only : med_map_field_packed, med_map_rh_is_created + + ! Arguments + type(ESMF_GridComp) :: gcomp + integer , intent(out) :: rc + ! + ! Local variables + type(InternalState) :: is_local + type(ESMF_Field) :: field_src + type(ESMF_Field) :: field_dst + integer :: nf ! indices + integer :: maptype + character(*),parameter :: subName = '(med_aofluxes_map_agrid2ogrid_output) ' + !----------------------------------------------------------------------- + + 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 subroutine med_aofluxes_map_agrid2ogrid_output + +!================================================================================ + subroutine med_aofluxes_map_xgrid2agrid_output(gcomp, rc) + + use ESMF, only : ESMF_FieldBundleIsCreated + + ! Arguments + type(ESMF_GridComp) :: gcomp + integer , intent(out) :: rc + ! + ! Local variables + type(InternalState) :: is_local + type(ESMF_Field) :: field_src + type(ESMF_Field) :: field_dst + type(ESMF_Field) :: lfield + integer :: n,i,nf ! indices + real(r8), pointer :: data_src(:) + real(r8), pointer :: data_src_save(:) + real(r8), pointer :: data_dst(:) + real(r8), pointer :: ofrac_x(:) + real(r8), pointer :: ofrac_a(:) + character(*),parameter :: subName = '(med_aofluxes_map_xgrid2agrid_output) ' + !----------------------------------------------------------------------- + rc = ESMF_SUCCESS + + if (.not. ESMF_FieldBundleIsCreated(FBaof_x)) then + RETURN end if - call t_stopf('MED:'//subname) + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - end subroutine med_aofluxes_update + ! Map ocn fraction on ocn mesh to xgrid + call ESMF_FieldBundleGet(is_local%wrap%FBFrac(compocn), 'ofrac', field=field_o, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldRegrid(field_o, field_x, routehandle=rh_ogrid2xgrid, & + termorderflag=ESMF_TERMORDER_SRCSEQ, zeroregion=ESMF_REGION_TOTAL, rc=rc) + call ESMF_FieldGet(field_x, farrayptr=ofrac_x, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + 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_FieldGet(field_src, farrayptr=data_src, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(data_src_save(size(data_src))) + data_src_save(:) = data_src(:) + do n = 1,size(data_src) + data_src(n) = data_src(n) * ofrac_x(n) + end do + call ESMF_FieldRegrid(field_src, field_dst, routehandle=rh_xgrid2agrid, & + termorderflag=ESMF_TERMORDER_SRCSEQ, zeroregion=ESMF_REGION_TOTAL, rc=rc) + data_src(:) = data_src_save(:) + deallocate(data_src_save) + call ESMF_FieldGet(field_dst, farrayptr=data_dst, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! normalization by '1./ofrac_a' + call ESMF_FieldBundleGet(is_local%wrap%FBFrac(compatm), 'ofrac', field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayptr=ofrac_a, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + do n = 1,size(ofrac_a) + if (ofrac_a(n) == 0.0_r8) then + data_dst(n) = 0.0_r8 + else + data_dst(n) = data_dst(n)/ofrac_a(n) + end if + end do + + end do + + end subroutine med_aofluxes_map_xgrid2agrid_output + +!================================================================================ + subroutine med_aofluxes_map_xgrid2ogrid_output(gcomp, rc) + + ! map aoflx output from xgrid->ogrid + + ! Arguments + type(ESMF_GridComp) :: gcomp + integer , intent(out) :: rc + ! + ! Local variables + type(InternalState) :: is_local + integer :: n,i,nf ! indices + type(ESMF_Field) :: field_src + type(ESMF_Field) :: field_dst + character(*),parameter :: subName = '(med_aofluxes_map_xgrid2ogrid_output) ' + !----------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + 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 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 subroutine med_aofluxes_map_xgrid2ogrid_output !================================================================================ subroutine set_aoflux_in_pointers(fldbun_a, fldbun_o, aoflux_in, lsize, xgrid, rc) diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 5bf3c3a53..7cfc6fc89 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -18,8 +18,8 @@ module med_phases_history_mod 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 : ncomps, compname 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, med_io_close @@ -28,6 +28,9 @@ module med_phases_history_mod implicit none private + ! Public routine called from med_internal_state_init + public :: med_phases_history_init + ! Public routine called from the run sequence public :: med_phases_history_write ! inst only - for all variables @@ -65,7 +68,7 @@ module med_phases_history_mod logical :: is_clockset = .false. logical :: is_active = .false. end type instfile_type - type(instfile_type) , public :: instfiles(ncomps) + type(instfile_type) , allocatable, public :: instfiles(:) ! ---------------------------- ! Time averaging history files @@ -84,7 +87,7 @@ module med_phases_history_mod logical :: is_clockset = .false. logical :: is_active = .false. end type avgfile_type - type(avgfile_type) :: avgfiles(ncomps) + type(avgfile_type), allocatable :: avgfiles(:) ! ---------------------------- ! Auxiliary history files @@ -109,9 +112,7 @@ module med_phases_history_mod 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 + type(auxcomp_type), allocatable, public :: auxcomp(:) ! ---------------------------- ! Other private module variables @@ -130,6 +131,14 @@ module med_phases_history_mod contains !=============================================================================== + subroutine med_phases_history_init() + ! allocate module memory + allocate(instfiles(ncomps)) + allocate(avgfiles(ncomps)) + allocate(auxcomp(ncomps)) + end subroutine med_phases_history_init + + !=============================================================================== subroutine med_phases_history_write(gcomp, rc) ! -------------------------------------- @@ -139,7 +148,7 @@ subroutine med_phases_history_write(gcomp, rc) use med_io_mod, only : med_io_write_time, med_io_define_time use ESMF , only : ESMF_Alarm, ESMF_AlarmSet use ESMF , only : ESMF_FieldBundleIsCreated - use esmflds , only : compocn, compatm + use med_internalstate_mod, only : compocn, compatm ! input/output variables type(ESMF_GridComp) :: gcomp @@ -369,7 +378,7 @@ subroutine med_phases_history_write_med(gcomp, rc) use ESMF , only : ESMF_FieldBundleIsCreated use med_io_mod, only : med_io_write_time, med_io_define_time - use esmFlds , only : compmed, compocn, compatm + use med_internalstate_mod, only : compmed, compocn, compatm ! input/output variables type(ESMF_GridComp) :: gcomp @@ -506,7 +515,7 @@ subroutine med_phases_history_write_lnd2glc(gcomp, fldbun, rc) ! Write yearly average of lnd -> glc fields - use esmFlds , only : complnd + use med_internalstate_mod, 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 diff --git a/mediator/med_phases_ocnalb_mod.F90 b/mediator/med_phases_ocnalb_mod.F90 index ce3ef2a82..1fe8fb502 100644 --- a/mediator/med_phases_ocnalb_mod.F90 +++ b/mediator/med_phases_ocnalb_mod.F90 @@ -6,7 +6,7 @@ module med_phases_ocnalb_mod use med_utils_mod , only : chkerr => med_utils_chkerr use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose use med_methods_mod , only : State_GetScalar => med_methods_State_GetScalar - use esmFlds , only : mapconsf, mapnames, compatm, compocn + use med_internalstate_mod , only : mapconsf, mapnames, compatm, compocn use perf_mod , only : t_startf, t_stopf #ifdef CESMCOUPLED use shr_orb_mod , only : shr_orb_cosz, shr_orb_decl diff --git a/mediator/med_phases_post_atm_mod.F90 b/mediator/med_phases_post_atm_mod.F90 index acf1c2298..ab6f65e2b 100644 --- a/mediator/med_phases_post_atm_mod.F90 +++ b/mediator/med_phases_post_atm_mod.F90 @@ -1,7 +1,8 @@ module med_phases_post_atm_mod !----------------------------------------------------------------------------- - ! Mediator phase for post atm calculations, maps atm->ice, atm->lnd and atm->ocn + ! Mediator phase for post atm calculations, maps atm->ice, atm->lnd, atm->ocn + ! and atm->wav !----------------------------------------------------------------------------- implicit none @@ -32,7 +33,7 @@ subroutine med_phases_post_atm(gcomp, rc) 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 - use esmFlds , only : compocn, compatm, compice, complnd + use med_internalstate_mod , only : compocn, compatm, compice, complnd, compwav use perf_mod , only : t_startf, t_stopf ! input/output variables @@ -96,6 +97,19 @@ subroutine med_phases_post_atm(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call t_stopf('MED:'//trim(subname)//' map_atm2lnd') end if + ! map atm->wav + if (is_local%wrap%med_coupling_active(compatm,compwav)) then + call t_startf('MED:'//trim(subname)//' map_atm2wav') + call med_map_field_packed( & + FBSrc=is_local%wrap%FBImp(compatm,compatm), & + FBDst=is_local%wrap%FBImp(compatm,compwav), & + FBFracSrc=is_local%wrap%FBFrac(compatm), & + field_normOne=is_local%wrap%field_normOne(compatm,compwav,:), & + packed_data=is_local%wrap%packed_data(compatm,compwav,:), & + routehandles=is_local%wrap%RH(compatm,compwav,:), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call t_stopf('MED:'//trim(subname)//' map_atm2wav') + end if ! Write atm inst, avg or aux if requested in mediator attributes call NUOPC_MediatorGet(gcomp, driverClock=dClock, rc=rc) diff --git a/mediator/med_phases_post_glc_mod.F90 b/mediator/med_phases_post_glc_mod.F90 index 5987ee355..14610e710 100644 --- a/mediator/med_phases_post_glc_mod.F90 +++ b/mediator/med_phases_post_glc_mod.F90 @@ -14,9 +14,9 @@ module med_phases_post_glc_mod use ESMF , only : ESMF_Mesh, ESMF_MESHLOC_ELEMENT, ESMF_TYPEKIND_R8 use ESMF , only : ESMF_Field, ESMF_FieldGet, ESMF_FieldCreate use ESMF , only : ESMF_RouteHandle, ESMF_RouteHandleIsCreated - use esmFlds , only : compatm, compice, complnd, comprof, compocn, ncomps, compname - use esmFlds , only : max_icesheets, num_icesheets, compglc - use esmFlds , only : mapbilnr, mapconsd, compname + use med_internalstate_mod , only : compatm, compice, complnd, comprof, compocn, compname, compglc + use med_internalstate_mod , only : mapbilnr, mapconsd, compname + use med_internalstate_mod , only : InternalState, mastertask, logunit use esmFlds , only : fldListTo use med_methods_mod , only : fldbun_diagnose => med_methods_FB_diagnose use med_methods_mod , only : fldbun_fldchk => med_methods_FB_fldchk @@ -27,7 +27,6 @@ module med_phases_post_glc_mod use med_methods_mod , only : field_getdata2d => med_methods_Field_getdata2d 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_map_mod , only : med_map_rh_is_created, med_map_routehandles_init use med_map_mod , only : med_map_field_packed, med_map_field_normalized, med_map_field use glc_elevclass_mod , only : glc_mean_elevation_virtual, glc_get_fractional_icecov @@ -58,7 +57,7 @@ module med_phases_post_glc_mod type(ESMF_Field) :: field_topo_x_icemask_g_ec ! elevation classes type(ESMF_Mesh) :: mesh_g end type ice_sheet_tolnd_type - type(ice_sheet_tolnd_type) :: ice_sheet_tolnd(max_icesheets) + type(ice_sheet_tolnd_type), allocatable :: ice_sheet_tolnd(:) type(ESMF_field) :: field_icemask_l ! no elevation classes type(ESMF_Field) :: field_frac_l_ec ! elevation classes @@ -116,21 +115,21 @@ subroutine med_phases_post_glc(gcomp, rc) if (first_call) then ! determine if there will be any glc to lnd coupling - do ns = 1,num_icesheets + do ns = 1,is_local%wrap%num_icesheets if (is_local%wrap%med_coupling_active(compglc(ns),complnd)) then glc2lnd_coupling = .true. exit end if end do ! determine if there will be any glc to ocn coupling - do ns = 1,num_icesheets + do ns = 1,is_local%wrap%num_icesheets if (is_local%wrap%med_coupling_active(compglc(ns),compocn)) then glc2ocn_coupling = .true. exit end if end do ! determine if there will be any glc to ice coupling - do ns = 1,num_icesheets + do ns = 1,is_local%wrap%num_icesheets if (is_local%wrap%med_coupling_active(compglc(ns),compice)) then glc2ice_coupling = .true. exit @@ -160,7 +159,7 @@ subroutine med_phases_post_glc(gcomp, rc) ! merging with rof->ocn fields is done in med_phases_prep_ocn !--------------------------------------- if (glc2ocn_coupling) then - do ns = 1,num_icesheets + do ns = 1,is_local%wrap%num_icesheets if (is_local%wrap%med_coupling_active(compglc(ns),compocn)) then call med_map_field_packed( & FBSrc=is_local%wrap%FBImp(compglc(ns),compglc(ns)), & @@ -187,7 +186,7 @@ subroutine med_phases_post_glc(gcomp, rc) if (glc2lnd_coupling) then ! The will following will map and merge Sg_frac and Sg_topo (and in the future Flgg_hflx) call t_startf('MED:'//trim(subname)//' glc2lnd ') - do ns = 1,num_icesheets + do ns = 1,is_local%wrap%num_icesheets if (is_local%wrap%med_coupling_active(compglc(ns),complnd)) then call med_map_field_packed( & FBSrc=is_local%wrap%FBImp(compglc(ns),compglc(ns)), & @@ -219,7 +218,7 @@ subroutine med_phases_post_glc(gcomp, rc) call NUOPC_MediatorGet(gcomp, driverClock=dClock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (ESMF_ClockIsCreated(dclock)) then - do ns = 1,num_icesheets + do ns = 1,is_local%wrap%num_icesheets call med_phases_history_write_comp(gcomp, compglc(ns), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end do @@ -298,7 +297,10 @@ subroutine map_glc2lnd_init(gcomp, rc) ! create module fields on glc mesh !--------------------------------------- - do ns = 1,max_icesheets + ! allocate module variable + allocate(ice_sheet_tolnd(is_local%wrap%num_icesheets)) + + do ns = 1,is_local%wrap%num_icesheets if (is_local%wrap%med_coupling_active(compglc(ns),complnd)) then call fldbun_getmesh(is_local%wrap%FBImp(compglc(ns),compglc(ns)), ice_sheet_tolnd(ns)%mesh_g, rc) @@ -415,7 +417,7 @@ subroutine map_glc2lnd( gcomp, rc) !--------------------------------- ! Map Sg_icemask and Sg_icemask_coupled_fluxes (no elevation classes) - do ns = 1,num_icesheets + do ns = 1,is_local%wrap%num_icesheets if (is_local%wrap%med_coupling_active(compglc(ns),complnd)) then call t_startf('MED:'//trim(subname)//' glc2lnd ') call med_map_field_packed( & @@ -433,7 +435,7 @@ subroutine map_glc2lnd( gcomp, rc) ! Get Sg_icemask on land as sum of all ice sheets (no elevation classes) call fldbun_getdata1d(is_local%wrap%FBExp(complnd), Sg_icemask, dataptr1d_dst, rc) dataptr1d_dst(:) = 0._r8 - do ns = 1,num_icesheets + do ns = 1,is_local%wrap%num_icesheets if (is_local%wrap%med_coupling_active(compglc(ns),complnd)) then call fldbun_getdata1d(is_local%wrap%FBImp(compglc(ns),complnd), Sg_icemask, dataptr1d_src, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -445,7 +447,7 @@ subroutine map_glc2lnd( gcomp, rc) call fldbun_getdata1d(is_local%wrap%FBExp(complnd), Sg_icemask_coupled_fluxes, dataptr1d_dst, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return dataptr1d_dst(:) = 0._r8 - do ns = 1,num_icesheets + do ns = 1,is_local%wrap%num_icesheets if (is_local%wrap%med_coupling_active(compglc(ns),complnd)) then call fldbun_getdata1d(is_local%wrap%FBImp(compglc(ns),complnd), Sg_icemask_coupled_fluxes, dataptr1d_src, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -453,7 +455,7 @@ subroutine map_glc2lnd( gcomp, rc) end if end do - do ns = 1,num_icesheets + do ns = 1,is_local%wrap%num_icesheets if (is_local%wrap%med_coupling_active(compglc(ns),complnd)) then ! Set (fractional ice coverage for each elevation class on the glc grid) diff --git a/mediator/med_phases_post_ice_mod.F90 b/mediator/med_phases_post_ice_mod.F90 index 2daa4c358..d081448e4 100644 --- a/mediator/med_phases_post_ice_mod.F90 +++ b/mediator/med_phases_post_ice_mod.F90 @@ -30,7 +30,7 @@ subroutine med_phases_post_ice(gcomp, rc) 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 med_internalstate_mod , only : compice, compatm, compocn, compwav use perf_mod , only : t_startf, t_stopf ! input/output variables @@ -59,18 +59,6 @@ subroutine med_phases_post_ice(gcomp, rc) call med_fraction_set(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! map ice to atm - scaling by updated ice fraction - if (is_local%wrap%med_coupling_active(compice,compatm)) then - call med_map_field_packed( & - FBSrc=is_local%wrap%FBImp(compice,compice), & - FBDst=is_local%wrap%FBImp(compice,compatm), & - FBFracSrc=is_local%wrap%FBFrac(compice), & - field_NormOne=is_local%wrap%field_normOne(compice,compatm,:), & - packed_data=is_local%wrap%packed_data(compice,compatm,:), & - routehandles=is_local%wrap%RH(compice,compatm,:), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - end if ! map ice to ocn if (is_local%wrap%med_coupling_active(compice,compocn)) then call t_startf('MED:'//trim(subname)//' map_ice2ocn') diff --git a/mediator/med_phases_post_lnd_mod.F90 b/mediator/med_phases_post_lnd_mod.F90 index 1bd416c77..559e67345 100644 --- a/mediator/med_phases_post_lnd_mod.F90 +++ b/mediator/med_phases_post_lnd_mod.F90 @@ -27,8 +27,7 @@ subroutine med_phases_post_lnd(gcomp, rc) use med_phases_prep_rof_mod , only : med_phases_prep_rof_accum use med_phases_prep_glc_mod , only : med_phases_prep_glc_accum_lnd, med_phases_prep_glc_avg use med_phases_history_mod , only : med_phases_history_write_comp - use esmFlds , only : complnd, compatm, comprof, compglc, num_icesheets - use esmFlds , only : lnd2glc_coupling, accum_lnd2glc + use med_internalstate_mod , only : complnd, compatm, comprof use perf_mod , only : t_startf, t_stopf ! input/output variables @@ -78,12 +77,12 @@ subroutine med_phases_post_lnd(gcomp, rc) end if ! accumulate lnd input for glc (note that lnd2glc_coupling and accum_lnd2glc is determined in med.F90) - if (lnd2glc_coupling) then + if (is_local%wrap%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 + else if (is_local%wrap%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) diff --git a/mediator/med_phases_post_ocn_mod.F90 b/mediator/med_phases_post_ocn_mod.F90 index c51f9eecf..abf766211 100644 --- a/mediator/med_phases_post_ocn_mod.F90 +++ b/mediator/med_phases_post_ocn_mod.F90 @@ -9,8 +9,6 @@ module med_phases_post_ocn_mod public :: med_phases_post_ocn - logical :: ocn2glc_coupling - character(*), parameter :: u_FILE_u = & __FILE__ @@ -29,9 +27,9 @@ subroutine med_phases_post_ocn(gcomp, rc) use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_map_mod , only : med_map_field_packed use med_internalstate_mod , only : InternalState, logunit, mastertask + use med_internalstate_mod , only : compice, compocn, compwav 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 ! input/output variables @@ -40,9 +38,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)' !--------------------------------------- @@ -71,18 +67,22 @@ subroutine med_phases_post_ocn(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call t_stopf('MED:'//trim(subname)//' map_ocn2ice') end if + ! Map ocn->wav + if (is_local%wrap%med_coupling_active(compocn,compwav)) then + call t_startf('MED:'//trim(subname)//' map_ocn2wav') + call med_map_field_packed( & + FBSrc=is_local%wrap%FBImp(compocn,compocn), & + FBDst=is_local%wrap%FBImp(compocn,compwav), & + FBFracSrc=is_local%wrap%FBFrac(compocn), & + field_normOne=is_local%wrap%field_normOne(compocn,compwav,:), & + packed_data=is_local%wrap%packed_data(compocn,compwav,:), & + routehandles=is_local%wrap%RH(compocn,compwav,:), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call t_stopf('MED:'//trim(subname)//' map_ocn2wav') + end if ! Accumulate ocn input for glc if there is ocn->glc coupling - if (first_call) then - do ns = 1,num_icesheets - if (is_local%wrap%med_coupling_active(compocn,compglc(ns))) then - ocn2glc_coupling = .true. - exit - end if - end do - first_call = .false. - end if - if (ocn2glc_coupling) then + if (is_local%wrap%ocn2glc_coupling) then call med_phases_prep_glc_accum_ocn(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if diff --git a/mediator/med_phases_post_rof_mod.F90 b/mediator/med_phases_post_rof_mod.F90 index 10ca7bfc7..ea478b0cc 100644 --- a/mediator/med_phases_post_rof_mod.F90 +++ b/mediator/med_phases_post_rof_mod.F90 @@ -21,7 +21,7 @@ subroutine med_phases_post_rof(gcomp, rc) 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_internalstate_mod , only : complnd, compocn, compice, compatm, comprof, 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 diff --git a/mediator/med_phases_post_wav_mod.F90 b/mediator/med_phases_post_wav_mod.F90 index a1bf805ef..31abf004c 100644 --- a/mediator/med_phases_post_wav_mod.F90 +++ b/mediator/med_phases_post_wav_mod.F90 @@ -24,8 +24,8 @@ subroutine med_phases_post_wav(gcomp, rc) use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose use med_map_mod , only : med_map_field_packed use med_internalstate_mod , only : InternalState, mastertask + use med_internalstate_mod , only : compwav, compatm, compocn, compice 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 ! input/output variables diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index 76c8b1e83..d3af6163d 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -16,9 +16,11 @@ module med_phases_prep_atm_mod use med_merge_mod , only : med_merge_auto use med_map_mod , only : med_map_field_packed use med_internalstate_mod , only : InternalState, mastertask - use esmFlds , only : compatm, compocn, compice, ncomps, compname - use esmFlds , only : fldListTo, fldListMed_aoflux, coupling_mode + use med_internalstate_mod , only : compatm, compocn, compice, compname, coupling_mode + use esmFlds , only : fldListTo, fldListMed_aoflux use perf_mod , only : t_startf, t_stopf + use med_phases_aofluxes_mod, only : med_aofluxes_map_xgrid2agrid_output + use med_phases_aofluxes_mod, only : med_aofluxes_map_ogrid2agrid_output implicit none private @@ -109,18 +111,13 @@ subroutine med_phases_prep_atm(gcomp, rc) !--------------------------------------- if (trim(coupling_mode) == 'cesm' .or. trim(coupling_mode) == 'hafs') then 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 + call med_aofluxes_map_ogrid2agrid_output(gcomp, 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 + ! Do nothing - fluxes are alread being computed on the 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 + call med_aofluxes_map_xgrid2agrid_output(gcomp, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return end if endif diff --git a/mediator/med_phases_prep_glc_mod.F90 b/mediator/med_phases_prep_glc_mod.F90 index 8098d4106..d47bbf46c 100644 --- a/mediator/med_phases_prep_glc_mod.F90 +++ b/mediator/med_phases_prep_glc_mod.F90 @@ -4,8 +4,6 @@ module med_phases_prep_glc_mod ! Mediator phases for preparing glc export from mediator !----------------------------------------------------------------------------- - ! TODO: determine the number of ice sheets that are present - use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use NUOPC , only : NUOPC_CompAttributeGet use NUOPC_Model , only : NUOPC_ModelGet @@ -23,9 +21,7 @@ module med_phases_prep_glc_mod use ESMF , only : ESMF_Mesh, ESMF_MESHLOC_ELEMENT, ESMF_TYPEKIND_R8, ESMF_KIND_R8 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 - use esmFlds , only : ocn2glc_coupling, lnd2glc_coupling, accum_lnd2glc + use med_internalstate_mod , only : complnd, compocn, mapbilnr, mapconsd, compname, compglc 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 @@ -88,7 +84,7 @@ module med_phases_prep_glc_mod 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), allocatable :: toglc_frlnd(:) type(ESMF_Field) :: field_normdst_l type(ESMF_Field) :: field_icemask_l @@ -165,11 +161,14 @@ subroutine med_phases_prep_glc_init(gcomp, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (chkErr(rc,__LINE__,u_FILE_u)) return + ! allocate module variables + allocate(toglc_frlnd(is_local%wrap%num_icesheets)) + ! ------------------------------- ! If will accumulate lnd2glc input on land grid ! ------------------------------- - if (accum_lnd2glc) then + if (is_local%wrap%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) @@ -203,11 +202,11 @@ subroutine med_phases_prep_glc_init(gcomp, rc) ! If lnd->glc couplng is active ! ------------------------------- - if (lnd2glc_coupling) then + if (is_local%wrap%lnd2glc_coupling) then ! Create accumulation field bundles from land on each glc ice sheet mesh ! Determine glc mesh from the mesh from the first export field to glc ! However FBlndAccum2glc_g has the fields fldnames_fr_lnd BUT ON the glc grid - do ns = 1,num_icesheets + do ns = 1,is_local%wrap%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 @@ -293,7 +292,7 @@ subroutine med_phases_prep_glc_init(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! Loop over ice sheets - do ns = 1,num_icesheets + do ns = 1,is_local%wrap%num_icesheets ! ice mask without elevation classes on glc toglc_frlnd(ns)%field_icemask_g = ESMF_FieldCreate(toglc_frlnd(ns)%mesh_g, & ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) @@ -333,7 +332,7 @@ subroutine med_phases_prep_glc_init(gcomp, rc) ! If ocn->glc couplng is active ! ------------------------------- - if (ocn2glc_coupling) then + if (is_local%wrap%ocn2glc_coupling) then ! Get ocean mesh call fldbun_getmesh(is_local%wrap%FBImp(compocn,compocn), mesh_o, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -354,7 +353,7 @@ subroutine med_phases_prep_glc_init(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! create route handle if it has not been created - do ns = 1,num_icesheets + do ns = 1,is_local%wrap%num_icesheets if (.not. med_map_RH_is_created(is_local%wrap%RH(compocn,compglc(ns),:),mapbilnr,rc=rc)) then call ESMF_LogWrite(trim(subname)//" mapbilnr is not created for ocn->glc mapping", & ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) @@ -661,7 +660,7 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) end if end if - if (ocn2glc_coupling) then + if (is_local%wrap%ocn2glc_coupling) then ! Average import from accumulated ocn import data do n = 1, size(fldnames_fr_ocn) call fldbun_getdata2d(FBocnAccum2glc_o, fldnames_fr_ocn(n), data2d, rc) @@ -687,7 +686,7 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) do n = 1,size(fldnames_fr_ocn) 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 + do ns = 1,is_local%wrap%num_icesheets call ESMF_FieldBundleGet(is_local%wrap%FBExp(compglc(ns)), fldnames_fr_ocn(n), field=lfield_dst, rc=rc) if (chkErr(rc,__LINE__,u_FILE_u)) return ! Do mapping of ocn to glc with dynamic masking @@ -701,7 +700,7 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) if (chkErr(rc,__LINE__,u_FILE_u)) return end if - if (lnd2glc_coupling) then + if (is_local%wrap%lnd2glc_coupling) then ! Map accumulated field bundle from land grid (with elevation classes) to glc grid (without elevation classes) ! and set FBExp(compglc(ns)) data ! Zero land accumulator and accumulated field bundles on land grid @@ -713,7 +712,7 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) end if if (dbug_flag > 1) then - do ns = 1,num_icesheets + do ns = 1,is_local%wrap%num_icesheets call fldbun_diagnose(is_local%wrap%FBExp(compglc(ns)), string=trim(subname)//' FBexp(compglc) ', rc=rc) if (chkErr(rc,__LINE__,u_FILE_u)) return end do @@ -786,7 +785,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 + do ns = 1,is_local%wrap%num_icesheets call fldbun_reset(toglc_frlnd(ns)%FBlndAccum2glc_g, value=0.0_r8, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end do @@ -810,11 +809,11 @@ subroutine med_phases_prep_glc_map_lnd2glc(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! map accumlated land fields to each ice sheet (normalize by the land fraction in the mapping) - do ns = 1,num_icesheets + do ns = 1,is_local%wrap%num_icesheets call fldbun_reset(toglc_frlnd(ns)%FBlndAccum2glc_g, value=0.0_r8, rc=rc) if (chkErr(rc,__LINE__,u_FILE_u)) return end do - do ns = 1,num_icesheets + do ns = 1,is_local%wrap%num_icesheets 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 @@ -837,7 +836,7 @@ subroutine med_phases_prep_glc_map_lnd2glc(gcomp, 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 + do ns = 1,is_local%wrap%num_icesheets 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 @@ -849,7 +848,7 @@ subroutine med_phases_prep_glc_map_lnd2glc(gcomp, rc) ! ------------------------------------------------------------------------ ! Loop over ice sheets - do ns = 1,num_icesheets + do ns = 1,is_local%wrap%num_icesheets if (dbug_flag > 1) then write(cnum,'(a3)') ns call fldbun_diagnose(is_local%wrap%FBImp(compglc(ns),compglc(ns)), & diff --git a/mediator/med_phases_prep_ice_mod.F90 b/mediator/med_phases_prep_ice_mod.F90 index 1f6424bf1..0d78bbed0 100644 --- a/mediator/med_phases_prep_ice_mod.F90 +++ b/mediator/med_phases_prep_ice_mod.F90 @@ -37,9 +37,9 @@ subroutine med_phases_prep_ice(gcomp, rc) use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_merge_mod , only : med_merge_auto use med_internalstate_mod , only : InternalState, logunit, mastertask - use esmFlds , only : compatm, compice, compocn, comprof, compglc, ncomps, compname + use med_internalstate_mod , only : compatm, compice, compocn, comprof + use med_internalstate_mod , only : coupling_mode use esmFlds , only : fldListTo - use esmFlds , only : coupling_mode use perf_mod , only : t_startf, t_stopf ! input/output variables diff --git a/mediator/med_phases_prep_lnd_mod.F90 b/mediator/med_phases_prep_lnd_mod.F90 index d60ac6dcf..81114c1bf 100644 --- a/mediator/med_phases_prep_lnd_mod.F90 +++ b/mediator/med_phases_prep_lnd_mod.F90 @@ -26,11 +26,11 @@ subroutine med_phases_prep_lnd(gcomp, rc) use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet, ESMF_Field, ESMF_FieldGet use ESMF , only : ESMF_GridComp, ESMF_GridCompGet use ESMF , only : ESMF_StateGet, ESMF_StateItem_Flag, ESMF_STATEITEM_NOTFOUND - use esmFlds , only : complnd, compatm, ncomps use esmFlds , only : fldListTo use med_methods_mod , only : fldbun_diagnose => med_methods_FB_diagnose 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 : complnd, compatm use med_internalstate_mod , only : InternalState, mastertask, logunit use med_merge_mod , only : med_merge_auto use perf_mod , only : t_startf, t_stopf diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index ffa029b37..0858462bc 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -20,8 +20,7 @@ module med_phases_prep_ocn_mod use med_methods_mod , only : FB_copy => med_methods_FB_copy use med_methods_mod , only : FB_reset => med_methods_FB_reset use esmFlds , only : fldListTo - use esmFlds , only : compocn, compatm, compice - use esmFlds , only : coupling_mode + use med_internalstate_mod , only : compocn, compatm, compice, coupling_mode use perf_mod , only : t_startf, t_stopf implicit none @@ -45,7 +44,6 @@ 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 diff --git a/mediator/med_phases_prep_rof_mod.F90 b/mediator/med_phases_prep_rof_mod.F90 index f54da223b..e64eea43b 100644 --- a/mediator/med_phases_prep_rof_mod.F90 +++ b/mediator/med_phases_prep_rof_mod.F90 @@ -12,7 +12,7 @@ module med_phases_prep_rof_mod use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use ESMF , only : ESMF_FieldBundle, ESMF_Field - use esmFlds , only : ncomps, complnd, comprof, compname, mapconsf, mapconsd, mapfcopy + use med_internalstate_mod , only : complnd, comprof, mapconsf, mapconsd, mapfcopy use med_internalstate_mod , only : InternalState, mastertask, logunit use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_constants_mod , only : czero => med_constants_czero diff --git a/mediator/med_phases_prep_wav_mod.F90 b/mediator/med_phases_prep_wav_mod.F90 index 8ff29e432..a1bd85c1b 100644 --- a/mediator/med_phases_prep_wav_mod.F90 +++ b/mediator/med_phases_prep_wav_mod.F90 @@ -5,20 +5,28 @@ module med_phases_prep_wav_mod !----------------------------------------------------------------------------- use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 - use med_constants_mod , only : dbug_flag => med_constants_dbug_flag + use med_constants_mod , only : czero =>med_constants_czero + use med_constants_mod , only : dbug_flag => med_constants_dbug_flag + use med_internalstate_mod , only : InternalState, mastertask, logunit + use med_merge_mod , only : med_merge_auto, med_merge_field + use med_map_mod , only : med_map_field_packed + use med_utils_mod , only : memcheck => med_memcheck use med_utils_mod , only : chkerr => med_utils_ChkErr use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose - use med_merge_mod , only : med_merge_auto - use med_map_mod , only : med_map_field_packed - use med_internalstate_mod , only : InternalState, mastertask - use esmFlds , only : compwav, ncomps, compname - use esmFlds , only : fldListFr, fldListTo + use med_methods_mod , only : FB_accum => med_methods_FB_accum + use med_methods_mod , only : FB_average => med_methods_FB_average + use med_methods_mod , only : FB_copy => med_methods_FB_copy + use med_methods_mod , only : FB_reset => med_methods_FB_reset + use esmFlds , only : fldListTo + use med_internalstate_mod , only : compwav use perf_mod , only : t_startf, t_stopf implicit none private - public :: med_phases_prep_wav + public :: med_phases_prep_wav_init ! called from med.F90 + public :: med_phases_prep_wav_accum ! called from run sequence + public :: med_phases_prep_wav_avg ! called from run sequence character(*), parameter :: u_FILE_u = & __FILE__ @@ -27,12 +35,45 @@ module med_phases_prep_wav_mod contains !----------------------------------------------------------------------------- - subroutine med_phases_prep_wav(gcomp, rc) + subroutine med_phases_prep_wav_init(gcomp, rc) + + use ESMF , only : ESMF_GridComp, ESMF_SUCCESS + use med_methods_mod , only : FB_Init => med_methods_FB_init + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(InternalState) :: is_local + character(len=*),parameter :: subname=' (med_phases_prep_wav_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 wave export accumulation FB for ' + end if + call FB_Init(is_local%wrap%FBExpAccumWav, is_local%wrap%flds_scalar_name, & + STgeom=is_local%wrap%NStateExp(compwav), STflds=is_local%wrap%NStateExp(compwav), & + name='FBExpAccumWav', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_reset(is_local%wrap%FBExpAccumWav, value=czero, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end subroutine med_phases_prep_wav_init + + !----------------------------------------------------------------------------- + subroutine med_phases_prep_wav_accum(gcomp, rc) + + use ESMF , only : ESMF_GridComp, ESMF_FieldBundleGet use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS - use ESMF , only : ESMF_GridComp, ESMF_Clock, ESMF_Time - use ESMF , only : ESMF_GridCompGet, ESMF_FieldBundleGet, ESMF_ClockGet, ESMF_TimeGet - use ESMF , only : ESMF_ClockPrint + use ESMF , only : ESMF_FAILURE, ESMF_LOGMSG_ERROR ! input/output variables type(ESMF_GridComp) :: gcomp @@ -40,85 +81,113 @@ subroutine med_phases_prep_wav(gcomp, rc) ! local variables type(InternalState) :: is_local - integer :: i,j,n,n1,ncnt - character(len=*),parameter :: subname='(med_phases_prep_wav)' + integer :: n, ncnt + character(len=*), parameter :: subname='(med_phases_prep_wav_accum)' !--------------------------------------- call t_startf('MED:'//subname) - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + if (dbug_flag > 20) then + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) end if rc = ESMF_SUCCESS + call memcheck(subname, 5, mastertask) + ! Get the internal state + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! auto merges to wav + call med_merge_auto(& + is_local%wrap%med_coupling_active(:,compwav), & + is_local%wrap%FBExp(compwav), & + is_local%wrap%FBFrac(compwav), & + is_local%wrap%FBImp(:,compwav), & + fldListTo(compwav), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! wave accumulator + call FB_accum(is_local%wrap%FBExpAccumWav, is_local%wrap%FBExp(compwav), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + is_local%wrap%ExpAccumWavCnt = is_local%wrap%ExpAccumWavCnt + 1 + + ! diagnose output + if (dbug_flag > 1) then + call FB_diagnose(is_local%wrap%FBExpAccumWav, string=trim(subname)//' FBExpAccumWav accumulation ', 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 + call t_stopf('MED:'//subname) + + end subroutine med_phases_prep_wav_accum + + !----------------------------------------------------------------------------- + subroutine med_phases_prep_wav_avg(gcomp, rc) + + ! Prepare the wav import Fields. + + use ESMF , only : ESMF_GridComp, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS + use ESMF , only : ESMF_FieldBundleGet + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(InternalState) :: is_local + integer :: ncnt + character(len=*),parameter :: subname='(med_phases_prep_wav_avg)' !--------------------------------------- - ! --- Get the internal state - !--------------------------------------- + rc = ESMF_SUCCESS + + call t_startf('MED:'//subname) + if (dbug_flag > 20) 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 ! Count the number of fields outside of scalar data, if zero, then return - ! Note - the scalar field has been removed from all mediator field bundles - so this is why we check if the - ! fieldCount is 0 and not 1 here - call ESMF_FieldBundleGet(is_local%wrap%FBExp(compwav), fieldCount=ncnt, rc=rc) + call ESMF_FieldBundleGet(is_local%wrap%FBExpAccumWav, fieldCount=ncnt, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + if (ncnt > 0) then - ! map to create FBimp(:,compwav) - do n1 = 1,ncomps - if (is_local%wrap%med_coupling_active(n1,compwav)) then - call med_map_field_packed( & - FBSrc=is_local%wrap%FBImp(n1,n1), & - FBDst=is_local%wrap%FBImp(n1,compwav), & - FBFracSrc=is_local%wrap%FBFrac(n1), & - field_normOne=is_local%wrap%field_normOne(n1,compwav,:), & - packed_data=is_local%wrap%packed_data(n1,compwav,:), & - routehandles=is_local%wrap%RH(n1,compwav,:), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - end do - - ! auto merges to create FBExp(compwav) - call med_merge_auto(& - is_local%wrap%med_coupling_active(:,compwav), & - is_local%wrap%FBExp(compwav), & - is_local%wrap%FBFrac(compwav), & - is_local%wrap%FBImp(:,compwav), & - fldListTo(compwav), rc=rc) + ! average wav accumulator + if (dbug_flag > 1) then + call FB_diagnose(is_local%wrap%FBExpAccumWav, & + string=trim(subname)//' FBExpAccumWav before avg ', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + call FB_average(is_local%wrap%FBExpAccumWav, is_local%wrap%ExpAccumWavCnt, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - !--------------------------------------- - !--- diagnose output - !--------------------------------------- - if (dbug_flag > 1) then - call FB_diagnose(is_local%wrap%FBExp(compwav), & - string=trim(subname)//' FBexp(compwav) ', rc=rc) + call FB_diagnose(is_local%wrap%FBExpAccumWav, & + string=trim(subname)//' FBExpAccumWav after avg ', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - !--------------------------------------- - !--- custom calculations - !--------------------------------------- - - !--------------------------------------- - !--- update local scalar data - !--------------------------------------- - - !is_local%wrap%scalar_data(1) = + ! copy to FBExp(compwav) + call FB_copy(is_local%wrap%FBExp(compwav), is_local%wrap%FBExpAccumWav, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - !--------------------------------------- - !--- clean up - !--------------------------------------- + ! zero accumulator + is_local%wrap%ExpAccumWavCnt = 0 + call FB_reset(is_local%wrap%FBExpAccumWav, value=czero, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - endif + end if - if (dbug_flag > 5) then + if (dbug_flag > 20) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end if call t_stopf('MED:'//subname) - end subroutine med_phases_prep_wav - + end subroutine med_phases_prep_wav_avg end module med_phases_prep_wav_mod diff --git a/mediator/med_phases_restart_mod.F90 b/mediator/med_phases_restart_mod.F90 index d87cfba80..5affb149a 100644 --- a/mediator/med_phases_restart_mod.F90 +++ b/mediator/med_phases_restart_mod.F90 @@ -8,7 +8,7 @@ module med_phases_restart_mod 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 med_internalstate_mod , only : ncomps, compname, compocn, complnd, compwav 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 @@ -381,6 +381,17 @@ subroutine med_phases_restart_write(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif + ! Write export accumulation to wav + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBExpAccumWav)) then + nx = is_local%wrap%nx(compwav) + ny = is_local%wrap%ny(compwav) + call med_io_write(restart_file, is_local%wrap%FBExpAccumWav, whead(m), wdata(m), nx, ny, & + nt=1, pre='wavExpAccum', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_io_write(restart_file, is_local%wrap%ExpAccumWavCnt, 'wavExpAccum_cnt', whead(m), wdata(m), 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) @@ -584,6 +595,12 @@ subroutine med_phases_restart_read(gcomp, rc) call med_io_read(restart_file, vm, is_local%wrap%ExpAccumOcnCnt, 'ocnExpAccum_cnt', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBExpAccumWav,rc=rc)) then + call med_io_read(restart_file, vm, is_local%wrap%FBExpAccumWav, pre='wavExpAccum', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_io_read(restart_file, vm, is_local%wrap%ExpAccumWavCnt, 'wavExpAccum_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)