diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index c33bf0e34..efec7ba88 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -95,6 +95,8 @@ jobs: cd ../components/cdeps git checkout main git submodule update --init + cd ../../share + git checkout main - name: Cache ESMF id: cache-esmf @@ -170,6 +172,6 @@ jobs: popd # the following can be used by developers to login to the github server in case of errors # see https://github.com/marketplace/actions/debugging-with-tmate for further details -# - name: Setup tmate session -# if: ${{ failure() }} -# uses: mxschmitt/action-tmate@v3 + - name: Setup tmate session + if: ${{ failure() }} + uses: mxschmitt/action-tmate@v3 diff --git a/cesm/driver/esm.F90 b/cesm/driver/esm.F90 index e2ed64891..d357e9753 100644 --- a/cesm/driver/esm.F90 +++ b/cesm/driver/esm.F90 @@ -877,6 +877,9 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) character(len=5) :: inst_suffix character(CL) :: cvalue logical :: found_comp +#ifdef ESMF_AWARE_THREADING + integer :: cnt +#endif integer :: rank, nprocs, ierr character(len=*), parameter :: subname = "(esm_pelayout.F90:esm_init_pelayout)" !--------------------------------------- diff --git a/cesm/nuopc_cap_share/seq_drydep_mod.F90 b/cesm/nuopc_cap_share/seq_drydep_mod.F90 index 780a6c611..3d6c292ee 100644 --- a/cesm/nuopc_cap_share/seq_drydep_mod.F90 +++ b/cesm/nuopc_cap_share/seq_drydep_mod.F90 @@ -1,8 +1,6 @@ module seq_drydep_mod use shr_drydep_mod, only: seq_drydep_setHCoeff=>shr_drydep_setHCoeff - use shr_drydep_mod - implicit none ! method specification diff --git a/cesm/nuopc_cap_share/shr_dust_emis_mod.F90 b/cesm/nuopc_cap_share/shr_dust_emis_mod.F90 new file mode 100644 index 000000000..f70024835 --- /dev/null +++ b/cesm/nuopc_cap_share/shr_dust_emis_mod.F90 @@ -0,0 +1,222 @@ +module shr_dust_emis_mod + + !======================================================================== + ! Module for handling dust emissions. + ! This module is shared by land and atmosphere models for the computation of + ! dust emissions. + !======================================================================== + + use shr_sys_mod , only : shr_sys_abort + use shr_kind_mod , only : CS => SHR_KIND_CS + use shr_nl_mod , only : shr_nl_find_group_name + use shr_log_mod , only : shr_log_getLogUnit, errMsg => shr_log_errMsg + + implicit none + private + + ! public member functions + public :: shr_dust_emis_readnl ! Read namelist + public :: is_dust_emis_zender ! If Zender_2003 dust emission method is being used + public :: is_dust_emis_leung ! If Leungr_2023 dust emission method is being used + public :: is_zender_soil_erod_from_land ! If Zender_2003 is being used and soil eroditability is in land + public :: is_zender_soil_erod_from_atm ! If Zender/_2003 is being used and soil eroditability is in atmosphere + + ! The following is only public for the sake of unit testing; it should not be called + ! directly outside this module + public :: dust_emis_set_options ! Set the namelist options directory not through the namelist + public :: is_NOT_initialized ! Check if dust emission has NOT been initialized + + ! private data members: + private :: check_options_finish_init ! Check that the options are correct and finish initialization + + ! PRIVATE DATA: + character(len=CS) :: dust_emis_method = 'Zender_2003' ! Dust emisison method to use: Zender_2003 or Leung_2023 + character(len=CS) :: zender_soil_erod_source = 'none' ! if calculated in lnd or atm (only when Zender_2003 is used) + logical :: dust_emis_initialized=.false. ! If dust emissions have been initiatlized yet or not + + character(len=*), parameter :: u_FILE_u = & + __FILE__ + +!=============================================================================== +CONTAINS +!=============================================================================== + + subroutine shr_dust_emis_readnl(mpicom, NLFilename) + + !======================================================================== + ! reads dust_emis_inparm namelist to determine how dust emissions will + ! be handled between the land and atmosphere models + !======================================================================== + use shr_mpi_mod, only : shr_mpi_bcast, shr_mpi_commrank + + character(len=*), intent(in) :: NLFilename ! Namelist filename + integer , intent(in) :: mpicom ! MPI communicator for broadcasting all all tasks + + !----- local ----- + integer :: unitn ! namelist unit number + integer :: ierr ! error code + logical :: exists ! if file exists or not + integer :: localPet ! Local processor rank + integer :: s_logunit ! Output log unit + character(*),parameter :: F00 = "('(shr_dust_emis_read) ',8a)" + character(*),parameter :: subName = '(shr_dust_emis_read) ' + !----------------------------------------------------------------------------- + + namelist /dust_emis_inparm/ dust_emis_method, zender_soil_erod_source + + !----------------------------------------------------------------------------- + ! Read namelist, check if namelist file exists first + !----------------------------------------------------------------------------- + + !--- Open and read namelist --- + if ( len_trim(NLFilename) == 0 )then + call shr_sys_abort( subName//'ERROR: nlfilename not set' ) + end if + + call shr_mpi_commrank( mpicom, localPet ) + + call shr_log_getLogUnit(s_logunit) + if (localPet==0) then + inquire( file=trim(NLFileName), exist=exists) + if ( exists ) then + open(newunit=unitn, file=trim(NLFilename), status='old' ) + write(s_logunit,F00) 'Read in dust_emis_inparm namelist from: ', trim(NLFilename) + call shr_nl_find_group_name(unitn, 'dust_emis_inparm', ierr) + if (ierr == 0) then + ! Note that ierr /= 0, no namelist is present. + read(unitn, dust_emis_inparm, iostat=ierr) + if (ierr > 0) then + call shr_sys_abort( subName//'ERROR:: problem on read of dust_emis_inparm ' & + // 'namelist in shr_dust_emis_readnl') + end if + endif + close( unitn ) + end if + end if + call shr_mpi_bcast(dust_emis_method, mpicom) + call shr_mpi_bcast(zender_soil_erod_source, mpicom) + + call check_options_finish_init() + + end subroutine shr_dust_emis_readnl + +!==================================================================================== + + subroutine check_options_finish_init() + ! Some error checking and mark initialization as finished + integer :: s_logunit ! Output log unit + character(*),parameter :: subName = '(check_options_finish_init) ' + + call shr_log_getLogUnit(s_logunit) + if (trim(dust_emis_method) == 'Leung_2023') then + if ( trim(zender_soil_erod_source) /= 'none' )then + write(s_logunit,*) 'ERROR: '//errMsg(u_FILE_u, __LINE__) + call shr_sys_abort(subName//"ERROR: zender_soil_erod_source should NOT be set, when dust_emis_method=Leung_2023" ) + return + end if + else if (trim(dust_emis_method) == 'Zender_2003') then + if ( (trim(zender_soil_erod_source) /= 'lnd') .and. (trim(zender_soil_erod_source) /= 'atm') )then + write(s_logunit,*) 'zender_soil_erod_source is NOT valid = ', trim(zender_soil_erod_source) + write(s_logunit,*) 'ERROR: '//errMsg(u_FILE_u, __LINE__) + call shr_sys_abort(subName//"ERROR: zender_soil_erod_source can only be lnd or atm" ) + return + end if + else + write(s_logunit,*) 'dust_emis_method not recognized = ', trim(dust_emis_method) + write(s_logunit,*) 'ERROR: '//errMsg(u_FILE_u, __LINE__) + call shr_sys_abort(subName//"ERROR: dust_emis_method namelist item is not valid" ) + return + end if + + dust_emis_initialized = .true. + + end subroutine check_options_finish_init + +!==================================================================================== + + logical function is_dust_emis_zender() + ! is_dust_emis_zender – Logical function, true if the Zender 2003 scheme is being used + if ( is_NOT_initialized() ) return + if (trim(dust_emis_method) == 'Zender_2003') then + is_dust_emis_zender = .true. + else + is_dust_emis_zender = .false. + end if + end function is_dust_emis_zender + +!=============================================================================== + + logical function is_dust_emis_leung() + ! is_dust_emis_leung – Logical function, true if the Leung 2023 scheme is being used + if ( is_NOT_initialized() ) return + if (trim(dust_emis_method) == 'Leung_2023') then + is_dust_emis_leung = .true. + else + is_dust_emis_leung = .false. + end if + end function is_dust_emis_leung + +!=============================================================================== + + logical function is_zender_soil_erod_from_land() + ! is_zender_soil_erod_from_land – Logical function, true if the Zender method is being used and soil erodibility is in CTSM + if ( is_NOT_initialized() ) return + if ( is_dust_emis_zender() )then + if (trim(zender_soil_erod_source) == 'lnd') then + is_zender_soil_erod_from_land = .true. + else + is_zender_soil_erod_from_land = .false. + end if + else + is_zender_soil_erod_from_land = .false. + end if + end function is_zender_soil_erod_from_land + +!=============================================================================== + + logical function is_zender_soil_erod_from_atm() + !is_zender_soil_erod_from_atm – Logical function, true if the Zender method is being used and soil erodibility is in CAM + if ( is_NOT_initialized() ) return + if ( is_dust_emis_zender() )then + if ( trim(zender_soil_erod_source) == 'atm') then + is_zender_soil_erod_from_atm = .true. + else + is_zender_soil_erod_from_atm = .false. + end if + else + is_zender_soil_erod_from_atm = .false. + end if + end function is_zender_soil_erod_from_atm + +!=============================================================================== + + logical function is_NOT_initialized() + ! Check if this is NOT initialized and return true if so (false if initialized) + ! Will abort with an error when using in the model + ! For unit testing will return the logical state + integer :: s_logunit ! Output log unit + + if ( dust_emis_initialized )then + is_NOT_initialized = .false. + return + else + is_NOT_initialized = .true. + call shr_log_getLogUnit(s_logunit) + write(s_logunit,*) 'ERROR: '//errMsg(u_FILE_u, __LINE__) + call shr_sys_abort( 'ERROR: dust emission namelist has NOT been read in yet,' // & + ' shr_dust_emis_mod is NOT initialized ' ) + end if + end function is_NOT_initialized + + subroutine dust_emis_set_options( dust_emis_method_in, zender_soil_erod_source_in) + character(len=*), intent(IN) :: dust_emis_method_in ! Dust emisison method to use: Zender_2003 or Leung_2023 + character(len=*), intent(IN) :: zender_soil_erod_source_in ! if calculed in lnd or atm (only when Zender_2003 is used) + + dust_emis_method = dust_emis_method_in + zender_soil_erod_source = zender_soil_erod_source_in + call check_options_finish_init() + end subroutine dust_emis_set_options + +!=============================================================================== + +end module shr_dust_emis_mod diff --git a/cime_config/buildnml b/cime_config/buildnml index 1d07ae55c..e02ca3071 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -50,8 +50,9 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): config["continue_run"] = ".true." if case.get_value("CONTINUE_RUN") else ".false." config["flux_epbal"] = "ocn" if case.get_value("CPL_EPBAL") == "ocn" else "off" config["mask_grid"] = case.get_value("MASK_GRID") - config["rest_option"] = case.get_value("REST_OPTION") - + for val in ("HIST", "REST", "STOP"): + config[val.lower()+"_option"] = case.get_value(val+"_OPTION") + config["comp_ocn"] = case.get_value("COMP_OCN") @@ -100,7 +101,7 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): else: config["single_column"] = "false" - # needed for determining the run sequence as well as glc_renormalize_smb + # needed for determining the run sequence config["COMP_ATM"] = case.get_value("COMP_ATM") config["COMP_ICE"] = case.get_value("COMP_ICE") config["COMP_GLC"] = case.get_value("COMP_GLC") @@ -189,6 +190,8 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): # determine coupling intervals comps = case.get_values("COMP_CLASSES") mindt = basedt + + coupling_times = {} for comp in comps: ncpl = case.get_value(comp.upper() + "_NCPL") @@ -201,6 +204,19 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): coupling_times[comp.lower() + "_cpl_dt"] = cpl_dt mindt = min(mindt, cpl_dt) + # Here we convert "nsteps" to "nseconds", this simplifies the fortran + + for val in ("REST", "HIST", "STOP"): + if case.get_value(val+"_OPTION") == "nsteps": + nsteps = case.get_value(val+"_N") + if val == "REST": + nmlgen.set_value("restart_n", value=mindt*nsteps) + elif val == "HIST": + nmlgen.set_value("history_n", value=mindt*nsteps) + else: + nmlgen.set_value("stop_n", value=mindt*nsteps) + + # sanity check comp_atm = case.get_value("COMP_ATM") if comp_atm is not None and comp_atm not in ("datm", "xatm", "satm"): diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index 2aa3c4ed4..63e1b09a8 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -1986,15 +1986,15 @@ https://www.unidata.ucar.edu/software/netcdf/docs/data_type.html - 64bit_offset - 64bit_offset - 64bit_offset - 64bit_offset - 64bit_offset - 64bit_offset - 64bit_offset - 64bit_offset - 64bit_offset + 64bit_data + 64bit_data + 64bit_data + 64bit_data + 64bit_data + 64bit_data + 64bit_data + 64bit_data + 64bit_data @@ -2412,6 +2412,19 @@ + + + + + + char + + case_git + env_build.xml + Remote git repository used for this case + + + diff --git a/cime_config/config_component_cesm.xml b/cime_config/config_component_cesm.xml index a19814827..b801f156e 100644 --- a/cime_config/config_component_cesm.xml +++ b/cime_config/config_component_cesm.xml @@ -109,8 +109,8 @@ none CO2A CO2A - CO2A - CO2A + CO2A + CO2A CO2A CO2A CO2C @@ -141,6 +141,54 @@ + + logical + FALSE + TRUE,FALSE + run_coupling + env_run.xml + + Activates DMS fluxes to be sent from ocn to atm. + Currently this is only available with BLOM ocean component. + + + + + logical + FALSE + TRUE,FALSE + run_coupling + env_run.xml + + Activates Bromoform fluxes to be sent from ocn to atm. + Currently this is only available with BLOM ocean component. + + + + + logical + FALSE + TRUE,FALSE + run_coupling + env_run.xml + + Activates N2O fluxes to be sent from ocn to atm. + Currently this is only available with BLOM ocean component. + + + + + logical + FALSE + TRUE,FALSE + run_coupling + env_run.xml + + Activates NH3 fluxes to be sent from ocn to atm. + Currently this is only available with BLOM ocean component. + + + char @@ -188,16 +236,14 @@ - 24 24 - - + 24 + - 24 - 144 24 + 24 24 @@ -205,6 +251,7 @@ 24 48 48 + 48 @@ -279,11 +326,7 @@ $ATM_NCPL 24 - 1 - 24 - 24 - 48 - 48 + 24 1 24 @@ -303,6 +346,7 @@ $ATM_NCPL $ATM_NCPL 1 + 1 run_coupling env_run.xml @@ -334,13 +378,14 @@ integer 8 - 1 $ATM_NCPL + $ATM_NCPL $ATM_NCPL $ATM_NCPL 1 8 8 + 8 $ATM_NCPL 1 $ATM_NCPL @@ -372,13 +417,14 @@ TRUE TRUE + TRUE TRUE FALSE run_component_cpl env_run.xml - Only used for compsets with DATM and POP (currently C, G and J): + Only used for compsets with DATM and [POP or MOM] (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 @@ -419,14 +465,12 @@ TIGHT,OPTION1,OPTION2 TIGHT - OPTION2 - OPTION2 - OPTION1 - OPTION1 - OPTION1 + OPTION2 + OPTION1 + OPTION1 OPTION2 - OPTION2 - OPTION2 + OPTION2 + OPTION2 run_coupling env_run.xml @@ -481,8 +525,10 @@ FALSE TRUE - TRUE + TRUE + TRUE TRUE + TRUE TRUE TRUE @@ -497,8 +543,7 @@ 284.7 367.0 - 284.317 - 284.7 + 284.317 run_co2 env_run.xml diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index f102da092..4482506cb 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -844,35 +844,51 @@ char control MED_attributes - on,off,on_if_glc_coupled_fluxes + on,off Whether to renormalize the surface mass balance (smb) sent from lnd to glc so that the global integral on the glc grid agrees with the global integral on the lnd grid. - Unlike most fluxes, smb is remapped with bilinear rather than conservative mapping weights, - so this option is needed for conservation. However, conservation is not required in many - cases, since we often run glc as a diagnostic (one-way-coupled) component. + Unlike most fluxes, smb is remapped with bilinear rather than conservative mapping + weights, so this option is needed for conservation. However, this can be turned off + in non-fully-coupled configurations where conservation isn't important (e.g., + glc-only configurations - T compsets) to avoid the global correction that comes with + this renormalization. Allowable values are: - 'on': always do this renormalization - 'off': never do this renormalization (see WARNING below) - 'on_if_glc_coupled_fluxes': Determine at runtime whether to do this renormalization. - Does the renormalization if we're running a two-way-coupled glc that sends fluxes - to other components (which is the case where we need conservation). - Does NOT do the renormalization if we're running a one-way-coupled glc, or if - we're running a glc-only compset (T compsets). - (In these cases, conservation is not important.) + 'on': do this renormalization + 'off': do not do this renormalization; note that this will break conservation so + typically should not be used in fully-coupled cases - Only used if running with a prognostic GLC component. - - WARNING: Setting this to 'off' will break conservation when running with an - evolving, two-way-coupled glc. + Only used if running with a GLC component. - on_if_glc_coupled_fluxes + on off + + logical + control + MED_attributes + + If true, remove negative runoff generated from the land component by downweighting all positive runoff globally. + + + .true. + + + + logical + control + MED_attributes + + If true, remove negative runoff generated from the glc (ice sheet) component by downweighting all positive runoff globally. + + + .false. + + integer @@ -1102,13 +1118,12 @@ char time ALLCOMP_attributes - none,never,nsteps,nseconds,nminutes,nhours,ndays,nmonths,nyears,monthly,yearly,date,end + none,never,nseconds,nminutes,nhours,ndays,nmonths,nyears,monthly,yearly,date,end mediator history snapshot option (used with history_n and history_ymd) set by HIST_OPTION in env_run.xml. history_option alarms are: [none/never], turns option off - [nsteps] , history snapshot every history_n nsteps , relative to current run start time [nseconds] , history snapshot every history_n nseconds, relative to current run start time [nminutes] , history snapshot every history_n nminutes, relative to current run start time [nhours] , history snapshot every history_n nhours , relative to current run start time @@ -1121,6 +1136,7 @@ $HIST_OPTION + nseconds @@ -2405,6 +2421,54 @@ + + logical + flds + ALLCOMP_attributes + + Pass DMS from OCN to ATM component + + + .false. + + + + + logical + flds + ALLCOMP_attributes + + Pass Bromoform from OCN to ATM component + + + .false. + + + + + logical + flds + ALLCOMP_attributes + + Pass N2O from OCN to ATM component + + + .false. + + + + + logical + flds + ALLCOMP_attributes + + Pass NH3 from OCN to ATM component + + + .false. + + + logical seq_flds @@ -2657,12 +2721,11 @@ char time CLOCK_attributes - none,never,nsteps,nseconds,nminutes,nhours,ndays,monthly,nmonths,nyears,date,end + none,never,nseconds,nminutes,nhours,ndays,monthly,nmonths,nyears,date,end sets the run length with stop_n and stop_ymd stop_option alarms are: [none/never] , turns option off - [nsteps] , stops every stop_n nsteps , relative to current run start time [nseconds] , stops every stop_n nseconds, relative to current run start time [nminutes] , stops every stop_n nminutes, relative to current run start time [nhours] , stops every stop_n nhours , relative to current run start time @@ -2676,6 +2739,7 @@ $STOP_OPTION + nseconds @@ -2721,12 +2785,11 @@ char time CLOCK_attributes - none,never,nsteps,nseconds,nminutes,nhours,ndays,nmonths,nyears,monthly,yearly,date,end + none,never,nseconds,nminutes,nhours,ndays,nmonths,nyears,monthly,yearly,date,end sets the restart frequency with restart_n and restart_ymd restart_option alarms are: [none/never], turns option off - [nsteps] , restarts every restart_n nsteps , relative to current run start time [nseconds] , restarts every restart_n nseconds, relative to current run start time [nminutes] , restarts every restart_n nminutes, relative to current run start time [nhours] , restarts every restart_n nhours , relative to current run start time @@ -2740,6 +2803,7 @@ $REST_OPTION + nseconds diff --git a/cime_config/namelist_definition_drv_flds.xml b/cime_config/namelist_definition_drv_flds.xml index 03b6b7c6d..4d4ab1ec3 100644 --- a/cime_config/namelist_definition_drv_flds.xml +++ b/cime_config/namelist_definition_drv_flds.xml @@ -141,6 +141,33 @@ + + + + + + char*80 + dust_emissions + dust_emis_inparm + Zender_2003,Leung_2023 + + Which dust emission method is going to be used. Either the Zender 2003 scheme or the Leung 2023 + scheme. + + + + + char*80 + dust_emissions + dust_emis_inparm + none,lnd,atm + + Option only applying for the Zender_2003 method for whether the soil erodibility file is handled + in the active LAND model or in the ATM model. + (only used when dust_emis_method is Zender_2003) + + + diff --git a/doc/source/addendum/req_attributes_cesm.rst b/doc/source/addendum/req_attributes_cesm.rst index c8d6ff7fa..475b845f7 100644 --- a/doc/source/addendum/req_attributes_cesm.rst +++ b/doc/source/addendum/req_attributes_cesm.rst @@ -101,24 +101,19 @@ Mediator land-ice component attribtes Whether to renormalize the surface mass balance (smb) sent from lnd to glc so that the global integral on the glc grid agrees with the global integral on the lnd grid. - Unlike most fluxes, smb is remapped with bilinear rather than conservative mapping weights, - so this option is needed for conservation. However, conservation is not required in many - cases, since we often run glc as a diagnostic (one-way-coupled) component. + Unlike most fluxes, smb is remapped with bilinear rather than conservative mapping + weights, so this option is needed for conservation. However, this can be turned off in + non-fully-coupled configurations where conservation isn't important (e.g., glc-only + configurations - T compsets) to avoid the global correction that comes with this + renormalization. Allowable values are: - ``on``: always do this renormalization - - ``off``: never do this renormalization (see WARNING below) - - ``on_if_glc_coupled_fluxes``: Determine at runtime whether to do this renormalization. - Does the renormalization if we're running a two-way-coupled glc that sends fluxes - to other components (which is the case where we need conservation). - Does NOT do the renormalization if we're running a one-way-coupled glc, or if - we're running a glc-only compset (T compsets). - (In these cases, conservation is not important.) - Only used if running with a prognostic GLC component. - WARNING: Setting this to 'off' will break conservation when running with an - evolving, two-way-coupled glc. + ``on``: do this renormalization + + ``off``: do not do this renormalization; note that this will break conservation so + typically should not be used in fully-coupled cases + + Only used if running with a GLC component. **glc_avg_period** Period at which coupler averages fields sent to GLC (the land-ice component). diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 86f513d7a..71219057e 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -59,7 +59,10 @@ module esmFldsExchange_cesm_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, maintask + use med_internalstate_mod , only : logunit, maintask, samegrid_atmlnd + use med_internalstate_mod , only : mrg_fracname_lnd2atm_state, mrg_fracname_lnd2atm_flux, map_fracname_lnd2atm + use med_internalstate_mod , only : mrg_fracname_lnd2rof, map_fracname_lnd2rof + use med_internalstate_mod , only : mrg_fracname_lnd2glc, map_fracname_lnd2glc implicit none public @@ -231,6 +234,12 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! write diagnostic output if (maintask) then + write(logunit,'(a)' ) ' flds_co2a: prognostic and diagnostic CO2 at lowest atm level is sent to lnd and ocn' + write(logunit,'(a)' ) ' flds_co2b: prognostic and diagnostic CO2 at lowest atm level is sent to lnd and ocn' + write(logunit,'(a)' ) ' and surface flux of CO2 from lnd is sent back to atm' + write(logunit,'(a)' ) ' flds_co2c: prognostic and diagnostic CO2 at lowest atm level is sent to lnd and ocn' + write(logunit,'(a)' ) ' and surface flux of CO2 from lnd is sent back to atm' + write(logunit,'(a)' ) ' and surface flux of CO2 from ocn is sent back to atm' 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 @@ -474,6 +483,32 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if ! --------------------------------------------------------------------- + ! to lnd: prognostic CO2 at the lowest atm model level + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld_from(compatm, 'Sa_co2prog') + call addfld_to(complnd, 'Sa_co2prog') + else + if ( fldchk(is_local%wrap%FBexp(complnd) , 'Sa_co2prog', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_co2prog', rc=rc)) then + call addmap_from(compatm, 'Sa_co2prog', complnd, mapbilnr, 'one', atm2lnd_map) + call addmrg_to(complnd, 'Sa_co2prog', mrg_from=compatm, mrg_fld='Sa_co2prog', mrg_type='copy') + end if + end if + ! --------------------------------------------------------------------- + ! to lnd: diagnostic CO2 at the lowest atm model level + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld_from(compatm, 'Sa_co2diag') + call addfld_to(complnd, 'Sa_co2diag') + else + if ( fldchk(is_local%wrap%FBexp(complnd) , 'Sa_co2diag', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_co2diag', rc=rc)) then + call addmap_from(compatm, 'Sa_co2diag', complnd, mapbilnr, 'one', atm2lnd_map) + call addmrg_to(complnd, 'Sa_co2diag', mrg_from=compatm, mrg_fld='Sa_co2diag', mrg_type='copy') + end if + end if + ! --------------------------------------------------------------------- ! to lnd: convective and large scale precipitation rate water equivalent from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then @@ -814,9 +849,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! Note that for aqua-plant there will be no import from complnd or compice - and the ! current logic below takes care of this. if (fldchk(is_local%wrap%FBImp(complnd,complnd), 'Sl_avsdr', rc=rc)) then - call addmap_from(complnd, 'Sl_avsdr', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmap_from(complnd, 'Sl_avsdr', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm, 'Sx_avsdr', & - mrg_from=complnd, mrg_fld='Sl_avsdr', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Sl_avsdr', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_state) end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Si_avsdr', rc=rc)) then call addmap_from(compice, 'Si_avsdr', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -841,9 +876,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! Note that for aqua-plant there will be no import from complnd or compice - and the ! current logic below takes care of this. if (fldchk(is_local%wrap%FBImp(complnd,complnd), 'Sl_avsdf', rc=rc)) then - call addmap_from(complnd, 'Sl_avsdf', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmap_from(complnd, 'Sl_avsdf', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm, 'Sx_avsdf', & - mrg_from=complnd, mrg_fld='Sl_avsdf', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Sl_avsdf', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_state) end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Si_avsdf', rc=rc)) then call addmap_from(compice, 'Si_avsdf', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -868,9 +903,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! Note that for aqua-plant there will be no import from complnd or compice - and the ! current logic below takes care of this. if (fldchk(is_local%wrap%FBImp(complnd,complnd), 'Sl_anidr', rc=rc)) then - call addmap_from(complnd, 'Sl_anidr', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmap_from(complnd, 'Sl_anidr', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm, 'Sx_anidr', & - mrg_from=complnd, mrg_fld='Sl_anidr', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Sl_anidr', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_state) end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Si_anidr', rc=rc)) then call addmap_from(compice, 'Si_anidr', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -895,9 +930,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! Note that for aqua-plant there will be no import from complnd or compice - and the ! current logic below takes care of this. if (fldchk(is_local%wrap%FBImp(complnd,complnd), 'Sl_anidf', rc=rc)) then - call addmap_from(complnd, 'Sl_anidf', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmap_from(complnd, 'Sl_anidf', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm, 'Sx_anidf', & - mrg_from=complnd, mrg_fld='Sl_anidf', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Sl_anidf', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_state) end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Si_anidf', rc=rc)) then call addmap_from(compice, 'Si_anidf', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -927,9 +962,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_tref', rc=rc)) then if (fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_tref', rc=rc)) then - call addmap_from(complnd , 'Sl_tref', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmap_from(complnd , 'Sl_tref', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm , 'Sx_tref', & - mrg_from=complnd, mrg_fld='Sl_tref', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Sl_tref', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_state) end if if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_tref', rc=rc)) then call addmap_from(compice , 'Si_tref', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -954,9 +989,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_u10', rc=rc)) then if (fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_u10', rc=rc)) then - call addmap_from(complnd , 'Sl_u10', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmap_from(complnd , 'Sl_u10', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm , 'Sx_u10', & - mrg_from=complnd, mrg_fld='Sl_u10', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Sl_u10', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_state) end if if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_u10', rc=rc)) then call addmap_from(compice , 'Si_u10', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -981,9 +1016,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_qref', rc=rc)) then if (fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_qref', rc=rc)) then - call addmap_from(complnd , 'Sl_qref', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmap_from(complnd , 'Sl_qref', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm , 'Sx_qref', & - mrg_from=complnd, mrg_fld='Sl_qref', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Sl_qref', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_state) end if if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_qref', rc=rc)) then call addmap_from(compice , 'Si_qref', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -1009,9 +1044,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_qref_wiso', rc=rc)) then if (fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_qref_wiso', rc=rc)) then - call addmap_from(complnd , 'Sl_qref_wiso', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmap_from(complnd , 'Sl_qref_wiso', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm , 'Sx_qref_wiso', & - mrg_from=complnd, mrg_fld='Sl_qref_wiso', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Sl_qref_wiso', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_state) end if if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_qref_wiso', rc=rc)) then call addmap_from(compice , 'Si_qref_wiso', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -1043,9 +1078,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_tref', rc=rc)) then if (fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_tref', rc=rc)) then - call addmap_from(complnd , 'Sl_tref', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmap_from(complnd , 'Sl_tref', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm , 'Sx_tref', & - mrg_from=complnd, mrg_fld='Sl_tref', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Sl_tref', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_state) end if if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_tref', rc=rc)) then call addmap_from(compice , 'Si_tref', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -1070,9 +1105,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_u10', rc=rc)) then if (fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_u10', rc=rc)) then - call addmap_from(complnd , 'Sl_u10', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmap_from(complnd , 'Sl_u10', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm , 'Sx_u10', & - mrg_from=complnd, mrg_fld='Sl_u10', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Sl_u10', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_state) end if if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_u10', rc=rc)) then call addmap_from(compice , 'Si_u10', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -1097,9 +1132,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_qref', rc=rc)) then if (fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_qref', rc=rc)) then - call addmap_from(complnd , 'Sl_qref', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmap_from(complnd , 'Sl_qref', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm , 'Sx_qref', & - mrg_from=complnd, mrg_fld='Sl_qref', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Sl_qref', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_state) end if if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_qref', rc=rc)) then call addmap_from(compice , 'Si_qref', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -1125,9 +1160,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_qref_wiso', rc=rc)) then if (fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_qref_wiso', rc=rc)) then - call addmap_from(complnd , 'Sl_qref_wiso', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmap_from(complnd , 'Sl_qref_wiso', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm , 'Sx_qref_wiso', & - mrg_from=complnd, mrg_fld='Sl_qref_wiso', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Sl_qref_wiso', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_state) end if if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_qref_wiso', rc=rc)) then call addmap_from(compice , 'Si_qref_wiso', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -1161,9 +1196,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_taux', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_taux', rc=rc)) then - call addmap_from(complnd , 'Fall_taux', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmap_from(complnd , 'Fall_taux', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm , 'Faxx_taux', & - mrg_from=complnd, mrg_fld='Fall_taux', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Fall_taux', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_flux) end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_taux', rc=rc)) then call addmap_from(compice , 'Faii_taux', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -1188,9 +1223,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_tauy', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_tauy', rc=rc)) then - call addmap_from(complnd , 'Fall_tauy', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmap_from(complnd , 'Fall_tauy', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm , 'Faxx_tauy', & - mrg_from=complnd, mrg_fld='Fall_tauy', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Fall_tauy', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_flux) end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_tauy', rc=rc)) then call addmap_from(compice , 'Faii_tauy', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -1215,9 +1250,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_lat', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_lat', rc=rc)) then - call addmap_from(complnd , 'Fall_lat', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmap_from(complnd , 'Fall_lat', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm , 'Faxx_lat', & - mrg_from=complnd, mrg_fld='Fall_lat', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Fall_lat', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_flux) end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_lat', rc=rc)) then call addmap_from(compice , 'Faii_lat', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -1242,9 +1277,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_sen', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_sen', rc=rc)) then - call addmap_from(complnd , 'Fall_sen', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmap_from(complnd , 'Fall_sen', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm , 'Faxx_sen', & - mrg_from=complnd, mrg_fld='Fall_sen', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Fall_sen', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_flux) end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_sen', rc=rc)) then call addmap_from(compice , 'Faii_sen', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -1269,9 +1304,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_evap', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_evap', rc=rc)) then - call addmap_from(complnd , 'Fall_evap', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmap_from(complnd , 'Fall_evap', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm , 'Faxx_evap', & - mrg_from=complnd, mrg_fld='Fall_evap', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Fall_evap', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_flux) end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_evap', rc=rc)) then call addmap_from(compice , 'Faii_evap', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -1296,9 +1331,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_lwup', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_lwup', rc=rc)) then - call addmap_from(complnd , 'Fall_lwup', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmap_from(complnd , 'Fall_lwup', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm , 'Faxx_lwup', & - mrg_from=complnd, mrg_fld='Fall_lwup', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Fall_lwup', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_flux) end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_lwup', rc=rc)) then call addmap_from(compice , 'Faii_lwup', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -1324,9 +1359,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_evap_wiso', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_evap_wiso', rc=rc)) then - call addmap_from(complnd , 'Fall_evap_wiso', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmap_from(complnd , 'Fall_evap_wiso', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm , 'Faxx_evap_wiso', & - mrg_from=complnd, mrg_fld='Fall_evap_wiso', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Fall_evap_wiso', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_flux) end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_evap_wiso', rc=rc)) then call addmap_from(compice , 'Faii_evap_wiso', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -1356,9 +1391,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if (fldchk(is_local%wrap%FBexp(compatm), 'Sx_t', rc=rc)) then if (fldchk(is_local%wrap%FBImp(complnd,complnd), 'Sl_t', rc=rc)) then - call addmap_from(complnd, 'Sl_t', compatm, mapconsf , 'lfrin', lnd2atm_map) + call addmap_from(complnd, 'Sl_t', compatm, mapconsf , map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm, 'Sx_t', & - mrg_from=complnd, mrg_fld='Sl_t', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Sl_t', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_state) end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Si_t', rc=rc)) then call addmap_from(compice, 'Si_t', compatm, mapconsf , 'ifrac', ice2atm_map) @@ -1427,7 +1462,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if - ! --------------------------------------------------------------------- ! to atm: surface snow depth from ice (needed for cam) ! to atm: mean ice volume per unit area from ice @@ -1517,7 +1551,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBexp(compatm) , 'Sl_fv', rc=rc) .and. & fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_fv', rc=rc)) then - call addmap_from(complnd, 'Sl_fv', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmap_from(complnd, 'Sl_fv', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm, 'Sl_fv', mrg_from=complnd, mrg_fld='Sl_fv', mrg_type='copy') end if end if @@ -1527,7 +1561,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBexp(compatm) , 'Sl_ram1', rc=rc) .and. & fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_ram1', rc=rc)) then - call addmap_from(complnd, 'Sl_ram1', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmap_from(complnd, 'Sl_ram1', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm, 'Sl_ram1', mrg_from=complnd, mrg_fld='Sl_ram1', mrg_type='copy') end if end if @@ -1537,12 +1571,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBexp(compatm) , 'Sl_snowh', rc=rc) .and. & fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_snowh', rc=rc)) then - call addmap_from(complnd, 'Sl_snowh', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmap_from(complnd, 'Sl_snowh', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm, 'Sl_snowh', mrg_from=complnd, mrg_fld='Sl_snowh', mrg_type='copy') end if end if + ! --------------------------------------------------------------------- - ! CARMA fields (volumetric soil water) + ! to atm: CARMA fields (volumetric soil water) from land !----------------------------------------------------------------------------- if (phase == 'advertise') then call addfld_from(complnd, 'Sl_soilw') @@ -1550,10 +1585,11 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBexp(compatm) , 'Sl_soilw', rc=rc) .and. & fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_soilw', rc=rc)) then - call addmap_from(complnd, 'Sl_soilw', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmap_from(complnd, 'Sl_soilw', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm, 'Sl_soilw', mrg_from=complnd, mrg_fld='Sl_soilw', mrg_type='copy') end if end if + ! --------------------------------------------------------------------- ! to atm: dust fluxes from land (4 sizes) ! --------------------------------------------------------------------- @@ -1563,11 +1599,12 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Fall_flxdst', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compatm) , 'Fall_flxdst', rc=rc)) then - call addmap_from(complnd, 'Fall_flxdst', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmap_from(complnd, 'Fall_flxdst', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm, 'Fall_flxdst', & - mrg_from=complnd, mrg_fld='Fall_flxdst', mrg_type='copy_with_weights', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Fall_flxdst', mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd2atm_flux) end if end if + !----------------------------------------------------------------------------- ! to atm: MEGAN emissions fluxes from land !----------------------------------------------------------------------------- @@ -1577,11 +1614,12 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Fall_voc', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compatm) , 'Fall_voc', rc=rc)) then - call addmap_from(complnd, 'Fall_voc', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmap_from(complnd, 'Fall_voc', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm, 'Fall_voc', & - mrg_from=complnd, mrg_fld='Fall_voc', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Fall_voc', mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd2atm_flux) end if end if + !----------------------------------------------------------------------------- ! to atm: fire emissions fluxes from land !----------------------------------------------------------------------------- @@ -1594,7 +1632,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) fldchk(is_local%wrap%FBExp(compatm) , 'Fall_fire', rc=rc)) then call addmap_from(complnd, 'Fall_fire', compatm, mapconsf, 'lfrin', lnd2atm_map) call addmrg_to(compatm, 'Fall_fire', & - mrg_from=complnd, mrg_fld='Fall_fire', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Fall_fire', mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd2atm_flux) end if end if ! 'wild fire plume height' @@ -1604,10 +1642,12 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Sl_fztop', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compatm) , 'Sl_fztop', rc=rc)) then - call addmap_from(complnd, 'Sl_fztop', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrg_to(compatm, 'Sl_fztop', mrg_from=complnd, mrg_fld='Sl_fztop', mrg_type='copy') + call addmap_from(complnd, 'Sl_fztop', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) + call addmrg_to(compatm, 'Sl_fztop', & + mrg_from=complnd, mrg_fld='Sl_fztop', mrg_type='copy') end if end if + !----------------------------------------------------------------------------- ! to atm: dry deposition velocities from land !----------------------------------------------------------------------------- @@ -1617,25 +1657,93 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Sl_ddvel', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compatm) , 'Sl_ddvel', rc=rc)) then - call addmap_from(complnd, 'Sl_ddvel', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmap_from(complnd, 'Sl_ddvel', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm, 'Sl_ddvel', mrg_from=complnd, mrg_fld='Sl_ddvel', mrg_type='copy') end if end if + ! --------------------------------------------------------------------- + ! to atm: surface flux of CO2 from land + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld_from(complnd, 'Fall_fco2_lnd') + call addfld_to(compatm, 'Fall_fco2_lnd') + else + if ( fldchk(is_local%wrap%FBImp(compocn,compocn), 'Faoo_co2_lnd', rc=rc) .and. & + fldchk(is_local%wrap%FBexp(compatm) , 'Faoo_co2_lnd', rc=rc)) then + call addmap_from(complnd, 'Fall_fco2_lnd', compatm, mapconsf, 'one', lnd2atm_map) + call addmrg_to(compatm, 'Fall_fco2_lnd', & + mrg_from=complnd, mrg_fld='Fall_fco2_lnd', mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd2atm_flux) + end if + end if + + ! --------------------------------------------------------------------- + ! to atm: surface flux of CO2 from ocn + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld_from(compocn, 'Faoo_fco2_ocn') + call addfld_to(compatm, 'Faoo_fco2_ocn') + else + if ( fldchk(is_local%wrap%FBImp(compocn,compocn), 'Faoo_fco2_ocn', rc=rc) .and. & + fldchk(is_local%wrap%FBexp(compatm) , 'Faoo_fco2_ocn', rc=rc)) then + call addmap_from(compocn, 'Faoo_fco2_ocn', compatm, mapconsd, 'one', ocn2atm_map) + ! custom merge in med_phases_prep_atm + end if + end if + !----------------------------------------------------------------------------- - ! to atm: dms from ocean + ! to atm: surface flux of dms from ocean !----------------------------------------------------------------------------- if (phase == 'advertise') then - call addfld_from(compocn, 'Faoo_dms_ocn') - call addfld_to(compatm, 'Faoo_dms_ocn') + call addfld_from(compocn, 'Faoo_fdms_ocn') + call addfld_to(compatm, 'Faoo_fdms_ocn') else - ! Note that Faoo_dmds should not be weighted by ifrac - since - ! it will be weighted by ifrac in the merge to the atm - if ( fldchk(is_local%wrap%FBImp(compocn,compocn), 'Faoo_dms_ocn', rc=rc) .and. & - fldchk(is_local%wrap%FBexp(compatm) , 'Faoo_dms_ocn', rc=rc)) then - call addmap_from(complnd, 'Faoo_dms_ocn', compocn, mapconsf, 'lfrac', ocn2atm_map) - call addmrg_to(compatm , 'Faoo_dms_ocn', & - mrg_from=compmed, mrg_fld='Faoo_dms_ocn', mrg_type='merge', mrg_fracname='ofrac') + if ( fldchk(is_local%wrap%FBImp(compocn,compocn), 'Faoo_fdms_ocn', rc=rc) .and. & + fldchk(is_local%wrap%FBexp(compatm) , 'Faoo_fdms_ocn', rc=rc)) then + call addmap_from(compocn, 'Faoo_fdms_ocn', compocn, mapconsd, 'one', ocn2atm_map) + ! custom merge in med_phases_prep_atm + end if + end if + + !----------------------------------------------------------------------------- + ! to atm: surface flux of bromoform from ocean + !----------------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld_from(compocn, 'Faoo_fbrf_ocn') + call addfld_to(compatm, 'Faoo_fbrf_ocn') + else + if ( fldchk(is_local%wrap%FBImp(compocn,compocn), 'Faoo_fbrf_ocn', rc=rc) .and. & + fldchk(is_local%wrap%FBexp(compatm) , 'Faoo_fbrf_ocn', rc=rc)) then + call addmap_from(compocn, 'Faoo_fbrf_ocn', compocn, mapconsd, 'one', ocn2atm_map) + ! custom merge in med_phases_prep_atm + end if + end if + + !----------------------------------------------------------------------------- + ! to atm: surface flux of n2o from ocean + !----------------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld_from(compocn, 'Faoo_fn2o_ocn') + call addfld_to(compatm, 'Faoo_fn2o_ocn') + else + if ( fldchk(is_local%wrap%FBImp(compocn,compocn), 'Faoo_fn2o_ocn', rc=rc) .and. & + fldchk(is_local%wrap%FBexp(compatm) , 'Faoo_fn2o_ocn', rc=rc)) then + call addmap_from(compocn, 'Faoo_fn2o_ocn', compocn, mapconsd, 'one', ocn2atm_map) + ! custom merge in med_phases_prep_atm + end if + end if + + !----------------------------------------------------------------------------- + ! to atm: surface flux of nh3 from ocean + !----------------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld_from(compocn, 'Faoo_fnh3_ocn') + call addfld_to(compatm, 'Faoo_fnh3_ocn') + else + if ( fldchk(is_local%wrap%FBImp(compocn,compocn), 'Faoo_fnh3_ocn', rc=rc) .and. & + fldchk(is_local%wrap%FBexp(compatm) , 'Faoo_fnh3_ocn', rc=rc)) then + call addmap_from(compocn, 'Faoo_fnh3_ocn', compocn, mapconsd, 'one', ocn2atm_map) + ! custom merge in med_phases_prep_atm end if end if @@ -1864,7 +1972,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addfld_from(compatm, 'Faxa_snowl') call addfld_to(compocn, 'Faxa_snow' ) else - ! TODO: why are we not merging Faxa_rain and Faxa_snow if they are sent from atm wiht ofrac + ! TODO: why are we not merging Faxa_rain and Faxa_snow if they are sent from atm with ofrac ! Note that the mediator atm/ocn flux calculation needs Faxa_rainc for the gustiness parameterization ! which by default is not actually used if ( fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainl', rc=rc) .and. & @@ -1996,6 +2104,32 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if + ! --------------------------------------------------------------------- + ! to ocn: prognostic CO2 at the lowest atm model level + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld_from(compatm, 'Sa_co2prog') + call addfld_to(compocn, 'Sa_co2prog') + else + if ( fldchk(is_local%wrap%FBImp(compatm, compatm), 'Sa_co2prog', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compocn) , 'Sa_co2prog', rc=rc)) then + call addmap_from(compatm, 'Sa_co2prog', compocn, mapbilnr, 'one', atm2ocn_map) + call addmrg_to(compocn, 'Sa_co2prog', mrg_from=compatm, mrg_fld='Sa_co2prog', mrg_type='copy') + end if + end if + ! --------------------------------------------------------------------- + ! to ocn: diagnostic CO2 at the lowest atm model level + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld_from(compatm, 'Sa_co2diag') + call addfld_to(compocn, 'Sa_co2diag') + else + if ( fldchk(is_local%wrap%FBImp(compatm, compatm), 'Sa_co2diag', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compocn) , 'Sa_co2diag', rc=rc)) then + call addmap_from(compatm, 'Sa_co2diag', compocn, mapbilnr, 'one', atm2ocn_map) + call addmrg_to(compocn, 'Sa_co2diag', mrg_from=compatm, mrg_fld='Sa_co2diag', mrg_type='copy') + end if + end if ! --------------------------------------------------------------------- ! to ocn: black carbon deposition fluxes from atm ! - hydrophylic black carbon dry deposition flux @@ -2068,6 +2202,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! --------------------------------------------------------------------- ! to ocn: enthalpy from atm rain, snow, evaporation ! to ocn: enthalpy from liquid and ice river runoff + ! to ocn: enthalpy from liquid and ice glacier runoff ! to ocn: enthalpy from ice melt ! --------------------------------------------------------------------- ! Note - do not need to add addmap or addmrg for the following since they @@ -2079,6 +2214,8 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addfld_to(compocn, 'Foxx_hcond') call addfld_to(compocn, 'Foxx_hrofl') call addfld_to(compocn, 'Foxx_hrofi') + call addfld_to(compocn, 'Foxx_hrofl_glc') + call addfld_to(compocn, 'Foxx_hrofi_glc') end if ! --------------------------------------------------------------------- @@ -2854,7 +2991,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBExp(compice) , 'Sw_elevation_spectrum', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav,compwav), 'Sw_elevation_spectrum', rc=rc)) then - call addmap_from(compwav, 'Sw_elevation_spectrum', compice, mapbilnr, 'one', 'unset') + call addmap_from(compwav, 'Sw_elevation_spectrum', compice, mapbilnr_nstod, 'one', wav2ocn_map) call addmrg_to(compice, 'Sw_elevation_spectrum', & mrg_from=compwav, mrg_fld='Sw_elevation_spectrum', mrg_type='copy') end if @@ -2882,16 +3019,14 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) !---------------------------------------------------------- ! to wav: ice thickness from ice !---------------------------------------------------------- - if (wav_coupling_to_cice) then - if (phase == 'advertise') then - call addfld_from(compice, 'Si_thick') - call addfld_to(compwav, 'Si_thick') - else - if (fldchk(is_local%wrap%FBexp(compwav) , 'Si_thick', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_thick', rc=rc)) then - call addmap_from(compice, 'Si_thick', compwav, mapbilnr, 'one', ice2wav_map) - call addmrg_to(compwav, 'Si_thick', mrg_from=compice, mrg_fld='Si_thick', mrg_type='copy') - end if + if (phase == 'advertise') then + call addfld_from(compice, 'Si_thick') + call addfld_to(compwav, 'Si_thick') + else + if ( fldchk(is_local%wrap%FBexp(compwav) , 'Si_thick', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_thick', rc=rc)) then + call addmap_from(compice, 'Si_thick', compwav, mapbilnr, 'one', ice2wav_map) + call addmrg_to(compwav, 'Si_thick', mrg_from=compice, mrg_fld='Si_thick', mrg_type='copy') end if end if !---------------------------------------------------------- @@ -3081,9 +3216,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_rofsur', rc=rc) .and. & fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_rofsur', rc=rc)) then - call addmap_from(complnd, 'Flrl_rofsur', comprof, mapconsf, 'lfrac', lnd2rof_map) + call addmap_from(complnd, 'Flrl_rofsur', comprof, mapconsf, map_fracname_lnd2rof, 'unset') call addmrg_to(comprof, 'Flrl_rofsur', & - mrg_from=complnd, mrg_fld='Flrl_rofsur', mrg_type='copy_with_weights', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Flrl_rofsur', mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd2rof) end if end if @@ -3096,9 +3231,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_rofi', rc=rc) .and. & fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_rofi', rc=rc)) then - call addmap_from(complnd, 'Flrl_rofi', comprof, mapconsf, 'lfrac', lnd2rof_map) + call addmap_from(complnd, 'Flrl_rofi', comprof, mapconsf, map_fracname_lnd2rof, 'unset') call addmrg_to(comprof, 'Flrl_rofi', & - mrg_from=complnd, mrg_fld='Flrl_rofi', mrg_type='copy_with_weights', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Flrl_rofi', mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd2rof) end if end if @@ -3111,9 +3246,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_rofgwl', rc=rc) .and. & fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_rofgwl', rc=rc)) then - call addmap_from(complnd, 'Flrl_rofgwl', comprof, mapconsf, 'lfrac', lnd2rof_map) + call addmap_from(complnd, 'Flrl_rofgwl', comprof, mapconsf, map_fracname_lnd2rof, 'unset') call addmrg_to(comprof, 'Flrl_rofgwl', & - mrg_from=complnd, mrg_fld='Flrl_rofgwl', mrg_type='copy_with_weights', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Flrl_rofgwl', mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd2rof) end if end if @@ -3126,9 +3261,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_rofsub', rc=rc) .and. & fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_rofsub', rc=rc)) then - call addmap_from(complnd, 'Flrl_rofsub', comprof, mapconsf, 'lfrac', lnd2rof_map) + call addmap_from(complnd, 'Flrl_rofsub', comprof, mapconsf, map_fracname_lnd2rof, 'unset') call addmrg_to(comprof, 'Flrl_rofsub', & - mrg_from=complnd, mrg_fld='Flrl_rofsub', mrg_type='copy_with_weights', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Flrl_rofsub', mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd2rof) end if end if @@ -3141,9 +3276,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_irrig', rc=rc) .and. & fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_irrig', rc=rc)) then - call addmap_from(complnd, 'Flrl_irrig', comprof, mapconsf, 'lfrac', lnd2rof_map) + call addmap_from(complnd, 'Flrl_irrig', comprof, mapconsf, map_fracname_lnd2rof, 'unset') call addmrg_to(comprof, 'Flrl_irrig', & - mrg_from=complnd, mrg_fld='Flrl_irrig', mrg_type='copy_with_weights', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Flrl_irrig', mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd2rof) end if end if @@ -3173,14 +3308,14 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! custom mapping, accumulation and merging will be done in prep_glc_mod.F90 do ns = 1,is_local%wrap%num_icesheets if ( fldchk(is_local%wrap%FBImp(complnd,complnd) , 'Flgl_qice_elev', rc=rc)) then - call addmap_from(complnd, 'Flgl_qice_elev', compglc(ns), mapbilnr, 'lfrac', 'unset') + call addmap_from(complnd, 'Flgl_qice_elev', compglc(ns), mapbilnr, map_fracname_lnd2glc, 'unset') end if if ( fldchk(is_local%wrap%FBImp(complnd,complnd) , 'Sl_tsrf_elev' , rc=rc)) then - call addmap_from(complnd, 'Sl_tsrf_elev', compglc(ns), mapbilnr, 'lfrac', 'unset') + call addmap_from(complnd, 'Sl_tsrf_elev', compglc(ns), mapbilnr, map_fracname_lnd2glc, 'unset') end if if ( fldchk(is_local%wrap%FBImp(complnd,complnd) , 'Sl_topo_elev' , rc=rc)) then - ! This is needed just for mappingn to glc - but is not sent as a field - call addmap_from(complnd, 'Sl_topo_elev', compglc(ns), mapbilnr, 'lfrac', 'unset') + ! This is needed just for mapping to glc - but is not sent as a field + call addmap_from(complnd, 'Sl_topo_elev', compglc(ns), mapbilnr, map_fracname_lnd2glc, 'unset') end if end do end if @@ -3188,7 +3323,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) !----------------------------- ! to glc: from ocn !----------------------------- - if (is_local%wrap%ocn2glc_coupling) then + if (ocn2glc_coupling) then if (phase == 'advertise') then call addfld_from(compocn, 'So_t_depth') call addfld_from(compocn, 'So_s_depth') @@ -3210,158 +3345,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if - !===================================================================== - ! CO2 EXCHANGE - !===================================================================== - - call NUOPC_CompAttributeGet(gcomp, name='flds_co2a', value=cvalue, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) flds_co2a - call ESMF_LogWrite('flds_co2a = '// trim(cvalue), ESMF_LOGMSG_INFO) - - call NUOPC_CompAttributeGet(gcomp, name='flds_co2b', value=cvalue, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) flds_co2b - call ESMF_LogWrite('flds_co2b = '// trim(cvalue), ESMF_LOGMSG_INFO) - - call NUOPC_CompAttributeGet(gcomp, name='flds_co2c', value=cvalue, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) flds_co2c - call ESMF_LogWrite('flds_co2c = '// trim(cvalue), ESMF_LOGMSG_INFO) - - if (flds_co2a) then - ! --------------------------------------------------------------------- - ! to lnd and ocn: prognostic CO2 at the lowest atm model level - ! --------------------------------------------------------------------- - if (phase == 'advertise') then - call addfld_from(compatm, 'Sa_co2prog') - call addfld_to(complnd, 'Sa_co2prog') - call addfld_to(compocn, 'Sa_co2prog') - else - call addmap_from(compatm, 'Sa_co2prog', complnd, mapbilnr, 'one', atm2lnd_map) - call addmap_from(compatm, 'Sa_co2prog', compocn, mapbilnr, 'one', atm2ocn_map) - - call addmrg_to(complnd, 'Sa_co2prog', & - mrg_from=compatm, mrg_fld='Sa_co2prog', mrg_type='copy') - call addmrg_to(compocn, 'Sa_co2prog', & - mrg_from=compatm, mrg_fld='Sa_co2prog', mrg_type='copy') - end if - - ! --------------------------------------------------------------------- - ! to lnd and ocn: diagnostic CO2 at the lowest atm model level - ! --------------------------------------------------------------------- - if (phase == 'advertise') then - call addfld_from(compatm, 'Sa_co2diag') - call addfld_to(complnd, 'Sa_co2diag') - call addfld_to(compocn, 'Sa_co2diag') - else - call addmap_from(compatm, 'Sa_co2diag', complnd, mapbilnr, 'one', atm2lnd_map) - call addmap_from(compatm, 'Sa_co2diag', compocn, mapbilnr, 'one', atm2ocn_map) - - call addmrg_to(complnd, 'Sa_co2diag', & - mrg_from=compatm, mrg_fld='Sa_co2diag', mrg_type='copy') - call addmrg_to(compocn, 'Sa_co2diag', & - mrg_from=compatm, mrg_fld='Sa_co2diag', mrg_type='copy') - end if - - else if (flds_co2b) then - - ! --------------------------------------------------------------------- - ! to lnd: prognostic CO2 at the lowest atm model level - ! --------------------------------------------------------------------- - if (phase == 'advertise') then - call addfld_from(compatm, 'Sa_co2prog') - call addfld_to(complnd, 'Sa_co2prog') - else - call addmap_from(compatm, 'Sa_co2prog', complnd, mapbilnr, 'one', atm2lnd_map) - call addmrg_to(complnd, 'Sa_co2prog', & - mrg_from=compatm, mrg_fld='Sa_co2prog', mrg_type='copy') - end if - - ! --------------------------------------------------------------------- - ! to lnd: diagnostic CO2 at the lowest atm model level - ! --------------------------------------------------------------------- - if (phase == 'advertise') then - call addfld_from(compatm, 'Sa_co2diag') - call addfld_to(complnd, 'Sa_co2diag') - else - call addmap_from(compatm, 'Sa_co2diag', complnd, mapbilnr, 'one', atm2lnd_map) - call addmrg_to(complnd, 'Sa_co2diag', & - mrg_from=compatm, mrg_fld='Sa_co2diag', mrg_type='copy') - end if - - ! --------------------------------------------------------------------- - ! to atm: surface flux of CO2 from land - ! --------------------------------------------------------------------- - if (phase == 'advertise') then - call addfld_from(complnd, 'Fall_fco2_lnd') - call addfld_to(compatm, 'Fall_fco2_lnd') - else - call addmap_from(complnd, 'Fall_fco2_lnd', compatm, mapconsf, 'one', lnd2atm_map) - call addmrg_to(compatm, 'Fall_fco2_lnd', & - mrg_from=complnd, mrg_fld='Fall_fco2_lnd', mrg_type='copy_with_weights', mrg_fracname='lfrac') - end if - - else if (flds_co2c) then - - ! --------------------------------------------------------------------- - ! to lnd and ocn: prognostic CO2 at the lowest atm model level - ! --------------------------------------------------------------------- - if (phase == 'advertise') then - call addfld_from(compatm, 'Sa_co2prog') - call addfld_to(complnd, 'Sa_co2prog') - call addfld_to(compocn, 'Sa_co2prog') - else - call addmap_from(compatm, 'Sa_co2prog', complnd, mapbilnr, 'one', atm2lnd_map) - call addmap_from(compatm, 'Sa_co2prog', compocn, mapbilnr, 'one', atm2ocn_map) - - call addmrg_to(complnd, 'Sa_co2prog', & - mrg_from=compatm, mrg_fld='Sa_co2prog', mrg_type='copy') - call addmrg_to(compocn, 'Sa_co2prog', & - mrg_from=compatm, mrg_fld='Sa_co2prog', mrg_type='copy') - end if - - ! --------------------------------------------------------------------- - ! to lnd and ocn: diagnostic CO2 at the lowest atm model level - ! --------------------------------------------------------------------- - if (phase == 'advertise') then - call addfld_from(compatm, 'Sa_co2diag') - call addfld_to(complnd, 'Sa_co2diag') - call addfld_to(compocn, 'Sa_co2diag') - else - call addmap_from(compatm, 'Sa_co2diag', complnd, mapbilnr, 'one', atm2lnd_map) - call addmap_from(compatm, 'Sa_co2diag', compocn, mapbilnr, 'one', atm2ocn_map) - - call addmrg_to(complnd, 'Sa_co2diag', & - mrg_from=compatm, mrg_fld='Sa_co2diag', mrg_type='copy') - call addmrg_to(compocn, 'Sa_co2diag', & - mrg_from=compatm, mrg_fld='Sa_co2diag', mrg_type='copy') - end if - - ! --------------------------------------------------------------------- - ! to atm: surface flux of CO2 from land - ! --------------------------------------------------------------------- - if (phase == 'advertise') then - call addfld_from(complnd, 'Fall_fco2_lnd') - call addfld_to(compatm, 'Fall_fco2_lnd') - else - call addmap_from(complnd, 'Fall_fco2_lnd', compatm, mapconsf, 'one', lnd2atm_map) - call addmrg_to(compatm, 'Fall_fco2_lnd', & - mrg_from=complnd, mrg_fld='Fall_fco2_lnd', mrg_type='copy_with_weights', mrg_fracname='lfrac') - end if - - ! --------------------------------------------------------------------- - ! to atm: surface flux of CO2 from ocn - ! --------------------------------------------------------------------- - if (phase == 'advertise') then - call addfld_from(compocn, 'Faoo_fco2_ocn') - call addfld_to(compatm, 'Faoo_fco2_ocn') - else - call addmap_from(compocn, 'Faoo_fco2_ocn', compatm, mapconsd, 'one', ocn2atm_map) - ! custom merge in med_phases_prep_atm - end if - endif - end subroutine esmFldsExchange_cesm end module esmFldsExchange_cesm_mod diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index 50200efa2..e41c61dff 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -857,12 +857,24 @@ # - standard_name: Faoo_fco2_ocn canonical_units: moles m-2 s-1 - description: ocn import to med + description: ocn import to med - surface flux of CO2 (downward positive) # - - standard_name: Faoo_dms_ocn + - standard_name: Faoo_fdms_ocn canonical_units: moles m-2 s-1 description: ocn import to med - surface flux of DMS (downward positive) # + - standard_name: Faoo_fbrf_ocn + canonical_units: moles m-2 s-1 + description: ocn import to med - surface flux of Bromoform (downward positive) + # + - standard_name: Faoo_fn2o_ocn + canonical_units: moles m-2 s-1 + description: ocn import to med - surface flux of N2O (downward positive) + # + - standard_name: Faoo_fnh3_ocn + canonical_units: moles m-2 s-1 + description: ocn import to med - surface flux of NH3 (downward positive) + # - standard_name: So_anidf canonical_units: 1 description: ocn import to med @@ -1011,6 +1023,16 @@ canonical_units: W m-2 description: med export to ocn heat content of ice runoff # + - standard_name: Foxx_hrofl_glc + alias: heat_content_rofl_glc + canonical_units: W m-2 + description: med export to ocn heat content of liquid glc runoff + # + - standard_name: Foxx_hrofi_glc + alias: heat_content_rofi_glc + canonical_units: W m-2 + description: med export to ocn heat content of ice glc runoff + # - standard_name: Foxx_evap alias: mean_evap_rate canonical_units: kg m-2 s-1 diff --git a/mediator/med.F90 b/mediator/med.F90 index ba1b1b0f6..98b985349 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -1621,7 +1621,7 @@ subroutine DataInitialize(gcomp, rc) use med_phases_post_lnd_mod , only : med_phases_post_lnd use med_phases_post_glc_mod , only : med_phases_post_glc use med_phases_post_ocn_mod , only : med_phases_post_ocn - use med_phases_post_rof_mod , only : med_phases_post_rof + use med_phases_post_rof_mod , only : med_phases_post_rof_init, med_phases_post_rof use med_phases_post_wav_mod , only : med_phases_post_wav use med_phases_ocnalb_mod , only : med_phases_ocnalb_run use med_phases_aofluxes_mod , only : med_phases_aofluxes_init_fldbuns @@ -1923,6 +1923,10 @@ subroutine DataInitialize(gcomp, rc) call med_phases_prep_rof_init(gcomp, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if + if (is_local%wrap%comp_present(comprof)) then + call med_phases_post_rof_init(gcomp, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if !--------------------------------------- ! Set the data initialize flag to false !--------------------------------------- @@ -2149,14 +2153,13 @@ subroutine DataInitialize(gcomp, rc) end if is_local%wrap%nx(n1) = nint(real_nx) is_local%wrap%ny(n1) = nint(real_ny) - endif - if (is_local%wrap%comp_present(n1)) then + write(msgString,'(3i8)') is_local%wrap%nx(n1), is_local%wrap%ny(n1), is_local%wrap%ntile(n1) + call ESMF_LogWrite(trim(subname)//":"//trim(compname(n1))//":"//trim(msgString), ESMF_LOGMSG_INFO) if (maintask) then write(logunit,'(a)') 'global nx,ny,ntile sizes for '//trim(compname(n1))//":"//trim(msgString) end if - call ESMF_LogWrite(trim(subname)//":"//trim(compname(n1))//":"//trim(msgString), ESMF_LOGMSG_INFO) - endif + end if end do if (maintask) write(logunit,*) diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index 32f3331d0..4c9ba6b46 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -27,7 +27,7 @@ module med_diag_mod use med_constants_mod , only : shr_const_rearth, shr_const_pi, shr_const_latice, shr_const_latvap use med_constants_mod , only : shr_const_ice_ref_sal, shr_const_ocn_ref_sal, shr_const_isspval 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, logunit, maintask, diagunit + use med_internalstate_mod , only : InternalState, logunit, maintask, diagunit, samegrid_atmlnd use med_methods_mod , only : fldbun_getdata2d => med_methods_FB_getdata2d use med_methods_mod , only : fldbun_getdata1d => med_methods_FB_getdata1d use med_methods_mod , only : fldbun_fldChk => med_methods_FB_FldChk @@ -665,8 +665,13 @@ subroutine med_phases_diag_atm(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Get fractions on atm mesh - call fldbun_getdata1d(is_local%wrap%FBfrac(compatm), 'lfrac', lfrac, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (samegrid_atmlnd) then + call fldbun_getdata1d(is_local%wrap%FBfrac(compatm), 'lfrac', lfrac, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call fldbun_getdata1d(is_local%wrap%FBfrac(compatm), 'lfrin', lfrac, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if call fldbun_getdata1d(is_local%wrap%FBfrac(compatm), 'ifrac', ifrac, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call fldbun_getdata1d(is_local%wrap%FBfrac(compatm), 'ofrac', ofrac, rc=rc) @@ -985,7 +990,7 @@ subroutine med_phases_diag_lnd( gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! get fractions on lnd mesh - call fldbun_getdata1d(is_local%wrap%FBfrac(complnd), 'lfrac', lfrac, rc=rc) + call fldbun_getdata1d(is_local%wrap%FBfrac(complnd), 'lfrin', lfrac, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return areas => is_local%wrap%mesh_info(complnd)%areas @@ -1198,7 +1203,7 @@ subroutine med_phases_diag_rof( gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if ( fldbun_fldchk(is_local%wrap%FBImp(comprof,comprof), 'Forr_rofl_glc', rc=rc)) then - call diag_rof(is_local%wrap%FBImp(comprof,comprof), 'Forr_rofi_glc' , f_watr_roff, ic, areas, budget_local, minus=.true., rc=rc) + call diag_rof(is_local%wrap%FBImp(comprof,comprof), 'Forr_rofl_glc' , f_watr_roff, ic, areas, budget_local, minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if if ( fldbun_fldchk(is_local%wrap%FBImp(comprof,comprof), 'Forr_rofi_glc', rc=rc)) then @@ -1355,12 +1360,10 @@ subroutine med_phases_diag_glc( gcomp, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - !------------------------------- ! from glc to mediator !------------------------------- - ! TODO: this will not be correct if there is more than 1 ice sheet ic = c_glc_recv ip = period_inst diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index b0cd53a61..3755b8f74 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -10,6 +10,11 @@ module med_fraction_mod ! ifrad = fraction of ocn on a grid at last radiation time ! ofrad = fraction of ice on a grid at last radiation time ! + ! ofrad = fraction of ice on a grid at last radiation time + ! afrac, lfrac, ifrac, and ofrac are the self-consistent values in the + ! system. lfrin is the fraction on the land grid and is allowed to + ! vary from the self-consistent value as descibed below. ifrad + ! and ofrad are needed for the swnet calculation. ! lfrac, ifrac, and ofrac: ! are the self-consistent values in the system ! ifrad and ofrad: @@ -17,12 +22,12 @@ module med_fraction_mod ! ! the fractions fields are defined for each grid in the fraction bundles as ! needed as follows. - ! character(*),parameter :: fraclist_a = 'ifrac:ofrac:lfrac:aofrac + ! character(*),parameter :: fraclist_a = 'ifrac:ofrac:lfrac:lfrin:aofrac ! character(*),parameter :: fraclist_o = 'ifrac:ofrac:ifrad:ofrad' ! character(*),parameter :: fraclist_i = 'ifrac:ofrac' - ! character(*),parameter :: fraclist_l = 'lfrac' - ! character(*),parameter :: fraclist_g = 'gfrac:lfrac' - ! character(*),parameter :: fraclist_r = 'lfrac:rfrac' + ! character(*),parameter :: fraclist_l = 'lfrac:lfrin' + ! character(*),parameter :: fraclist_g = 'gfrac:lfrac:lfrin' + ! character(*),parameter :: fraclist_r = 'rfrac:lfrac:lfrin' ! ! we assume ocean and ice are on the same grids, same masks ! we assume ocn2atm and ice2atm are masked maps @@ -44,6 +49,9 @@ module med_fraction_mod ! where fractions_* are a bundle of fractions on a particular grid and ! *frac is the fraction of a particular component in the bundle. ! + ! in general, on every grid, + ! fractions_*(ifrac) + fractions_*(ofrac) + fractions_*(lfrac) = 1.0 + ! ! the fractions are computed fundamentally as follows (although the ! detailed implementation might be slightly different) ! @@ -52,8 +60,12 @@ module med_fraction_mod ! fractions_*(ifrac) = 0.0 ! fractions/masks provided by surface components ! fractions_o(ofrac) = ocean "mask" provided by ocean + ! fractions_l(lfrin) = Sl_lfrin ! land model fraction computed as + ! map of ocean mask to land grid ! then mapped to the atm model ! fractions_a(ofrac) = mapo2a(fractions_o(ofrac)) + ! fractions_a(lfrin) = mapl2a(fractions_l(lfrin)) + ! ! and a few things are then derived ! fractions_a(lfrac) = 1.0 - fractions_a(ofrac) ! this is truncated to zero for very small values (< 0.001) @@ -79,8 +91,8 @@ module med_fraction_mod ! fraction corrections in mapping are as follows ! mapo2a uses *fractions_o(ofrac) and /fractions_a(ofrac) ! mapi2a uses *fractions_i(ifrac) and /fractions_a(ifrac) - ! mapl2a uses *fractions_l(lfrac) - ! mapl2g weights by fractions_l(lfrac) with normalization and multiplies by fractions_g(lfrac) + ! mapl2a uses *fractions_l(lfrin) and /fractions_a(lfrin) + ! mapl2g weights by fractions_l(lfrin) with normalization and multiplies by fractions_g(lfrin) ??? ! ! run time: ! fractions_a(lfrac) + fractions_a(ofrac) + fractions_a(ifrac) ~ 1.0 @@ -95,6 +107,19 @@ module med_fraction_mod ! is_local%wrap%FBImp(compocn,compocn) => 'So_omask' ! is_local%wrap%FBImp(compice,compice) => 'Si_ifrac' (runtime) ! + ! NOTE: In trigrid configurations, lfrin MUST be defined as the + ! conservative o2l mapping of the complement of the ocean mask. + ! In non-trigrid configurations, lfrin is generally associated with + ! the fraction of land grid defined by the surface dataset and might + ! be 1 everywhere for instance. In many cases, the non-trigrid + ! lfrin is defined to be the conservative o2a mapping of the complement + ! of the ocean mask. In this case, it is defined the same as the + ! trigrid. But to support all cases, + ! for trigrid: + ! mapping from the land grid should use the lfrin field (same in non-trigrid) + ! budget diagnostics should use lfrin (lfrac in non-trigrid) + ! merges in the atm should use lfrac (same in non-trigrid) + ! the runoff should use the lfrin fraction in the runoff merge (lfrac in non-trigrid) !----------------------------------------------------------------------------- use med_kind_mod , only : CX =>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 @@ -109,7 +134,7 @@ module med_fraction_mod 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 + use med_internalstate_mod , only : ncomps, samegrid_atmlnd implicit none private @@ -118,15 +143,15 @@ module med_fraction_mod public med_fraction_init public med_fraction_set - integer, parameter :: nfracs = 5 - 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 '/) - character(len=6),parameter,dimension(1) :: fraclist_l = (/'lfrac '/) - character(len=6),parameter,dimension(2) :: fraclist_g = (/'gfrac ','lfrac '/) - character(len=6),parameter,dimension(2) :: fraclist_r = (/'rfrac ','lfrac '/) - character(len=6),parameter,dimension(1) :: fraclist_w = (/'wfrac '/) + integer, parameter :: nfracs = 5 + character(len=6),allocatable :: fraclist(:,:) + character(len=6),parameter :: fraclist_a(5) = (/'ifrac ','ofrac ','lfrac ','lfrin ','aofrac'/) + character(len=6),parameter :: fraclist_o(4) = (/'ifrac ','ofrac ','ifrad ','ofrad '/) + character(len=6),parameter :: fraclist_i(2) = (/'ifrac ','ofrac '/) + character(len=6),parameter :: fraclist_l(2) = (/'lfrac ','lfrin '/) + character(len=6),parameter :: fraclist_g(3) = (/'gfrac ','lfrac ','lfrin '/) + character(len=6),parameter :: fraclist_r(3) = (/'rfrac ','lfrac ','lfrin '/) + character(len=6),parameter :: fraclist_w(1) = (/'wfrac '/) !--- standard --- real(R8) , parameter :: eps_fraclim = 1.0e-03 ! truncation limit in fractions_a(lfrac) @@ -169,6 +194,7 @@ subroutine med_fraction_init(gcomp, rc) real(R8), pointer :: ofrac(:) real(R8), pointer :: aofrac(:) real(R8), pointer :: lfrac(:) + real(R8), pointer :: lfrin(:) real(R8), pointer :: ifrac(:) real(R8), pointer :: gfrac(:) real(R8), pointer :: rfrac(:) @@ -251,7 +277,8 @@ subroutine med_fraction_init(gcomp, rc) endif !--------------------------------------- - ! Set 'lfrac' for FBFrac(complnd) - this might be overwritten later + ! Set 'lfrac' in FBFrac(complnd) - this might be overwritten later + ! Set 'lfrin' in FBFrac(complnd) !--------------------------------------- if (is_local%wrap%comp_present(complnd)) then @@ -262,6 +289,11 @@ subroutine med_fraction_init(gcomp, rc) if (associated(lfrac)) then lfrac(:) = Sl_lfrin(:) end if + call fldbun_getdata1d(is_local%wrap%FBFrac(complnd) , 'lfrin', lfrin, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (associated(lfrin)) then + lfrin(:) = Sl_lfrin(:) + end if end if !--------------------------------------- @@ -378,7 +410,40 @@ subroutine med_fraction_init(gcomp, rc) end if !--------------------------------------- - ! Set 'lfrac' in FBFrac(compatm) and correct 'ofrac' in FBFrac(compatm) + ! Set 'lfrin' in FBFrac(compatm) + ! --------------------------------------- + + if ( is_local%wrap%comp_present(compatm) .and. & + is_local%wrap%comp_present(complnd) .and. & + is_local%wrap%med_coupling_active(complnd,compatm)) then + + if (med_map_RH_is_created(is_local%wrap%RH(complnd,compatm,:),mapfcopy, rc=rc)) then + maptype = mapfcopy + else + maptype = mapconsd + if (.not. med_map_RH_is_created(is_local%wrap%RH(complnd,compatm,:),maptype, rc=rc)) then + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(complnd,compatm))) then + call med_map_routehandles_init( complnd, compatm, & + FBSrc=is_local%wrap%FBImp(complnd,complnd), & + FBDst=is_local%wrap%FBImp(complnd,compatm), & + mapindex=maptype, RouteHandle=is_local%wrap%RH, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end if + end if + + call ESMF_FieldBundleGet(is_local%wrap%FBfrac(complnd), 'lfrin', field=field_src, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compatm), 'lfrin', field=field_dst, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_map_field(field_src, field_dst, is_local%wrap%RH(complnd,compatm,:), maptype, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + end if + + !--------------------------------------- + ! Set 'lfrac' in FBFrac(compatm) + ! Reset 'ofrac' in FBFrac(compatm) if appropriate ! --------------------------------------- ! These should actually be mapo2a of ofrac and lfrac but we can't ! map lfrac from o2a due to masked mapping weights. So we have to @@ -389,7 +454,7 @@ subroutine med_fraction_init(gcomp, rc) if (is_local%wrap%comp_present(compocn) .or. is_local%wrap%comp_present(compice)) then - ! Ocean is present + ! Ocean or ice is present call fldbun_getdata1d(is_local%wrap%FBfrac(compatm), 'lfrac', lfrac, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call fldbun_getdata1d(is_local%wrap%FBfrac(compatm), 'ofrac', ofrac, rc) @@ -431,20 +496,26 @@ subroutine med_fraction_init(gcomp, rc) call med_map_field(field_src, field_dst, is_local%wrap%RH(complnd,compatm,:), maptype, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbun_getdata1d(is_local%wrap%FBfrac(compatm), 'lfrac', lfrac, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Reset ofrac in FBFrac(compatm) + if (samegrid_atmlnd) then + call fldbun_getdata1d(is_local%wrap%FBfrac(compatm), 'lfrac', lfrac, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call fldbun_getdata1d(is_local%wrap%FBfrac(compatm), 'lfrin', lfrac, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if call fldbun_getdata1d(is_local%wrap%FBfrac(compatm), 'ofrac', ofrac, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (associated(ofrac)) then - do n = 1,size(lfrac) - ofrac(n) = 1.0_R8 - lfrac(n) - if (abs(ofrac(n)) < eps_fraclim) then - ofrac(n) = 0.0_R8 - end if - end do + do n = 1,size(lfrac) + ofrac(n) = 1.0_R8 - lfrac(n) + if (abs(ofrac(n)) < eps_fraclim) then + ofrac(n) = 0.0_R8 + end if + end do end if - end if + end if end if !--------------------------------------- @@ -502,7 +573,7 @@ subroutine med_fraction_init(gcomp, rc) endif endif - ! Set 'lfrac' in FBFrac(comprof) + ! Set 'lfrac' and 'lfrin' in FBFrac(comprof) if (is_local%wrap%comp_present(complnd)) then maptype = mapconsd if (.not. med_map_RH_is_created(is_local%wrap%RH(complnd,comprof,:),maptype, rc=rc)) then @@ -512,17 +583,25 @@ subroutine med_fraction_init(gcomp, rc) mapindex=maptype, RouteHandle=is_local%wrap%RH, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if + call ESMF_FieldBundleGet(is_local%wrap%FBfrac(complnd), 'lfrac', field=field_src, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldBundleGet(is_local%wrap%FBfrac(comprof), 'lfrac', field=field_dst, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call med_map_field(field_src, field_dst, is_local%wrap%RH(complnd,comprof,:), maptype, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldBundleGet(is_local%wrap%FBfrac(complnd), 'lfrin', field=field_src, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleGet(is_local%wrap%FBfrac(comprof), 'lfrin', field=field_dst, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_map_field(field_src, field_dst, is_local%wrap%RH(complnd,comprof,:), maptype, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return endif endif !--------------------------------------- - ! Set 'gfrac' and 'lfrac' for FBFrac(compglc) + ! Set 'gfrac', 'lfrac' and 'lfrin' in FBFrac(compglc) !--------------------------------------- do ns = 1,is_local%wrap%num_icesheets @@ -547,7 +626,7 @@ subroutine med_fraction_init(gcomp, rc) endif endif - ! Set 'lfrac' in FBFrac(compglc(ns)) + ! Set 'lfrac' and 'lfrin' in FBFrac(compglc(ns)) if ( is_local%wrap%comp_present(complnd) .and. is_local%wrap%med_coupling_active(complnd,compglc(ns))) then maptype = mapconsd if (.not. med_map_RH_is_created(is_local%wrap%RH(complnd,compglc(ns),:),maptype, rc=rc)) then @@ -557,12 +636,20 @@ subroutine med_fraction_init(gcomp, rc) mapindex=maptype, RouteHandle=is_local%wrap%RH, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if + call ESMF_FieldBundleGet(is_local%wrap%FBfrac(complnd), 'lfrac', field=field_src, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compglc(ns)), 'lfrac', field=field_dst, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call med_map_field(field_src, field_dst, is_local%wrap%RH(complnd,compglc(ns),:), maptype, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldBundleGet(is_local%wrap%FBfrac(complnd), 'lfrin', field=field_src, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compglc(ns)), 'lfrin', field=field_dst, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_map_field(field_src, field_dst, is_local%wrap%RH(complnd,compglc(ns),:), maptype, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return endif endif end do diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index 21b480a4d..d09903be5 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -115,6 +115,15 @@ module med_internalstate_mod real(r8), pointer :: lons(:) => null() end type mesh_info_type + logical , public :: samegrid_atmlnd = .true. ! true=>atm and lnd are on the same grid + character(len=CS), public :: mrg_fracname_lnd2atm_state + character(len=CS), public :: mrg_fracname_lnd2atm_flux + character(len=CS), public :: map_fracname_lnd2atm + character(len=CS), public :: mrg_fracname_lnd2rof + character(len=CS), public :: map_fracname_lnd2rof + character(len=CS), public :: mrg_fracname_lnd2glc + character(len=CS), public :: map_fracname_lnd2glc + ! private internal state to keep instance data type InternalStateStruct @@ -191,11 +200,11 @@ module med_internalstate_mod type(mesh_info_type) , pointer :: mesh_info(:) type(ESMF_FieldBundle) , pointer :: FBArea(:) ! needed for mediator history writes - end type InternalStateStruct + end type InternalStateStruct - type, public :: InternalState + type, public :: InternalState type(InternalStateStruct), pointer :: wrap - end type InternalState + end type InternalState character(len=*), parameter :: u_FILE_u = & __FILE__ @@ -223,6 +232,10 @@ subroutine med_internalstate_init(gcomp, rc) character(len=CX) :: msgString character(len=3) :: name integer :: num_icesheets + character(len=CL) :: atm_mesh_name + character(len=CL) :: lnd_mesh_name + logical :: isPresent_lnd, isSet_lnd + logical :: isPresent_atm, isSet_atm character(len=*),parameter :: subname=' (internalstate init) ' !----------------------------------------------------------- @@ -230,6 +243,53 @@ subroutine med_internalstate_init(gcomp, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! determine if atm and lnd have the same mesh + call NUOPC_CompAttributeGet(gcomp, name='mesh_atm', value=atm_mesh_name, & + isPresent=isPresent_atm, isSet=isSet_atm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(gcomp, name='mesh_lnd', value=lnd_mesh_name, & + isPresent=isPresent_lnd, isSet=isSet_lnd, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if ((isPresent_lnd .and. isSet_lnd) .and. (isPresent_atm .and. isSet_atm)) then + if (trim(atm_mesh_name) == trim(lnd_mesh_name)) then + samegrid_atmlnd = .true. + else + samegrid_atmlnd = .false. + end if + else + samegrid_atmlnd = .true. + end if + + ! See med_fraction_mod for the following definitions + if (samegrid_atmlnd) then + map_fracname_lnd2atm = 'lfrin' ! in fraclist_a + mrg_fracname_lnd2atm_state = 'lfrac' ! in fraclist_a + mrg_fracname_lnd2atm_flux = 'lfrac' ! in fraclist_a + map_fracname_lnd2rof = 'lfrac' ! in fraclist_r + mrg_fracname_lnd2rof = 'lfrac' ! in fraclist_r + map_fracname_lnd2glc = 'lfrac' ! in fraclist_g + mrg_fracname_lnd2glc = 'lfrac' ! in fraclist_g + else + map_fracname_lnd2atm = 'lfrin' ! in fraclist_a + mrg_fracname_lnd2atm_state = 'lfrac' ! in fraclist_a + mrg_fracname_lnd2atm_flux = 'lfrin' ! in fraclist_a + map_fracname_lnd2rof = 'lfrin' ! in fraclist_r + mrg_fracname_lnd2rof = 'lfrin' ! in fraclist_r + map_fracname_lnd2glc = 'lfrin' ! in fraclist_g + mrg_fracname_lnd2rof = 'lfrin' ! in fraclist_g + endif + + if (maintask) then + write(logunit,'(a,i8)') trim(subname)//' map_fracname_lnd2atm = '//trim(map_fracname_lnd2atm) //' in fraclist_a' + write(logunit,'(a,i8)') trim(subname)//' mrg_fracname_lnd2atm_state = '//trim(mrg_fracname_lnd2atm_state)//' in fraclist_a' + write(logunit,'(a,i8)') trim(subname)//' mrg_fracname_lnd2atm_flux = '//trim(mrg_fracname_lnd2atm_flux) //' in fraclist_a' + write(logunit,'(a,i8)') trim(subname)//' map_fracname_lnd2rof = '//trim(map_fracname_lnd2rof) //' in fraclist_r' + write(logunit,'(a,i8)') trim(subname)//' mrg_fracname_lnd2rof = '//trim(mrg_fracname_lnd2rof) //' in fraclist_r' + write(logunit,'(a,i8)') trim(subname)//' map_fracname_lnd2glc = '//trim(map_fracname_lnd2glc) //' in fraclist_g' + write(logunit,'(a,i8)') trim(subname)//' mrg_fracname_lnd2rof = '//trim(mrg_fracname_lnd2rof) //' in fraclist_g' + end if + ! 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 diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index f4abadaf6..1b89f4634 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -870,24 +870,28 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, & ng = maxval(maxIndexPTile) if (tiles) then - lnx = nx - lny = ny - lntile = ng/(lnx*lny) - write(tmpstr,*) subname, 'ng,lnx,lny,lntile = ',ng,lnx,lny,lntile - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) - if (lntile /= ntile) then - call ESMF_LogWrite(trim(subname)//' ERROR: grid2d size and ntile are not consistent ', ESMF_LOGMSG_INFO) - call ESMF_Finalize(endflag=ESMF_END_ABORT) - endif + lnx = ng + lny = 1 + lntile = 1 + if (nx > 0) lnx = nx + if (ny > 0) lny = ny + if (ntile > 0) lntile = ntile + write(tmpstr,*) subname, 'ng,lnx,lny,lntile = ',ng,lnx,lny,lntile + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + if (lnx*lny*lntile /= ng) then + write(tmpstr,*) subname,' ERROR: grid size not consistent ',ng,lnx,lny,lntile + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + call ESMF_Finalize(endflag=ESMF_END_ABORT) + end if else - lnx = ng - lny = 1 - if (nx > 0) lnx = nx - if (ny > 0) lny = ny - if (lnx*lny /= ng) then - write(tmpstr,*) subname,' WARNING: grid2d size not consistent ',ng,lnx,lny - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) - endif + lnx = ng + lny = 1 + if (nx > 0) lnx = nx + if (ny > 0) lny = ny + if (lnx*lny /= ng) then + write(tmpstr,*) subname,' WARNING: grid2d size not consistent ',ng,lnx,lny + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + endif end if deallocate(minIndexPTile, maxIndexPTile) @@ -902,7 +906,7 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, & if (tiles) then rcode = pio_def_dim(io_file, trim(lpre)//'_nx', lnx, dimid3(1)) rcode = pio_def_dim(io_file, trim(lpre)//'_ny', lny, dimid3(2)) - rcode = pio_def_dim(io_file, trim(lpre)//'_ntile', ntile, dimid3(3)) + rcode = pio_def_dim(io_file, trim(lpre)//'_ntile', lntile, dimid3(3)) if (present(nt)) then dimid4(1:3) = dimid3 rcode = pio_inq_dimid(io_file, 'time', dimid4(4)) @@ -1020,10 +1024,18 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, & write(tmpstr,*) subname,' dof = ',ns,size(dof),dof(1),dof(ns) !,minval(dof),maxval(dof) call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) if (tiles) then - call pio_initdecomp(io_subsystem, pio_double, (/lnx,lny,ntile/), dof, iodesc) + if (luse_float) then + call pio_initdecomp(io_subsystem, pio_real, (/lnx,lny,lntile/), dof, iodesc) + else + call pio_initdecomp(io_subsystem, pio_double, (/lnx,lny,lntile/), dof, iodesc) + end if else - call pio_initdecomp(io_subsystem, pio_double, (/lnx,lny/), dof, iodesc) - !call pio_writedof(lpre, (/lnx,lny/), int(dof,kind=PIO_OFFSET_KIND), mpicom) + if (luse_float) then + call pio_initdecomp(io_subsystem, pio_real, (/lnx,lny/), dof, iodesc) + else + call pio_initdecomp(io_subsystem, pio_double, (/lnx,lny/), dof, iodesc) + end if + !call pio_writedof(lpre, (/lnx,lny/), int(dof,kind=PIO_OFFSET_KIND), mpicom) end if deallocate(dof) @@ -1056,10 +1068,18 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, & rcode = pio_inq_varid(io_file, trim(name1), varid) call pio_setframe(io_file,varid,frame) - if (gridToFieldMap(1) == 1) then - call pio_write_darray(io_file, varid, iodesc, fldptr2(:,n), rcode, fillval=lfillvalue) - else if (gridToFieldMap(1) == 2) then - call pio_write_darray(io_file, varid, iodesc, fldptr2(n,:), rcode, fillval=lfillvalue) + if (luse_float) then + if (gridToFieldMap(1) == 1) then + call pio_write_darray(io_file, varid, iodesc, real(fldptr2(:,n),r4), rcode, fillval=real(lfillvalue,r4)) + else if (gridToFieldMap(1) == 2) then + call pio_write_darray(io_file, varid, iodesc, real(fldptr2(n,:),r4), rcode, fillval=real(lfillvalue,r4)) + end if + else + if (gridToFieldMap(1) == 1) then + call pio_write_darray(io_file, varid, iodesc, fldptr2(:,n), rcode, fillval=lfillvalue) + else if (gridToFieldMap(1) == 2) then + call pio_write_darray(io_file, varid, iodesc, fldptr2(n,:), rcode, fillval=lfillvalue) + end if end if end do else if (rank == 1 .or. rank == 0) then @@ -1068,7 +1088,11 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, & call pio_setframe(io_file,varid,frame) ! fix for writing data on exchange grid, which has no data in some PETs if (rank == 0) nullify(fldptr1) - call pio_write_darray(io_file, varid, iodesc, fldptr1, rcode, fillval=lfillvalue) + if (luse_float) then + call pio_write_darray(io_file, varid, iodesc, real(fldptr1,r4), rcode, fillval=real(lfillvalue,r4)) + else + call pio_write_darray(io_file, varid, iodesc, fldptr1, rcode, fillval=lfillvalue) + end if end if ! end if rank is 2 or 1 or 0 end if ! end if not "hgt" @@ -1077,16 +1101,31 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, & ! Fill coordinate variables - why is this being done each time? rcode = pio_inq_varid(io_file, trim(coordvarnames(1)), varid) call pio_setframe(io_file,varid,frame) - call pio_write_darray(io_file, varid, iodesc, ownedElemCoords_x, rcode, fillval=lfillvalue) + if (luse_float) then + call pio_write_darray(io_file, varid, iodesc, real(ownedElemCoords_x,r4), rcode, fillval=real(lfillvalue,r4)) + else + call pio_write_darray(io_file, varid, iodesc, ownedElemCoords_x, rcode, fillval=lfillvalue) + end if rcode = pio_inq_varid(io_file, trim(coordvarnames(2)), varid) call pio_setframe(io_file,varid,frame) - call pio_write_darray(io_file, varid, iodesc, ownedElemCoords_y, rcode, fillval=lfillvalue) - + if (luse_float) then + call pio_write_darray(io_file, varid, iodesc, real(ownedElemCoords_y,r4), rcode, fillval=real(lfillvalue,r4)) + else + call pio_write_darray(io_file, varid, iodesc, ownedElemCoords_y, rcode, fillval=lfillvalue) + end if call pio_syncfile(io_file) call pio_freedecomp(io_file, iodesc) endif - deallocate(ownedElemCoords, ownedElemCoords_x, ownedElemCoords_y) + if(allocated(ownedElemCoords)) then + deallocate(ownedElemCoords) + endif + if(allocated(ownedElemCoords_x)) then + deallocate(ownedElemCoords_x) + endif + if(allocated(ownedElemCoords_y)) then + deallocate(ownedElemCoords_y) + endif if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index d4bdab2a7..1634e7523 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -2609,6 +2609,7 @@ subroutine med_methods_FB_check_for_nans(FB, maintask, logunit, rc) do index=1,fieldCount call med_methods_FB_getNameN(FB, index, fieldname, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleGet(FB, fieldName=fieldname, field=field, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldGet(field, rank=fieldrank, name=fieldname, rc=rc) @@ -2632,9 +2633,8 @@ subroutine med_methods_FB_check_for_nans(FB, maintask, logunit, rc) if (nanfound) then call ESMF_LogWrite('ABORTING JOB', ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) rc = ESMF_FAILURE - return end if - + end subroutine med_methods_FB_check_for_nans !----------------------------------------------------------------------------- diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index 21bc9cb86..b910c1a68 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -1601,9 +1601,13 @@ subroutine set_aoflux_in_pointers(fldbun_a, fldbun_o, aoflux_in, lsize, xgrid, r if (chkerr(rc,__LINE__,u_FILE_u)) return call fldbun_getfldptr(fldbun_a, 'Sa_shum', aoflux_in%shum, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (associated(aoflux_in%rainc)) then + if (add_gusts) then call fldbun_getfldptr(fldbun_a, 'Faxa_rainc', aoflux_in%rainc, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + else + ! rainc is not used without add_gusts but some compilers complain about the unallocated pointer + ! in the subroutine interface + allocate(aoflux_in%rainc(1)) end if end if @@ -1743,7 +1747,6 @@ subroutine set_aoflux_out_pointers(fldbun, lsize, aoflux_out, xgrid, rc) allocate(aoflux_out%evap_18O(lsize)); aoflux_out%evap_18O(:) = 0._R8 allocate(aoflux_out%evap_HDO(lsize)); aoflux_out%evap_HDO(:) = 0._R8 end if - if (add_gusts) then call fldbun_getfldptr(fldbun, 'So_ugustOut', aoflux_out%ugust_out, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index b8b7843cb..51068340c 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -364,11 +364,13 @@ subroutine med_phases_history_write(gcomp, rc) end if if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_a,rc=rc)) then call med_io_write(io_file, is_local%wrap%FBMed_ocnalb_a, whead(m), wdata(m), & - is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_alb_atm', rc=rc) + is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_alb_atm', & + ntile=is_local%wrap%ntile(compatm), rc=rc) end if if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a,rc=rc)) then call med_io_write(io_file, is_local%wrap%FBMed_aoflux_a, whead(m), wdata(m), & - is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_aoflux_atm', rc=rc) + is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_aoflux_atm', & + ntile=is_local%wrap%ntile(compatm), rc=rc) end if end do ! end of loop over whead/wdata m index phases @@ -502,7 +504,8 @@ subroutine med_phases_history_write_med(gcomp, rc) end if if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a,rc=rc)) then call med_io_write(instfiles(compmed)%io_file, is_local%wrap%FBMed_aoflux_a, whead(m), wdata(m), & - is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_aoflux_atm', rc=rc) + is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_aoflux_atm', & + ntile=is_local%wrap%ntile(compatm), rc=rc) end if ! If appropriate - write ocn albedos computed in mediator @@ -512,7 +515,8 @@ subroutine med_phases_history_write_med(gcomp, rc) end if if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_a,rc=rc)) then call med_io_write(instfiles(compmed)%io_file, is_local%wrap%FBMed_ocnalb_a, whead(m), wdata(m), & - is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_alb_atm', rc=rc) + is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_alb_atm', & + ntile=is_local%wrap%ntile(compatm), rc=rc) end if end do ! end of loop over m @@ -1065,6 +1069,7 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc) logical :: enable_auxfile character(CL) :: time_units ! units of time variable integer :: nx,ny ! global grid size + integer :: ntile ! number of tiles for tiled domain eg CSG logical :: write_now ! if true, write time sample to file real(r8) :: time_val ! time coordinate output real(r8) :: time_bnds(2) ! time bounds output @@ -1271,6 +1276,7 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc) ! Set shorthand variables nx = is_local%wrap%nx(compid) ny = is_local%wrap%ny(compid) + ntile = is_local%wrap%ntile(compid) ! Increment number of time samples on file auxcomp%files(nf)%nt = auxcomp%files(nf)%nt + 1 @@ -1306,7 +1312,7 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc) call med_io_write(auxcomp%files(nf)%io_file, is_local%wrap%FBimp(compid,compid), & whead(1), wdata(1), nx, ny, nt=auxcomp%files(nf)%nt, & pre=trim(compname(compid))//'Imp', flds=auxcomp%files(nf)%flds, & - use_float=.true., rc=rc) + use_float=.true., ntile=ntile, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! end definition phase @@ -1320,13 +1326,15 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc) ! Write data variables for time nt if (auxcomp%files(nf)%doavg) then call med_io_write(auxcomp%files(nf)%io_file, auxcomp%files(nf)%FBaccum, whead(2), wdata(2), nx, ny, & - nt=auxcomp%files(nf)%nt, pre=trim(compname(compid))//'Imp', flds=auxcomp%files(nf)%flds, rc=rc) + nt=auxcomp%files(nf)%nt, pre=trim(compname(compid))//'Imp', flds=auxcomp%files(nf)%flds, & + use_float=.true., ntile=ntile, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call med_methods_FB_reset(auxcomp%files(nf)%FBaccum, value=czero, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else call med_io_write(auxcomp%files(nf)%io_file, is_local%wrap%FBimp(compid,compid), whead(2), wdata(2), nx, ny, & - nt=auxcomp%files(nf)%nt, pre=trim(compname(compid))//'Imp', flds=auxcomp%files(nf)%flds, rc=rc) + nt=auxcomp%files(nf)%nt, pre=trim(compname(compid))//'Imp', flds=auxcomp%files(nf)%flds, & + use_float=.true., ntile=ntile, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if diff --git a/mediator/med_phases_post_rof_mod.F90 b/mediator/med_phases_post_rof_mod.F90 index aafeec011..036eeca30 100644 --- a/mediator/med_phases_post_rof_mod.F90 +++ b/mediator/med_phases_post_rof_mod.F90 @@ -2,11 +2,52 @@ module med_phases_post_rof_mod ! Post rof phase, if appropriate, map initial rof->lnd, rof->ocn, rof->ice + use NUOPC_Mediator , only : NUOPC_MediatorGet + use NUOPC , only : NUOPC_CompAttributeGet + use ESMF , only : ESMF_Clock, ESMF_ClockIsCreated + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LOGMSG_ERROR, ESMF_SUCCESS, ESMF_FAILURE + use ESMF , only : ESMF_GridComp, ESMF_GridCompGet + use ESMF , only : ESMF_Mesh, ESMF_MESHLOC_ELEMENT, ESMF_TYPEKIND_R8 + use ESMF , only : ESMF_Field, ESMF_FieldCreate + use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleCreate + use ESMF , only : ESMF_FieldBundleGet, ESMF_FieldBundleAdd + use ESMF , only : ESMF_VM, ESMF_VMAllreduce, ESMF_REDUCE_SUM + 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 : complnd, compocn, compice, comprof + use med_internalstate_mod , only : InternalState, maintask, logunit + use med_utils_mod , only : chkerr => med_utils_ChkErr + use med_constants_mod , only : dbug_flag => med_constants_dbug_flag + use med_phases_history_mod, only : med_phases_history_write_comp + use med_map_mod , only : med_map_field_packed + use med_methods_mod , only : fldbun_getdata1d => med_methods_FB_getdata1d + use med_methods_mod , only : fldbun_getmesh => med_methods_FB_getmesh + use perf_mod , only : t_startf, t_stopf + use shr_sys_mod , only : shr_sys_abort + implicit none private - public :: med_phases_post_rof + public :: med_phases_post_rof_init + public :: med_phases_post_rof + private :: med_phases_post_rof_create_rof_field_bundle + private :: med_phases_post_rof_remove_negative_runoff + + ! A local FieldBundle to hold a copy of rof fields, so that when we modify them, we + ! aren't modifying the import fields in-place. + type(ESMF_FieldBundle) :: FBrof_r + integer :: num_rof_fields + character(len=CS), allocatable :: rof_field_names(:) + logical :: remove_negative_runoff_lnd + logical :: remove_negative_runoff_glc + + character(len=9), parameter :: fields_to_remove_negative_runoff_lnd(2) = & + ['Forr_rofl', & + 'Forr_rofi'] + character(len=13), parameter :: fields_to_remove_negative_runoff_glc(2) = & + ['Forr_rofl_glc', & + 'Forr_rofi_glc'] + character(*) , parameter :: u_FILE_u = & __FILE__ @@ -14,20 +55,71 @@ module med_phases_post_rof_mod contains !================================================================================================ - subroutine med_phases_post_rof(gcomp, rc) + subroutine med_phases_post_rof_init(gcomp, rc) + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + character(CL) :: cvalue + logical :: isPresent, isSet + logical :: flds_wiso + + character(len=*), parameter :: subname='(med_phases_post_rof_init)' + !--------------------------------------- + + rc = ESMF_SUCCESS + + call t_startf('MED:'//subname) + if (dbug_flag > 20) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + end if + + call med_phases_post_rof_create_rof_field_bundle(gcomp, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompAttributeGet(gcomp, name='remove_negative_runoff_lnd', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) remove_negative_runoff_lnd + else + remove_negative_runoff_lnd = .false. + end if + + call NUOPC_CompAttributeGet(gcomp, name='remove_negative_runoff_glc', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) remove_negative_runoff_glc + else + remove_negative_runoff_glc = .false. + end if + + ! remove_negative_runoff isn't yet set up to handle isotope fields, so ensure that + ! this isn't set along with flds_wiso + call NUOPC_CompAttributeGet(gcomp, name='flds_wiso', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) flds_wiso + else + flds_wiso = .false. + end if + if ((remove_negative_runoff_lnd .or. remove_negative_runoff_glc) .and. flds_wiso) then + call shr_sys_abort('remove_negative_runoff_lnd and remove_negative_runoff_glc must be set to false when flds_wiso is true') + end if + + if (maintask) then + write(logunit,'(a,l7)') trim(subname)//' remove_negative_runoff_lnd = ', remove_negative_runoff_lnd + write(logunit,'(a,l7)') trim(subname)//' remove_negative_runoff_glc = ', remove_negative_runoff_glc + end if - use NUOPC_Mediator , only : NUOPC_MediatorGet - use ESMF , only : ESMF_Clock, ESMF_ClockIsCreated - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LOGMSG_ERROR, ESMF_SUCCESS, ESMF_FAILURE - use ESMF , only : ESMF_GridComp, ESMF_GridCompGet - use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 - use med_internalstate_mod , only : complnd, compocn, compice, comprof - 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 - use med_phases_history_mod, only : med_phases_history_write_comp - use med_map_mod , only : med_map_field_packed - use perf_mod , only : t_startf, t_stopf + 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_post_rof_init + + subroutine med_phases_post_rof(gcomp, rc) ! input/output variables type(ESMF_GridComp) :: gcomp @@ -36,6 +128,10 @@ subroutine med_phases_post_rof(gcomp, rc) ! local variables type(InternalState) :: is_local type(ESMF_Clock) :: dClock + real(r8), pointer :: data_orig(:) + real(r8), pointer :: data_copy(:) + integer :: n + logical :: exists character(len=*), parameter :: subname='(med_phases_post_rof)' !--------------------------------------- @@ -50,11 +146,40 @@ subroutine med_phases_post_rof(gcomp, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + do n = 1, num_rof_fields + call fldbun_getdata1d(is_local%wrap%FBImp(comprof,comprof), trim(rof_field_names(n)), data_orig, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbun_getdata1d(FBrof_r, trim(rof_field_names(n)), data_copy, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + data_copy(:) = data_orig(:) + end do + + if (remove_negative_runoff_lnd) then + do n = 1, size(fields_to_remove_negative_runoff_lnd) + call ESMF_FieldBundleGet(FBrof_r, fieldName=trim(fields_to_remove_negative_runoff_lnd(n)), isPresent=exists, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (exists) then + call med_phases_post_rof_remove_negative_runoff(gcomp, fields_to_remove_negative_runoff_lnd(n), rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end do + end if + if (remove_negative_runoff_glc) then + do n = 1, size(fields_to_remove_negative_runoff_glc) + call ESMF_FieldBundleGet(FBrof_r, fieldName=trim(fields_to_remove_negative_runoff_glc(n)), isPresent=exists, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (exists) then + call med_phases_post_rof_remove_negative_runoff(gcomp, fields_to_remove_negative_runoff_glc(n), rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end do + end if + ! map rof to lnd if (is_local%wrap%med_coupling_active(comprof,complnd)) then call t_startf('MED:'//trim(subname)//' map_rof2lnd') call med_map_field_packed( & - FBSrc=is_local%wrap%FBImp(comprof,comprof), & + FBSrc=FBrof_r, & FBDst=is_local%wrap%FBImp(comprof,complnd), & FBFracSrc=is_local%wrap%FBFrac(comprof), & field_normOne=is_local%wrap%field_normOne(comprof,complnd,:), & @@ -67,7 +192,7 @@ subroutine med_phases_post_rof(gcomp, rc) if (is_local%wrap%med_coupling_active(comprof,compocn)) then call t_startf('MED:'//trim(subname)//' map_rof2ocn') call med_map_field_packed( & - FBSrc=is_local%wrap%FBImp(comprof,comprof), & + FBSrc=FBrof_r, & FBDst=is_local%wrap%FBImp(comprof,compocn), & FBFracSrc=is_local%wrap%FBFrac(comprof), & field_normOne=is_local%wrap%field_normOne(comprof,compocn,:), & @@ -80,7 +205,7 @@ subroutine med_phases_post_rof(gcomp, rc) if (is_local%wrap%med_coupling_active(comprof,compice)) then call t_startf('MED:'//trim(subname)//' map_rof2ice') call med_map_field_packed( & - FBSrc=is_local%wrap%FBImp(comprof,comprof), & + FBSrc=FBrof_r, & FBDst=is_local%wrap%FBImp(comprof,compice), & FBFracSrc=is_local%wrap%FBFrac(comprof), & field_normOne=is_local%wrap%field_normOne(comprof,compice,:), & @@ -105,4 +230,196 @@ subroutine med_phases_post_rof(gcomp, rc) end subroutine med_phases_post_rof + subroutine med_phases_post_rof_create_rof_field_bundle(gcomp, rc) + !--------------------------------------------------------------- + ! Create FBrof_r + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(InternalState) :: is_local + integer :: n + type(ESMF_Mesh) :: mesh + type(ESMF_Field) :: field + integer, parameter :: dbug_threshold = 20 ! threshold for writing debug information in this subroutine + character(len=*), parameter :: subname='(med_phases_post_rof_mod: med_phases_post_rof_create_rof_field_bundle)' + !--------------------------------------- + + rc = ESMF_SUCCESS + + call t_startf('MED:'//subname) + if (dbug_flag > dbug_threshold) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + end if + + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call fldbun_getmesh(is_local%wrap%FBImp(comprof,comprof), mesh, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldBundleGet(is_local%wrap%FBImp(comprof,comprof), fieldCount=num_rof_fields, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(rof_field_names(num_rof_fields)) + call ESMF_FieldBundleGet(is_local%wrap%FBImp(comprof,comprof), fieldNameList=rof_field_names, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Note that, for simplicity, we'll add all rof fields to this local FieldBundle, even + ! though we only need to modify a subset of the fields. + FBrof_r = ESMF_FieldBundleCreate(name='FBrof_r', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + do n = 1, num_rof_fields + field = ESMF_FieldCreate(mesh, ESMF_TYPEKIND_R8, name=rof_field_names(n), meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleAdd(FBrof_r, (/field/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do + + if (dbug_flag > dbug_threshold) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + end if + call t_stopf('MED:'//subname) + + end subroutine med_phases_post_rof_create_rof_field_bundle + + subroutine med_phases_post_rof_remove_negative_runoff(gcomp, field_name, rc) + !--------------------------------------------------------------- + ! For one runoff field, remove negative runoff by downweighting all positive runoff to + ! spread the negative runoff globally. + + ! input/output variables + type(ESMF_GridComp) :: gcomp + character(len=*), intent(in) :: field_name ! name of runoff flux field to process + integer, intent(out) :: rc + + ! local variables + type(InternalState) :: is_local + type(ESMF_VM) :: vm + real(r8), pointer :: runoff_flux(:) ! temporary 1d pointer + real(r8), pointer :: areas(:) + real(r8) :: local_positive(1), global_positive(1) + real(r8) :: local_negative(1), global_negative(1) + real(r8) :: global_sum + real(r8) :: multiplier + real(r8) :: local_positive_final(1), global_positive_final(1) + real(r8) :: local_negative_final(1), global_negative_final(1) + real(r8) :: global_sum_final + integer :: n + + integer, parameter :: dbug_threshold = 20 ! threshold for writing debug information in this subroutine + character(len=*), parameter :: subname='(med_phases_post_rof_mod: med_phases_post_rof_remove_negative_runoff)' + !--------------------------------------- + + rc = ESMF_SUCCESS + + call t_startf('MED:'//subname) + if (dbug_flag > dbug_threshold) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + end if + + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Note that we don't use rof fractions in the global sum. This is consistent with the + ! global budget calculations in med_diag_mod and is because the rof fractions are 1 + ! everywhere. + areas => is_local%wrap%mesh_info(comprof)%areas + + call fldbun_getdata1d(FBrof_r, trim(field_name), runoff_flux, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + local_positive(1) = 0.0_r8 + local_negative(1) = 0.0_r8 + do n = 1, size(runoff_flux) + if (runoff_flux(n) >= 0.0_r8) then + local_positive(1) = local_positive(1) + areas(n) * runoff_flux(n) + else + local_negative(1) = local_negative(1) + areas(n) * runoff_flux(n) + end if + end do + + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMAllreduce(vm, senddata=local_positive, recvdata=global_positive, count=1, & + reduceflag=ESMF_REDUCE_SUM, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMAllreduce(vm, senddata=local_negative, recvdata=global_negative, count=1, & + reduceflag=ESMF_REDUCE_SUM, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + global_sum = global_positive(1) + global_negative(1) + if (maintask .and. dbug_flag > dbug_threshold) then + write(logunit,'(a)') subname//' Before correction: '//trim(field_name) + write(logunit,'(a,e27.17)') subname//' global_positive = ', global_positive(1) + write(logunit,'(a,e27.17)') subname//' global_negative = ', global_negative(1) + write(logunit,'(a,e27.17)') subname//' global_sum = ', global_sum + end if + + if (global_sum > 0.0_r8) then + ! There is enough positive runoff to absorb all of the negative runoff; so set + ! negative runoff to 0 and downweight positive runoff to conserve. + multiplier = global_sum/global_positive(1) + do n = 1, size(runoff_flux) + if (runoff_flux(n) > 0.0_r8) then + runoff_flux(n) = runoff_flux(n) * multiplier + else + runoff_flux(n) = 0.0_r8 + end if + end do + else if (global_sum < 0.0_r8) then + ! There is more negative than positive runoff. Hopefully this happens rarely, if + ! ever; so set positive runoff to 0 and downweight negative runoff to minimize + ! negative runoff and conserve. + multiplier = global_sum/global_negative(1) + do n = 1, size(runoff_flux) + if (runoff_flux(n) < 0.0_r8) then + runoff_flux(n) = runoff_flux(n) * multiplier + else + runoff_flux(n) = 0.0_r8 + end if + end do + else + ! global_sum == 0 - i.e., positive and negative exactly balance (very rare, unless + ! the fluxes are already 0 everywhere!); set all fluxes to 0 in this case. + do n = 1, size(runoff_flux) + runoff_flux(n) = 0.0_r8 + end do + end if + + if (dbug_flag > dbug_threshold) then + ! Recompute positives, negatives and total sum for output diagnostic purposes + local_positive_final(1) = 0.0_r8 + local_negative_final(1) = 0.0_r8 + do n = 1, size(runoff_flux) + if (runoff_flux(n) >= 0.0_r8) then + local_positive_final(1) = local_positive_final(1) + areas(n) * runoff_flux(n) + else + local_negative_final(1) = local_negative_final(1) + areas(n) * runoff_flux(n) + end if + end do + call ESMF_VMAllreduce(vm, senddata=local_positive_final, recvdata=global_positive_final, count=1, & + reduceflag=ESMF_REDUCE_SUM, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMAllreduce(vm, senddata=local_negative_final, recvdata=global_negative_final, count=1, & + reduceflag=ESMF_REDUCE_SUM, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + global_sum_final = global_positive_final(1) + global_negative_final(1) + if (maintask) then + write(logunit,'(a)') subname//' After correction: '//trim(field_name) + write(logunit,'(a,e27.17)') subname//' global_positive_final = ', global_positive_final(1) + write(logunit,'(a,e27.17)') subname//' global_negative_final = ', global_negative_final(1) + write(logunit,'(a,e27.17)') subname//' global_sum_final = ', global_sum_final + end if + end if + + if (dbug_flag > dbug_threshold) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + end if + call t_stopf('MED:'//subname) + + end subroutine med_phases_post_rof_remove_negative_runoff + end module med_phases_post_rof_mod diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index b9e7582e1..bcdf2ea42 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -17,7 +17,7 @@ module med_phases_prep_atm_mod use med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans use med_merge_mod , only : med_merge_auto use med_map_mod , only : med_map_field_packed - use med_internalstate_mod , only : InternalState, maintask, logunit + use med_internalstate_mod , only : InternalState, maintask, logunit, samegrid_atmlnd use med_internalstate_mod , only : compatm, compocn, compice, compname, coupling_mode use esmFlds , only : med_fldlist_GetfldListTo, med_fldlist_type use perf_mod , only : t_startf, t_stopf @@ -32,6 +32,9 @@ module med_phases_prep_atm_mod real(r8), public :: global_htot_corr(1) = 0._r8 ! enthalpy correction from med_phases_prep_ocn + character(len=13) :: fldnames_from_ocn(5) = (/'Faoo_fbrf_ocn','Faoo_fdms_ocn','Faoo_fco2_ocn',& + 'Faoo_fn2o_ocn','Faoo_fnh3_ocn'/) + character(*), parameter :: u_FILE_u = & __FILE__ @@ -52,7 +55,7 @@ subroutine med_phases_prep_atm(gcomp, rc) real(R8), pointer :: dataPtr2(:) real(R8), pointer :: ifrac(:) real(R8), pointer :: ofrac(:) - integer :: n + integer :: n,nf type(med_fldlist_type), pointer :: fldList character(len=*),parameter :: subname='(med_phases_prep_atm)' !------------------------------------------------------------------------------- @@ -183,8 +186,13 @@ subroutine med_phases_prep_atm(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldGet(lfield, farrayPtr=dataptr1, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldBundleGet(is_local%wrap%FBFrac(compatm), fieldName='lfrac', field=lfield, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + if (samegrid_atmlnd) then + call ESMF_FieldBundleGet(is_local%wrap%FBFrac(compatm), fieldName='lfrac', field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + call ESMF_FieldBundleGet(is_local%wrap%FBFrac(compatm), fieldName='lfrin', field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if call ESMF_FieldGet(lfield, farrayPtr=dataptr2, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return do n = 1,size(dataptr1) @@ -194,30 +202,33 @@ subroutine med_phases_prep_atm(gcomp, rc) ! Note - the following needs a custom merge since Faoo_fco2_ocn is scaled by (ifrac+ofrac) ! in the merge to the atm - if ( FB_FldChk(is_local%wrap%FBExp(compatm) , 'Faoo_fco2_ocn', rc=rc) .and. & - FB_FldChk(is_local%wrap%FBImp(compocn,compocn), 'Faoo_fco2_ocn', rc=rc)) then - call ESMF_FieldGet(lfield, farrayPtr=dataptr1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldBundleGet(is_local%wrap%FBFrac(compatm), fieldName='ifrac', field=lfield, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(lfield, farrayPtr=ifrac, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldBundleGet(is_local%wrap%FBFrac(compatm), fieldName='ofrac', field=lfield, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(lfield, farrayPtr=ofrac, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldBundleGet(is_local%wrap%FBImp(compocn,compatm), fieldName='Faoo_fco2_ocn', field=lfield, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(lfield, farrayPtr=dataptr1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldBundleGet(is_local%wrap%FBExp(compatm), fieldName='Faoo_fco2_ocn', field=lfield, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(lfield, farrayPtr=dataptr2, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - do n = 1,size(dataptr2) + call ESMF_FieldBundleGet(is_local%wrap%FBFrac(compatm), fieldName='ifrac', field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayPtr=ifrac, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleGet(is_local%wrap%FBFrac(compatm), fieldName='ofrac', field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayPtr=ofrac, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + do nf = 1,size(fldnames_from_ocn) + if ( FB_FldChk(is_local%wrap%FBExp(compatm) , trim(fldnames_from_ocn(nf)), rc=rc) .and. & + FB_FldChk(is_local%wrap%FBImp(compocn,compocn), trim(fldnames_from_ocn(nf)), rc=rc)) then + call ESMF_FieldBundleGet(is_local%wrap%FBImp(compocn,compatm), & + fieldName=trim(fldnames_from_ocn(nf)), field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayPtr=dataptr1, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleGet(is_local%wrap%FBExp(compatm), & + fieldName=trim(fldnames_from_ocn(nf)), field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayPtr=dataptr2, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + do n = 1,size(dataptr2) dataptr2(n) = (ifrac(n) + ofrac(n)) * dataptr1(n) - end do - end if + end do + end if + end do ! Add enthalpy correction to sensible heat if appropriate if (FB_FldChk(is_local%wrap%FBExp(compatm), 'Faxx_sen', rc=rc)) then @@ -247,7 +258,8 @@ subroutine med_phases_prep_atm_enthalpy_correction (gcomp, hcorr, rc) ! Note that this is only called if the following fields are in FBExp(compocn) ! 'Faxa_rain','Foxx_hrain','Faxa_snow' ,'Foxx_hsnow', ! 'Foxx_evap','Foxx_hevap','Foxx_hcond','Foxx_rofl', - ! 'Foxx_hrofl','Foxx_rofi','Foxx_hrofi' + ! 'Foxx_hrofl','Foxx_rofi','Foxx_hrofi','Foxx_rofl_glc', + ! 'Foxx_hrofl_glc','Foxx_rofi_glc','Foxx_hrofi_glc' use ESMF , only : ESMF_VMAllreduce, ESMF_GridCompGet, ESMF_REDUCE_SUM use ESMF , only : ESMF_VM diff --git a/mediator/med_phases_prep_glc_mod.F90 b/mediator/med_phases_prep_glc_mod.F90 index 22d06363d..4eff5966f 100644 --- a/mediator/med_phases_prep_glc_mod.F90 +++ b/mediator/med_phases_prep_glc_mod.F90 @@ -22,7 +22,7 @@ module med_phases_prep_glc_mod use ESMF , only : ESMF_DYNAMICMASK, ESMF_DynamicMaskSetR8R8R8, ESMF_DYNAMICMASKELEMENTR8R8R8 use ESMF , only : ESMF_FieldRegrid, ESMF_REGION_EMPTY use med_internalstate_mod , only : complnd, compocn, mapbilnr, mapconsd, compname, compglc - use med_internalstate_mod , only : InternalState, maintask, logunit + use med_internalstate_mod , only : InternalState, maintask, logunit, map_fracname_lnd2glc 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 use med_constants_mod , only : dbug_flag => med_constants_dbug_flag @@ -135,7 +135,6 @@ subroutine med_phases_prep_glc_init(gcomp, rc) type(ESMF_Mesh) :: mesh_o type(ESMF_Field) :: lfield character(len=CS) :: glc_renormalize_smb - logical :: glc_coupled_fluxes integer :: ungriddedUBound_output(1) ! currently the size must equal 1 for rank 2 fieldds character(len=*),parameter :: subname=' (med_phases_prep_glc_init) ' !--------------------------------------- @@ -234,25 +233,11 @@ subroutine med_phases_prep_glc_init(gcomp, rc) call NUOPC_CompAttributeGet(gcomp, name='glc_renormalize_smb', value=glc_renormalize_smb, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ! TODO: talk to Bill Sacks to determine if this is the correct logic - glc_coupled_fluxes = is_local%wrap%med_coupling_active(compglc(1),complnd) - ! Note glc_coupled_fluxes should be false in the no_evolve cases - ! Goes back to the zero-gcm fluxes variable - if zero-gcm fluxes is true than do not renormalize - ! The user can set this to true in an evolve cases - select case (glc_renormalize_smb) case ('on') smb_renormalize = .true. case ('off') smb_renormalize = .false. - case ('on_if_glc_coupled_fluxes') - if (.not. glc_coupled_fluxes) then - ! Do not renormalize if med_coupling_active is not true for compglc->complnd - ! In this case, conservation is not important - smb_renormalize = .false. - else - smb_renormalize = .true. - end if case default write(logunit,*) subname,' ERROR: unknown value for glc_renormalize_smb: ', trim(glc_renormalize_smb) call ESMF_LogWrite(trim(subname)//' ERROR: unknown value for glc_renormalize_smb: '// trim(glc_renormalize_smb), & @@ -812,8 +797,8 @@ subroutine med_phases_prep_glc_map_lnd2glc(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! get land fraction field on land mesh - call ESMF_FieldBundleGet(is_local%wrap%FBFrac(complnd), 'lfrac', field=field_lfrac_l, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleGet(is_local%wrap%FBFrac(complnd), fieldName=map_fracname_lnd2glc, field=field_lfrac_l, rc=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,is_local%wrap%num_icesheets @@ -1052,7 +1037,7 @@ subroutine med_phases_prep_glc_renormalize_smb(gcomp, ns, rc) real(r8) , pointer :: frac_l_ec(:,:) ! EC fractions (Sg_ice_covered) on land grid real(r8) , pointer :: icemask_g(:) ! icemask on glc grid real(r8) , pointer :: icemask_l(:) ! icemask on land grid - real(r8) , pointer :: lfrac(:) ! land fraction on land grid + real(r8) , pointer :: lndfrac(:) ! land fraction on land grid real(r8) , pointer :: dataptr1d(:) ! temporary 1d pointer integer :: ec ! loop index over elevation classes integer :: n @@ -1066,7 +1051,7 @@ subroutine med_phases_prep_glc_renormalize_smb(gcomp, ns, rc) ! renormalization factors (should be close to 1, e.g. in range 0.95 to 1.05) real(r8) :: accum_renorm_factor ! ratio between global accumulation on the two grids real(r8) :: ablat_renorm_factor ! ratio between global ablation on the two grids - real(r8) :: effective_area ! grid cell area multiplied by min(lfrac,icemask_l). + real(r8) :: effective_area ! grid cell area multiplied by min(lndfrac,icemask_l). real(r8), pointer :: area_g(:) ! areas on glc grid character(len=*), parameter :: subname=' (renormalize_smb) ' !--------------------------------------------------------------- @@ -1146,8 +1131,8 @@ subroutine med_phases_prep_glc_renormalize_smb(gcomp, ns, rc) call field_getdata2d(field_frac_l_ec, frac_l_ec, rc) if (chkErr(rc,__LINE__,u_FILE_u)) return - ! determine fraction on land grid, lfrac(:) - call fldbun_getdata1d(is_local%wrap%FBFrac(complnd), 'lfrac', lfrac, rc) + ! determine fraction on land grid, lndfrac(:) + call fldbun_getdata1d(is_local%wrap%FBFrac(complnd), map_fracname_lnd2glc, lndfrac, rc) if (chkErr(rc,__LINE__,u_FILE_u)) return ! get qice_l_ec @@ -1156,9 +1141,9 @@ subroutine med_phases_prep_glc_renormalize_smb(gcomp, ns, rc) local_accum_lnd(1) = 0.0_r8 local_ablat_lnd(1) = 0.0_r8 - do n = 1, size(lfrac) + do n = 1, size(lndfrac) ! Calculate effective area for sum - need the mapped icemask_l - effective_area = min(lfrac(n), icemask_l(n)) * is_local%wrap%mesh_info(complnd)%areas(n) + effective_area = min(lndfrac(n), icemask_l(n)) * is_local%wrap%mesh_info(complnd)%areas(n) if (effective_area > 0.0_r8) then do ec = 1, ungriddedCount if (qice_l_ec(ec,n) >= 0.0_r8) then diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index d911d93e1..246ec5866 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -97,6 +97,8 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) real(r8), pointer :: hcond(:) real(r8), pointer :: rofl(:), hrofl(:) real(r8), pointer :: rofi(:), hrofi(:) + real(r8), pointer :: rofl_glc(:), hrofl_glc(:) + real(r8), pointer :: rofi_glc(:), hrofi_glc(:) real(r8), pointer :: areas(:) real(r8), allocatable :: hcorr(:) type(med_fldlist_type), pointer :: fldList @@ -156,20 +158,24 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) !--------------------------------------- !--- custom calculations !--------------------------------------- - ! compute enthaly associated with rain, snow, condensation and liquid river runoff + ! compute enthalpy associated with rain, snow, condensation and liquid river & glc runoff ! the sea-ice model already accounts for the enthalpy flux (as part of melth), so ! enthalpy from meltw **is not** included below - if ( FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_rain' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrain' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_snow' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hsnow' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_evap' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hevap' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hcond' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofl' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrofl' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofi' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrofi' , rc=rc)) then + if ( FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_rain' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrain' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_snow' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hsnow' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_evap' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hevap' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hcond' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofl' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrofl' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofi' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrofi' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Forr_rofl_glc' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrofl_glc' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Forr_rofi_glc' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrofi_glc' , rc=rc)) then call FB_GetFldPtr(is_local%wrap%FBImp(compocn,compocn), 'So_t', tocn, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -201,6 +207,16 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hrofi', hrofi, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Forr_rofl_glc' , rofl_glc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hrofl_glc', hrofl_glc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Forr_rofi_glc' , rofi_glc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hrofi_glc', hrofi_glc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + do n = 1,size(tocn) ! Need max to ensure that will not have an enthalpy contribution if the water is below 0C hrain(n) = max((tocn(n) - shr_const_tkfrz), 0._r8) * rain(n) * shr_const_cpsw @@ -209,6 +225,8 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) hcond(n) = max((tocn(n) - shr_const_tkfrz), 0._r8) * max(evap(n), 0._r8) * shr_const_cpsw hrofl(n) = max((tocn(n) - shr_const_tkfrz), 0._r8) * rofl(n) * shr_const_cpsw hrofi(n) = min((tocn(n) - shr_const_tkfrz), 0._r8) * rofi(n) * shr_const_cpsw + hrofl_glc(n) = max((tocn(n) - shr_const_tkfrz), 0._r8) * rofl_glc(n) * shr_const_cpsw + hrofi_glc(n) = min((tocn(n) - shr_const_tkfrz), 0._r8) * rofi_glc(n) * shr_const_cpsw end do ! Determine enthalpy correction factor that will be added to the sensible heat flux sent to the atm @@ -220,7 +238,7 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) glob_area_inv = 1._r8 / (4._r8 * shr_const_pi) areas => is_local%wrap%mesh_info(compocn)%areas do n = 1,size(tocn) - hcorr(n) = (hrain(n) + hsnow(n) + hcond(n) + hevap(n) + hrofl(n) + hrofi(n)) * & + hcorr(n) = (hrain(n) + hsnow(n) + hcond(n) + hevap(n) + hrofl(n) + hrofi(n) + hrofl_glc(n) + hrofi_glc(n)) * & areas(n) * glob_area_inv end do call med_phases_prep_atm_enthalpy_correction(gcomp, hcorr, rc) @@ -266,6 +284,7 @@ subroutine med_phases_prep_ocn_avg(gcomp, rc) ! local variables type(InternalState) :: is_local integer :: ncnt + logical, save :: first_call = .true. character(len=*),parameter :: subname='(med_phases_prep_ocn_avg)' !--------------------------------------- @@ -306,9 +325,10 @@ subroutine med_phases_prep_ocn_avg(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Check for nans in fields export to ocn - call FB_check_for_nans(is_local%wrap%FBExp(compocn), maintask, logunit, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - + if(.not. first_call) then + call FB_check_for_nans(is_local%wrap%FBExp(compocn), maintask, logunit, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif ! zero accumulator is_local%wrap%ExpAccumOcnCnt = 0 call FB_reset(is_local%wrap%FBExpAccumOcn, value=czero, rc=rc) @@ -320,6 +340,7 @@ subroutine med_phases_prep_ocn_avg(gcomp, rc) call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end if call t_stopf('MED:'//subname) + first_call = .false. end subroutine med_phases_prep_ocn_avg diff --git a/mediator/med_phases_restart_mod.F90 b/mediator/med_phases_restart_mod.F90 index c85e703ef..eeaf50e10 100644 --- a/mediator/med_phases_restart_mod.F90 +++ b/mediator/med_phases_restart_mod.F90 @@ -302,7 +302,8 @@ subroutine med_phases_restart_write(gcomp, rc) trim(nexttimestr),'.nc' if (maintask) then - restart_pfile = "rpointer.cpl"//trim(cpl_inst_tag)//'.'//trim(nexttimestr) +! restart_pfile = "rpointer.cpl"//trim(cpl_inst_tag)//'.'//trim(nexttimestr) + restart_pfile = "rpointer.cpl"//trim(cpl_inst_tag) call ESMF_LogWrite(trim(subname)//" write rpointer file = "//trim(restart_pfile), ESMF_LOGMSG_INFO) open(newunit=unitn, file=restart_pfile, form='FORMATTED') write(unitn,'(a)') trim(restart_file) @@ -547,7 +548,8 @@ subroutine med_phases_restart_read(gcomp, rc) endif ! Get the restart file name from the pointer file - restart_pfile = "rpointer.cpl"//trim(cpl_inst_tag)//'.'//trim(currtimestr) +! restart_pfile = "rpointer.cpl"//trim(cpl_inst_tag)//'.'//trim(currtimestr) + restart_pfile = "rpointer.cpl"//trim(cpl_inst_tag) if (maintask) then call ESMF_LogWrite(trim(subname)//" read rpointer file = "//trim(restart_pfile), ESMF_LOGMSG_INFO) open(newunit=unitn, file=restart_pfile, form='FORMATTED', status='old', iostat=ierr)