diff --git a/.github/workflows/extbuild.yml b/.github/workflows/extbuild.yml index 8d2283d54..55e0f8f92 100644 --- a/.github/workflows/extbuild.yml +++ b/.github/workflows/extbuild.yml @@ -20,13 +20,13 @@ jobs: CPPFLAGS: "-I/usr/include -I/usr/local/include" # Versions of all dependencies can be updated here - ESMF_VERSION: v8.6.0 + ESMF_VERSION: v8.6.1 PNETCDF_VERSION: checkpoint.1.12.3 NETCDF_FORTRAN_VERSION: v4.6.1 PIO_VERSION: pio2_6_2 - CDEPS_VERSION: cdeps1.0.26 + CDEPS_VERSION: cdeps1.0.36 steps: - - uses: actions/checkout@v3 + - uses: actions/checkout@v4 # Build the ESMF library, if the cache contains a previous build # it will be used instead - id: load-env @@ -40,13 +40,13 @@ jobs: sudo apt-get install pnetcdf-bin libpnetcdf-dev sudo apt-get install autotools-dev autoconf - id: cache-esmf - uses: actions/cache@v3 + uses: actions/cache@v4 with: path: ~/ESMF key: ${{ runner.os }}-${{ env.ESMF_VERSION }}-ESMF - name: Cache ParallelIO id: cache-ParallelIO - uses: actions/cache@v3 + uses: actions/cache@v4 with: path: ~/pio key: ${{ runner.os }}-${{ env.PIO_VERSION }}.pio @@ -75,17 +75,21 @@ jobs: cache: true - name: Cache CDEPS id: cache-cdeps - uses: actions/cache@v3 + uses: actions/cache@v4 with: - path: $HOME/cdeps - key: ${{ runner.os }}-${{ env.CDEPS_VERSION }}.cdeps + path: /homme/runner/work/CMEPS/CMEPS/build-cdeps + key: ${{ runner.os }}-${{ env.CDEPS_VERSION }}.cdeps1 - name: checkout CDEPS - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: repository: ESCOMP/CDEPS path: cdeps-src ref: ${{ env.CDEPS_VERSION }} + - name: get genf90 + run: | + cd cdeps-src + git submodule update --init - name: Build CDEPS if: steps.cache-cdeps.outputs.cache-hit != 'true' uses: ESCOMP/CDEPS/.github/actions/buildcdeps@cdeps1.0.26 @@ -93,12 +97,13 @@ jobs: esmfmkfile: $ESMFMKFILE pio_path: ${GITHUB_WORKSPACE}/pio src_root: ${GITHUB_WORKSPACE}/cdeps-src - cmake_flags: " -Wno-dev -DCMAKE_BUILD_TYPE=DEBUG -DWERROR=ON -DCMAKE_Fortran_FLAGS=\"-DCPRGNU -g -Wall \ + cmake_flags: " -Wno-dev -DDISABLE_FoX=ON -DCMAKE_BUILD_TYPE=DEBUG -DWERROR=ON -DCMAKE_Fortran_FLAGS=\"-DCPRGNU -g -Wall \ -ffree-form -ffree-line-length-none -fallow-argument-mismatch \"" - name: Build CMEPS run: | - export PIO=${GITHUB_WORKSPACE}/pio + export PIO=$HOME/pio + export ESMFMKFILE=$HOME/ESMF/lib/libg/Linux.gfortran.64.openmpi.default/esmf.mk mkdir build-cmeps pushd build-cmeps cmake -DCMAKE_BUILD_TYPE=DEBUG -DCMAKE_Fortran_FLAGS="-g -Wall -Werror -ffree-form -ffree-line-length-none -Wno-unused-dummy-argument -I /home/runner/work/CMEPS/CMEPS/build-cdeps/share" ../ diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 1044661ba..efec7ba88 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -26,7 +26,7 @@ jobs: CPPFLAGS: "-I/usr/include -I/usr/local/include " LDFLAGS: "-L/usr/lib/x86_64-linux-gnu -lnetcdf -lnetcdff -lpnetcdf" # Versions of all dependencies can be updated here - ESMF_VERSION: v8.6.0 + ESMF_VERSION: v8.6.1 PARALLELIO_VERSION: pio2_6_2 CIME_MODEL: cesm CIME_DRIVER: nuopc @@ -64,13 +64,13 @@ jobs: run: pip install -r requirements.txt # use the latest cesm main - name: cesm checkout - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: repository: ESCOMP/CESM path: cesm # this cmeps commit - name: cmeps checkout - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: path: cesm/components/cmeps @@ -79,7 +79,7 @@ jobs: - name: checkout externals run: | pushd cesm - ./manage_externals/checkout_externals ccs_config cdeps share mct cpl7 parallelio + ./bin/git-fleximod update ccs_config cdeps share mct parallelio cd ccs_config git checkout main cd ../ @@ -94,72 +94,55 @@ jobs: git submodule update --init cd ../components/cdeps git checkout main + git submodule update --init + cd ../../share + git checkout main - name: Cache ESMF id: cache-esmf - uses: actions/cache@v3 + uses: actions/cache@v4 with: path: ~/ESMF - key: ${{ runner.os }}-${{ env.ESMF_VERSION }}-ESMF1 - # - name: cache pnetcdf - # id: cache-pnetcdf - # uses: actions/cache@v3 - # with: - # path: ~/pnetcdf - # key: ${{ runner.os }}-${{ env.PNETCDF_VERSION}}-pnetcdf - - # - name: Cache netcdf-fortran - # id: cache-netcdf-fortran - # uses: actions/cache@v3 - # with: - # path: ~/netcdf-fortran - # key: ${{ runner.os }}-${{ env.NETCDF_FORTRAN_VERSION }}-netcdf-fortran + key: ${{ runner.os }}-${{ env.ESMF_VERSION }} - name: Cache ParallelIO id: cache-ParallelIO - uses: actions/cache@v3 + uses: actions/cache@v4 with: - path: ~/pio + path: ${GITHUB_WORKSPACE}/pio key: ${{ runner.os }}-${{ env.PARALLELIO_VERSION }}.parallelio + - name: Cache inputdata id: cache-inputdata - uses: actions/cache@v3 + uses: actions/cache@v4 with: path: $HOME/cesm/inputdata key: inputdata - # - name: Build PNetCDF - # if: steps.cache-pnetcdf.outputs.cache-hit != 'true' - # uses: ESCOMP/CDEPS/.github/actions/buildpnetcdf@e06246b560d3132170bb1a5443fa3d65dfbd2040 - # with: - # pnetcdf_version: ${{ env.PNETCDF_VERSION }} - # install_prefix: $HOME/pnetcdf - # - name: Build NetCDF Fortran - # if: steps.cache-netcdf-fortran.outputs.cache-hit != 'true' - # uses: ESCOMP/CDEPS/.github/actions/buildnetcdff@e06246b560d3132170bb1a5443fa3d65dfbd2040 - # with: - # netcdf_fortran_version: ${{ env.NETCDF_FORTRAN_VERSION }} - # install_prefix: $HOME/netcdf-fortran - # netcdf_c_path: /usr + - name: Build ParallelIO if: steps.cache-PARALLELIO.outputs.cache-hit != 'true' uses: NCAR/ParallelIO/.github/actions/parallelio_cmake@05173a6556ea8d80eb34e3881a5014ea8f4b7543 with: parallelio_version: ${{ env.ParallelIO_VERSION }} enable_fortran: True - install_prefix: /home/runner/pio + install_prefix: ${GITHUB_WORKSPACE}/pio - - name: Build ESMF - if: steps.cache-esmf.outputs.cache-hit != 'true' - uses: ESCOMP/CDEPS/.github/actions/buildesmf@e06246b560d3132170bb1a5443fa3d65dfbd2040 + - name: Install ESMF + uses: esmf-org/install-esmf-action@v1 + env: + ESMF_COMPILER: gfortran + ESMF_BOPT: g + ESMF_COMM: openmpi + ESMF_NETCDF: nc-config + ESMF_PNETCDF: pnetcdf-config + ESMF_INSTALL_PREFIX: ${GITHUB_WORKSPACE}/ESMF + ESMF_PIO: external + ESMF_PIO_INCLUDE: ${GITHUB_WORKSPACE}/pio/include + ESMF_PIO_LIBPATH: ${GITHUB_WORKSPACE}/pio/lib with: - esmf_version: ${{ env.ESMF_VERSION }} - esmf_bopt: g - esmf_comm: openmpi - install_prefix: ~/ESMF - netcdf_c_path: /usr - netcdf_fortran_path: /usr - pnetcdf_path: /usr - parallelio_path: ~/pio + version: ${{ env.ESMF_VERSION }} + esmpy: false + cache: true - name: PREP for scripts regression test @@ -169,14 +152,13 @@ jobs: pushd $GITHUB_WORKSPACE/cesm/cime/CIME/tests export SRCROOT=$GITHUB_WORKSPACE/cesm/ export CIME_TEST_PLATFORM=ubuntu-latest - export PIO_INCDIR=$HOME/pio/include - export PIO_LIBDIR=$HOME/pio/lib + export PIO_INCDIR=$GITHUB_WORKSPACE/pio/include + export PIO_LIBDIR=$GITHUB_WORKSPACE/pio/lib export PIO_VERSION_MAJOR=2 export PIO_TYPENAME_VALID_VALUES="netcdf,pnetcdf" export NETCDF_PATH=/usr export PNETCDF_PATH=/usr export LD_LIBRARY_PATH=/usr/lib/libx86_64-linux-gnu/:$LD_LIBRARY_PATH - export ESMFMKFILE=$HOME/ESMF/lib/libg/Linux.gfortran.64.openmpi.default/esmf.mk cat <> $GITHUB_WORKSPACE/cesm/ccs_config/machines/cmake_macros/ubuntu-latest.cmake set(NetCDF_Fortran_INCLUDE_DIR /usr/include) set(NetCDF_Fortran_LIBRARY /usr/lib/x86_64-gnu-Linux/libnetcdff.so) diff --git a/cesm/driver/esm.F90 b/cesm/driver/esm.F90 index a8342f54c..e2ed64891 100644 --- a/cesm/driver/esm.F90 +++ b/cesm/driver/esm.F90 @@ -796,7 +796,6 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) #ifndef NO_MPI2 use mpi , only : MPI_COMM_NULL, mpi_comm_size #endif - use m_MCTWorld , only : mct_world_init => init #ifdef MED_PRESENT use med_internalstate_mod , only : med_id @@ -1164,9 +1163,6 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) enddo - call mct_world_init(componentCount+1, GLOBAL_COMM, comms, comps) - - deallocate(petlist, comms, comps, comp_iamin, comp_comm_iam) end subroutine 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 ff2553be7..bc8585d8c 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -106,7 +106,7 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): config["COMP_OCN"] = case.get_value("COMP_OCN") config["COMP_ROF"] = case.get_value("COMP_ROF") config["COMP_WAV"] = case.get_value("COMP_WAV") - config["CAMDEV"] = "True" if "CAM%DEV" in case.get_value("COMPSET") else "False" + config["CAMDEV"] = "True" if "CAM70" in case.get_value("COMPSET") else "False" if ( ( @@ -127,7 +127,7 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): elif case.get_value("RUN_TYPE") == "branch": config["run_type"] = "branch" - config['wav_ice_coupling'] = config['COMP_WAV'] == 'ww3dev' and config['COMP_ICE'] == 'cice' + config['wav_ice_coupling'] = 'ww3' in config['COMP_WAV'] and config['COMP_ICE'] == 'cice' # ---------------------------------------------------- # Initialize namelist defaults @@ -146,10 +146,10 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): if config["COMP_OCN"] == "docn" and "aqua" in case.get_value("DOCN_MODE"): nmlgen.set_value("aqua_planet", value=".true.") - # make sure that variable add_gusts is only set to true if compset includes cam_dev + # make sure that variable add_gusts is only set to true if compset includes cam7 physics add_gusts = literal_to_python_value(nmlgen.get_value("add_gusts"), type_="logical") if add_gusts: - expect("CAM%DEV" in case.get_value("COMPSET"),"ERROR: add_gusts can only be set if CAM%DEV in compset {}".format(case.get_value("COMPSET"))) + expect("CAM70" in case.get_value("COMPSET"),"ERROR: add_gusts can only be set if CAM70 in compset {}".format(case.get_value("COMPSET"))) # -------------------------------- # Overwrite: set component coupling frequencies diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index 938e0e31c..33add8b2b 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -1389,14 +1389,6 @@ rof2lnd flux mapping file - - char - idmap - run_domain - env_run.xml - rof2ocn flux mapping file - - char idmap @@ -1413,54 +1405,6 @@ rof2ocn runoff mapping file - - char - idmap - run_domain - env_run.xml - glc2ice runoff mapping file - - - - char - idmap - run_domain - env_run.xml - glc2ocn runoff mapping file for liquid runoff - - - - char - idmap - run_domain - env_run.xml - glc2ocn runoff mapping file for ice runoff - - - - char - idmap - run_domain - env_run.xml - ocn2wav state mapping file - - - - char - idmap - run_domain - env_run.xml - ice2wav state mapping file - - - - char - idmap - run_domain - env_run.xml - wav2ocn state mapping file - - char 1.0e-02 diff --git a/cime_config/config_component_cesm.xml b/cime_config/config_component_cesm.xml index a19814827..4dd12e1e4 100644 --- a/cime_config/config_component_cesm.xml +++ b/cime_config/config_component_cesm.xml @@ -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 @@ -190,14 +238,15 @@ 24 24 - - + 24 + 24 144 24 + 24 24 @@ -205,6 +254,7 @@ 24 48 48 + 48 @@ -279,6 +329,7 @@ $ATM_NCPL 24 + 24 1 24 24 @@ -303,6 +354,7 @@ $ATM_NCPL $ATM_NCPL 1 + 1 run_coupling env_run.xml @@ -336,11 +388,13 @@ 1 $ATM_NCPL + $ATM_NCPL $ATM_NCPL $ATM_NCPL 1 8 8 + 8 $ATM_NCPL 1 $ATM_NCPL @@ -372,13 +426,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 +474,15 @@ TIGHT,OPTION1,OPTION2 TIGHT - OPTION2 - OPTION2 - OPTION1 - OPTION1 - OPTION1 + OPTION2 + OPTION2 + OPTION1 + OPTION1 + OPTION1 + OPTION1 OPTION2 - OPTION2 - OPTION2 + OPTION2 + OPTION2 run_coupling env_run.xml @@ -482,7 +538,9 @@ TRUE TRUE + TRUE TRUE + TRUE TRUE TRUE diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 331ede173..2c191d4b1 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -620,19 +620,6 @@ - - char - flds - ALLCOMP_attributes - - if the ocean component sends fields at multiple ocean levels to the - land-ice component, these are the colon deliminted level indices - - - 1:10:19:26:30:33:35 - - - char control @@ -899,6 +886,28 @@ 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 @@ -2283,54 +2292,6 @@ - - char - mapping - abs - MED_attributes - - glc2ocn runoff mapping file for liquid runoff - - - $GLC2OCN_LIQ_RMAPNAME - - - - char - mapping - abs - MED_attributes - - glc to ice runoff conservative mapping file - - - $GLC2ICE_RMAPNAME - - - - char - mapping - abs - MED_attributes - - glc2ocn runoff mapping file for ice runoff - - - $GLC2OCN_ICE_RMAPNAME - - - - char - mapping - abs - MED_attributes - - runoff to ocn area overlap conservative mapping file - - - $ROF2OCN_FMAPNAME - - char mapping @@ -2355,42 +2316,6 @@ $ROF2OCN_ICE_RMAPNAME - - char - mapping - abs - MED_attributes - - ocn to wav state mapping file for states - - - $OCN2WAV_SMAPNAME - - - - char - mapping - abs - MED_attributes - - ice to wav state mapping file for states - - - $ICE2WAV_SMAPNAME - - - - char - mapping - abs - MED_attributes - - wav to ocn state mapping file for states - - - $WAV2OCN_SMAPNAME - - @@ -2515,6 +2440,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 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/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 335274d22..c9812759b 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -5,10 +5,49 @@ module esmFldsExchange_cesm_mod ! fields exchanged between components and their associated routing, ! mapping and merging ! - ! Merging arguments: - ! mrg_fromN = source component index that for the field to be merged - ! mrg_fldN = souce field name to be merged - ! mrg_typeN = merge type ('copy', 'copy_with_weights', 'sum', 'sum_with_weights', 'merge') + ! ----------------------------------------------------------------------------------------- + ! subroutine med_fldList_addmrg_to(index, fldname, mrg_from, mrg_fld, mrg_type, mrg_fracname, rc) + ! integer , intent(in) :: index + ! character(len=*), intent(in) :: fldname + ! integer , intent(in) :: mrg_from + ! character(len=*), intent(in) :: mrg_fld + ! character(len=*), intent(in) :: mrg_type + ! character(len=*), intent(in) , optional :: mrg_fracname + ! integer , intent(out), optional :: rc + ! + ! index : destination component index that merging will occur to + ! fldname : field name in mediator export field bundle for destination component + ! mrg_from : source component index that will contribute to the merge + ! mrg_fld : field name fom source component field bundle that will be used in merge + ! mrg_type : one of ['copy', 'copy_with_weights', 'sum', 'sum_with_weights', 'merge'] + ! mrg_fracname : if mrg_type is copy_with_weights or merge - + ! fraction name in fraction field bundle to use in merge + ! + ! ----------------------------------------------------------------------------------------- + ! subroutine med_fldList_addmap_from(index, fldname, destcomp, maptype, mapnorm, mapfile) + ! integer , intent(in) :: index + ! character(len=*) , intent(in) :: fldname + ! integer , intent(in) :: destcomp + ! integer , intent(in) :: maptype + ! character(len=*) , intent(in) :: mapnorm + ! character(len=*) , intent(in), optional :: mapfile + ! + ! index : source component index that mapping will occur from + ! fldname : field name in mediator import field for source component + ! destcomp : destination component index + ! maptype : mapping type (see med_internal_state_mod.F90 for the supported mapping types) + ! if maptype is mapfcopy - create a redistribution route handle + ! mapnorm : normalization type, one of ['unset', 'one', 'none', fracname] + ! fracname - is the field name of the field in the fraction field bundle corresponding to the + ! source field that will be used for normalization + ! 'one' - implies that the mapped field is divided by mapping 'one' from the source to the + ! destination mesh + ! 'none' - do not use any normalization - use if maytype is not mapfcopy + ! 'unset' - do not use any normalization - only used if maptype is mapfcopy + ! mapfile : if mapfile is idmap - create a redistribution route nhandle + ! if mapfile is unset then create the mapping route handle at run time + ! + ! ----------------------------------------------------------------------------------------- ! NOTE: ! mrg_from(compmed) can either be for mediator computed fields for atm/ocn fluxes or for ocn albedos ! @@ -20,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 @@ -28,26 +70,23 @@ module esmFldsExchange_cesm_mod public :: esmFldsExchange_cesm ! currently required mapping files - character(len=CX) :: glc2ice_rmap ='unset' - character(len=CX) :: glc2ocn_liq_rmap ='unset' - character(len=CX) :: glc2ocn_ice_rmap ='unset' - character(len=CX) :: rof2ocn_fmap ='unset' character(len=CX) :: rof2ocn_ice_rmap ='unset' character(len=CX) :: rof2ocn_liq_rmap ='unset' - character(len=CX) :: wav2ocn_smap ='unset' - character(len=CX) :: ice2wav_smap ='unset' - character(len=CX) :: ocn2wav_smap ='unset' + character(len=CX) :: rof2lnd_map = 'unset' + character(len=CX) :: lnd2rof_map = 'unset' ! no mapping files (value is 'idmap' or 'unset') - character(len=CX) :: atm2ice_map='unset' - character(len=CX) :: atm2ocn_map='unset' - character(len=CX) :: atm2lnd_map='unset' - character(len=CX) :: ice2atm_map='unset' - character(len=CX) :: ocn2atm_map='unset' - character(len=CX) :: lnd2atm_map='unset' - character(len=CX) :: lnd2rof_map='unset' - character(len=CX) :: rof2lnd_map='unset' - character(len=CX) :: atm2wav_map='unset' + character(len=CX) :: atm2ice_map = 'unset' + character(len=CX) :: atm2ocn_map = 'unset' + character(len=CX) :: atm2lnd_map = 'unset' + character(len=CX) :: atm2wav_map = 'unset' + character(len=CX) :: ice2atm_map = 'unset' + character(len=CX) :: ice2wav_map = 'unset' + character(len=CX) :: lnd2atm_map = 'unset' + character(len=CX) :: ocn2atm_map = 'unset' + character(len=CX) :: ocn2wav_map = 'unset' + character(len=CX) :: rof2ocn_map = 'unset' + character(len=CX) :: wav2ocn_map = 'unset' logical :: mapuv_with_cart3d ! Map U/V vector wind fields from ATM to OCN/ICE by rotating in Cartesian 3D space and then back logical :: flds_i2o_per_cat ! Ice thickness category fields passed to OCN @@ -76,12 +115,11 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) use med_internalstate_mod , only : compice, comprof, compwav, compglc, ncomps use med_internalstate_mod , only : mapbilnr, mapconsf, mapconsd, mappatch, mappatch_uv3d, mapbilnr_nstod use med_internalstate_mod , only : mapfcopy, mapnstod, mapnstod_consd, mapnstod_consf - use med_internalstate_mod , only : map_glc2ocn_ice, map_glc2ocn_liq, map_rof2ocn_ice, map_rof2ocn_liq + use med_internalstate_mod , only : map_rof2ocn_ice, map_rof2ocn_liq use esmFlds , only : addfld_ocnalb => med_fldList_addfld_ocnalb use esmFlds , only : addfld_aoflux => med_fldList_addfld_aoflux use esmFlds , only : addmap_aoflux => med_fldList_addmap_aoflux use esmFlds , only : addmap_ocnalb => med_fldList_addmap_ocnalb - use esmFlds , only : addfld_to => med_fldList_addfld_to use esmFlds , only : addfld_from => med_fldList_addfld_from use esmFlds , only : addmap_from => med_fldList_addmap_from @@ -95,7 +133,12 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! local variables: type(InternalState) :: is_local integer :: n, ns + character(len=CL) :: atm_mesh_name + character(len=CL) :: lnd_mesh_name + character(len=CL) :: ice_mesh_name + character(len=CL) :: ocn_mesh_name character(len=CL) :: cvalue + character(len=CS) :: mrgfld_source logical :: wav_coupling_to_cice logical :: ocn2glc_coupling character(len=*) , parameter :: subname=' (esmFldsExchange_cesm) ' @@ -121,51 +164,37 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (phase == 'advertise') then - ! mapping to atm - call NUOPC_CompAttributeGet(gcomp, name='ice2atm_map', value=ice2atm_map, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (maintask) write(logunit, '(a)') trim(subname)//'ice2atm_map = '// trim(ice2atm_map) - call NUOPC_CompAttributeGet(gcomp, name='lnd2atm_map', value=lnd2atm_map, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (maintask) write(logunit, '(a)') trim(subname)//'lnd2atm_map = '// trim(lnd2atm_map) - call NUOPC_CompAttributeGet(gcomp, name='ocn2atm_map', value=ocn2atm_map, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (maintask) write(logunit, '(a)') trim(subname)//'ocn2atm_map = '// trim(ocn2atm_map) + ! determine if atm and lnd have the same mesh + call NUOPC_CompAttributeGet(gcomp, name='mesh_atm', value=atm_mesh_name, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(gcomp, name='mesh_lnd', value=lnd_mesh_name, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(gcomp, name='mesh_ice', value=ice_mesh_name, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(gcomp, name='mesh_ocn', value=ocn_mesh_name, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (trim(atm_mesh_name) == trim(lnd_mesh_name)) then + atm2lnd_map = 'idmap' + lnd2atm_map = 'idmap' + end if + if (trim(atm_mesh_name) == trim(ocn_mesh_name)) then + atm2ocn_map = 'idmap' + ocn2atm_map = 'idmap' + end if + if (trim(atm_mesh_name) == trim(ice_mesh_name)) then + atm2ice_map = 'idmap' + ice2atm_map = 'idmap' + end if - ! mapping to lnd - call NUOPC_CompAttributeGet(gcomp, name='atm2lnd_map', value=atm2lnd_map, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (maintask) write(logunit, '(a)') trim(subname)//'atm2lnd_map = '// trim(atm2lnd_map) + ! mapping rof=>lnd and lnd=>rof - the following two maps are needed for MIZUROUTE call NUOPC_CompAttributeGet(gcomp, name='rof2lnd_map', value=rof2lnd_map, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (maintask) write(logunit, '(a)') trim(subname)//'rof2lnd_map = '// trim(rof2lnd_map) - - ! mapping to ice - call NUOPC_CompAttributeGet(gcomp, name='atm2ice_map', value=atm2ice_map, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (maintask) write(logunit, '(a)') trim(subname)//'atm2ice_map = '// trim(atm2ice_map) - call NUOPC_CompAttributeGet(gcomp, name='glc2ice_rmapname', value=glc2ice_rmap, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (maintask) write(logunit, '(a)') trim(subname)//'glc2ice_rmapname = '// trim(glc2ice_rmap) - - ! mapping to ocn - call NUOPC_CompAttributeGet(gcomp, name='atm2ocn_map', value=atm2ocn_map, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (maintask) write(logunit, '(a)') trim(subname)//'atm2ocn_map = '// trim(atm2ocn_map) - call NUOPC_CompAttributeGet(gcomp, name='glc2ocn_liq_rmapname', value=glc2ocn_liq_rmap, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (maintask) write(logunit, '(a)') trim(subname)//'glc2ocn_liq_rmapname = '// trim(glc2ocn_liq_rmap) - call NUOPC_CompAttributeGet(gcomp, name='glc2ocn_ice_rmapname', value=glc2ocn_ice_rmap, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (maintask) write(logunit, '(a)') trim(subname)//'glc2ocn_ice_rmapname = '// trim(glc2ocn_ice_rmap) - call NUOPC_CompAttributeGet(gcomp, name='wav2ocn_smapname', value=wav2ocn_smap, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (maintask) write(logunit, '(a)') trim(subname)//'wav2ocn_smapname = '// trim(wav2ocn_smap) - - call NUOPC_CompAttributeGet(gcomp, name='rof2ocn_fmapname', value=rof2ocn_fmap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='lnd2rof_map', value=lnd2rof_map, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (maintask) write(logunit, '(a)') trim(subname)//'rof2ocn_fmapname = '// trim(rof2ocn_fmap) + if (maintask) write(logunit, '(a)') trim(subname)//'lnd2rof_map = '// trim(lnd2rof_map) + ! mapping to rof => ocn with custom mapping call NUOPC_CompAttributeGet(gcomp, name='rof2ocn_liq_rmapname', value=rof2ocn_liq_rmap, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (maintask) write(logunit, '(a)') trim(subname)//'rof2ocn_liq_rmapname = '// trim(rof2ocn_liq_rmap) @@ -173,23 +202,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (maintask) write(logunit, '(a)') trim(subname)//'rof2ocn_ice_rmapname = '// trim(rof2ocn_ice_rmap) - ! mapping to rof - call NUOPC_CompAttributeGet(gcomp, name='lnd2rof_map', value=lnd2rof_map, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (maintask) write(logunit, '(a)') trim(subname)//'lnd2rof_map = '// trim(lnd2rof_map) - - ! mapping to wav - call NUOPC_CompAttributeGet(gcomp, name='atm2wav_map', value=atm2wav_map, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (maintask) write(logunit,'(a)') trim(subname)//'atm2wav_map = '// trim(atm2wav_map) - - call NUOPC_CompAttributeGet(gcomp, name='ice2wav_smapname', value=ice2wav_smap, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (maintask) write(logunit,'(a)') trim(subname)//'ice2wav_smapname = '// trim(ice2wav_smap) - call NUOPC_CompAttributeGet(gcomp, name='ocn2wav_smapname', value=ocn2wav_smap, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (maintask) write(logunit,'(a)') trim(subname)//'ocn2wav_smapname = '// trim(ocn2wav_smap) - ! uv cart3d mapping call NUOPC_CompAttributeGet(gcomp, name='mapuv_with_cart3d', value=cvalue, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -215,13 +227,19 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call NUOPC_CompAttributeGet(gcomp, name='flds_wiso', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) flds_wiso - ! are water isotope exchanges enabled? + call NUOPC_CompAttributeGet(gcomp, name='flds_r2l_stream_channel_depths', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) flds_r2l_stream_channel_depths ! write diagnostic output if (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 @@ -465,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 @@ -805,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) @@ -832,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) @@ -859,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) @@ -886,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) @@ -918,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) @@ -945,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) @@ -972,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) @@ -1000,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) @@ -1034,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) @@ -1061,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) @@ -1088,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) @@ -1116,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) @@ -1152,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) @@ -1179,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) @@ -1206,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) @@ -1233,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) @@ -1260,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) @@ -1287,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) @@ -1315,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) @@ -1347,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) @@ -1418,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 @@ -1508,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 @@ -1518,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 @@ -1528,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') @@ -1541,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) ! --------------------------------------------------------------------- @@ -1554,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 !----------------------------------------------------------------------------- @@ -1568,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, 'one', atm2lnd_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 !----------------------------------------------------------------------------- @@ -1583,9 +1630,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Fall_fire', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compatm) , 'Fall_fire', rc=rc)) then - call addmap_from(complnd, 'Fall_fire', compatm, mapconsf, 'one', lnd2atm_map) + 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' @@ -1595,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, 'one', 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 !----------------------------------------------------------------------------- @@ -1608,11 +1657,96 @@ 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, 'one', 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: surface flux of dms from ocean + !----------------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld_from(compocn, 'Faoo_fdms_ocn') + call addfld_to(compatm, 'Faoo_fdms_ocn') + else + 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 + !===================================================================== ! FIELDS TO OCEAN (compocn) !===================================================================== @@ -1970,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 @@ -2204,134 +2364,94 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if !----------------------------- - ! to ocn: liquid runoff from rof and glc components - ! to ocn: frozen runoff flux from rof and glc components + ! to ocn: liquid runoff from rof originating from lnd + ! to ocn: liquid runoff from rof originating from glc + ! to ocn: ice runoff from rof originating from lnd + ! to ocn: ice runoff from rof originating from glc ! to ocn: waterflux back to ocn due to flooding from rof !----------------------------- if (phase == 'advertise') then ! Note that Flrr_flood below needs to be added to - ! fldlistFr(comprof) in order to be mapped correctly but the ocean - ! does not receive it so it is advertised but it will! not be connected - do ns = 1, is_local%wrap%num_icesheets - call addfld_from(compglc(ns), 'Fogg_rofl') - end do + ! fldlistFr(comprof) in order to be mapped correctly to the ocean but the ocean + ! does not receive it so it is advertised but it will not be connected call addfld_from(comprof, 'Forr_rofl') - call addfld_to(compocn, 'Foxx_rofl') - call addfld_to(compocn, 'Flrr_flood') - do ns = 1, is_local%wrap%num_icesheets - call addfld_from(compglc(ns), 'Fogg_rofi') - end do call addfld_from(comprof, 'Forr_rofi') + call addfld_from(comprof, 'Forr_rofl_glc') + call addfld_from(comprof, 'Forr_rofi_glc') + call addfld_to(compocn, 'Foxx_rofl') call addfld_to(compocn, 'Foxx_rofi') + call addfld_to(compocn, 'Forr_rofl_glc') + call addfld_to(compocn, 'Forr_rofi_glc') + call addfld_to(compocn, 'Flrr_flood') else - if ( fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofl' , rc=rc)) then - ! liquid from river and possibly flood from river to ocean - if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofl' , rc=rc)) then - if (trim(rof2ocn_liq_rmap) == 'unset') then - call addmap_from(comprof, 'Forr_rofl', compocn, mapconsd, 'one', 'unset') - else - call addmap_from(comprof, 'Forr_rofl', compocn, map_rof2ocn_liq, 'none', rof2ocn_liq_rmap) - end if - if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_flood', rc=rc)) then - call addmap_from(comprof, 'Flrr_flood', compocn, mapconsd, 'one', rof2ocn_fmap) - call addmrg_to(compocn, 'Foxx_rofl', mrg_from=comprof, mrg_fld='Forr_rofl:Flrr_flood', mrg_type='sum') - else - call addmrg_to(compocn, 'Foxx_rofl', mrg_from=comprof, mrg_fld='Forr_rofl', mrg_type='sum') - end if + ! Liquid runoff from land and glc - mapping + if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofl' , rc=rc)) then + if ( fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofl' , rc=rc)) then + if (trim(rof2ocn_liq_rmap) == 'unset') then + call addmap_from(comprof, 'Forr_rofl', compocn, mapconsd, 'one', 'unset') + else + call addmap_from(comprof, 'Forr_rofl', compocn, map_rof2ocn_liq, 'none', rof2ocn_liq_rmap) end if - ! liquid from glc to ocean - do ns = 1, is_local%wrap%num_icesheets - if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Fogg_rofl' , rc=rc)) then - ! TODO: this custom map needs to be different for every ice sheet - how will this be handled? - call addmap_from(compglc(ns), 'Fogg_rofl', compocn, map_glc2ocn_liq, 'one' , glc2ocn_liq_rmap) - call addmrg_to(compocn, 'Foxx_rofl', mrg_from=compglc(ns), mrg_fld='Fogg_rofl', mrg_type='sum') - end if - end do - end if - if ( fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofi' , rc=rc)) then - ! ice from river to ocean - if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofi' , rc=rc)) then - if (trim(rof2ocn_ice_rmap) == 'unset') then - call addmap_from(comprof, 'Forr_rofi', compocn, mapconsd, 'one', 'unset') - else - call addmap_from(comprof, 'Forr_rofi', compocn, map_rof2ocn_ice, 'none', rof2ocn_ice_rmap) - end if - call addmrg_to(compocn, 'Foxx_rofi', mrg_from=comprof, mrg_fld='Forr_rofi', mrg_type='sum') + end if + end if + if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_flood', rc=rc)) then + if ( fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofl' , rc=rc)) then + call addmap_from(comprof, 'Flrr_flood', compocn, mapconsd, 'one', rof2ocn_map) + end if + end if + if ( fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofl_glc', rc=rc)) then + if (fldchk(is_local%wrap%FBExp(compocn), 'Forr_rofl_glc', rc=rc) .or. & + fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofl', rc=rc)) then + if (trim(rof2ocn_liq_rmap) == 'unset') then + call addmap_from(comprof, 'Forr_rofl_glc', compocn, mapconsd, 'one', 'unset') + else + call addmap_from(comprof, 'Forr_rofl_glc', compocn, map_rof2ocn_liq, 'none', rof2ocn_liq_rmap) end if - ! ice from glc to ocean - do ns = 1, is_local%wrap%num_icesheets - if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Fogg_rofi' , rc=rc)) then - ! TODO: this custom map needs to be different for every ice sheet - how will this be handled? - call addmap_from(compglc(ns), 'Fogg_rofi', compocn, map_glc2ocn_ice, 'one', glc2ocn_ice_rmap) - call addmrg_to(compocn, 'Foxx_rofi', mrg_from=compglc(ns), mrg_fld='Fogg_rofi', mrg_type='sum') - end if - end do - end if - end if + end if + end if - if (flds_wiso) then - if (phase == 'advertise') then - do ns = 1, is_local%wrap%num_icesheets - call addfld_from(compglc(ns), 'Fogg_rofl_wiso') - end do - call addfld_from(comprof, 'Forr_rofl_wiso') - call addfld_to(compocn, 'Foxx_rofl_wiso') - call addfld_to(compocn, 'Flrr_flood_wiso') - do ns = 1, is_local%wrap%num_icesheets - call addfld_from(compglc(ns), 'Fogg_rofi_wiso') - end do - call addfld_from(comprof, 'Forr_rofi_wiso') - call addfld_to(compocn, 'Foxx_rofi_wiso') - else - if ( fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofl_wiso' , rc=rc)) then - ! liquid from river and possibly flood from river to ocean - if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofl_wiso' , rc=rc)) then - if (trim(rof2ocn_liq_rmap) == 'unset') then - call addmap_from(comprof, 'Forr_rofl_wiso', compocn, mapconsd, 'none', 'unset') - else - call addmap_from(comprof, 'Forr_rofl_wiso', compocn, map_rof2ocn_liq, 'none', rof2ocn_liq_rmap) - end if - if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_flood_wiso', rc=rc)) then - call addmap_from(comprof, 'Flrr_flood_wiso', compocn, mapconsd, 'one', rof2ocn_fmap) - call addmrg_to(compocn, 'Foxx_rofl_wiso', & - mrg_from=comprof, mrg_fld='Forr_rofl:Flrr_flood', mrg_type='sum') - else - call addmrg_to(compocn, 'Foxx_rofl_wiso', & - mrg_from=comprof, mrg_fld='Forr_rofl', mrg_type='sum') - end if - end if - ! liquid from glc to ocean - do ns = 1, is_local%wrap%num_icesheets - if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Fogg_rofl_wiso' , rc=rc)) then - ! TODO: this custom map needs to be different for every ice sheet - how will this be handled? - call addmap_from(compglc(ns), 'Fogg_rofl_wiso', compocn, map_glc2ocn_liq, 'one' , glc2ocn_liq_rmap) - call addmrg_to(compocn, 'Foxx_rofl_wiso', & - mrg_from=compglc(ns), mrg_fld='Fogg_rofl_wiso', mrg_type='sum') - end if - end do - end if - if ( fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofi_wiso' , rc=rc)) then - ! ice from river to ocean - if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofi_wiso' , rc=rc)) then - if (trim(rof2ocn_ice_rmap) == 'unset') then - call addmap_from(comprof, 'Forr_rofi_wiso', compocn, mapconsd, 'none', 'unset') - else - call addmap_from(comprof, 'Forr_rofi_wiso', compocn, map_rof2ocn_ice, 'none', rof2ocn_ice_rmap) - end if - call addmrg_to(compocn, 'Foxx_rofi_wiso', mrg_from=comprof, mrg_fld='Forr_rofi', mrg_type='sum') - end if - ! ice from glc to ocean - do ns = 1, is_local%wrap%num_icesheets - if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Fogg_rofi_wiso' , rc=rc)) then - ! TODO: this custom map needs to be different for every ice sheet - how will this be handled? - call addmap_from(compglc(ns), 'Fogg_rofi_wiso', compocn, map_glc2ocn_ice, 'one', glc2ocn_ice_rmap) - call addmrg_to(compocn, 'Foxx_rofi_wiso', & - mrg_from=compglc(ns), mrg_fld='Fogg_rofi_wiso', mrg_type='sum') - end if - end do + ! Liquid runoff from land and glc - merging + if ( fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofl' , rc=rc)) then + mrgfld_source = 'Forr_rofl' + if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_flood', rc=rc)) then + mrgfld_source = trim(mrgfld_source) //':Flrr_flood' + end if + if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofl_glc', rc=rc)) then + mrgfld_source = trim(mrgfld_source) //':Forr_rofl_glc' + end if + call addmrg_to(compocn, 'Foxx_rofl', mrg_from=comprof, mrg_fld=trim(mrgfld_source), mrg_type='sum') + end if + + ! Frozen runoff from land and glc - mapping + if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofi' , rc=rc)) then + if ( fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofi' , rc=rc)) then + if (trim(rof2ocn_ice_rmap) == 'unset') then + call addmap_from(comprof, 'Forr_rofi', compocn, mapconsd, 'one', 'unset') + else + call addmap_from(comprof, 'Forr_rofi', compocn, map_rof2ocn_ice, 'none', rof2ocn_ice_rmap) end if - end if + end if + end if + if ( fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofi_glc', rc=rc)) then + if (fldchk(is_local%wrap%FBExp(compocn), 'Forr_rofi_glc', rc=rc) .or. & + fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofi', rc=rc)) then + if (trim(rof2ocn_ice_rmap) == 'unset') then + call addmap_from(comprof, 'Forr_rofi_glc', compocn, mapconsd, 'one', 'unset') + else + call addmap_from(comprof, 'Forr_rofi_glc', compocn, map_rof2ocn_ice, 'none', rof2ocn_ice_rmap) + end if + end if + end if + + ! Frozen runoff from land and glc - merging + if ( fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofi' , rc=rc)) then + mrgfld_source = 'Forr_rofi' + if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofi_glc', rc=rc)) then + mrgfld_source = trim(mrgfld_source) //':Forr_rofi_glc' + end if + call addmrg_to(compocn, 'Foxx_rofi', mrg_from=comprof, mrg_fld=trim(mrgfld_source), mrg_type='sum') + end if end if !----------------------------- @@ -2367,7 +2487,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_lamult', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_lamult', rc=rc)) then - call addmap_from(compwav, 'Sw_lamult', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmap_from(compwav, 'Sw_lamult', compocn, mapbilnr_nstod, 'one', wav2ocn_map) call addmrg_to(compocn, 'Sw_lamult', mrg_from=compwav, mrg_fld='Sw_lamult', mrg_type='copy') end if end if @@ -2380,7 +2500,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_ustokes', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_ustokes', rc=rc)) then - call addmap_from(compwav, 'Sw_ustokes', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmap_from(compwav, 'Sw_ustokes', compocn, mapbilnr_nstod, 'one', wav2ocn_map) call addmrg_to(compocn, 'Sw_ustokes', mrg_from=compwav, mrg_fld='Sw_ustokes', mrg_type='copy') end if end if @@ -2393,7 +2513,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_vstokes', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_vstokes', rc=rc)) then - call addmap_from(compwav, 'Sw_vstokes', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmap_from(compwav, 'Sw_vstokes', compocn, mapbilnr_nstod, 'one', wav2ocn_map) call addmrg_to(compocn, 'Sw_vstokes', mrg_from=compwav, mrg_fld='Sw_vstokes', mrg_type='copy') end if end if @@ -2406,7 +2526,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_hstokes', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_hstokes', rc=rc)) then - call addmap_from(compwav, 'Sw_hstokes', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmap_from(compwav, 'Sw_hstokes', compocn, mapbilnr_nstod, 'one', wav2ocn_map) call addmrg_to(compocn, 'Sw_hstokes', mrg_from=compwav, mrg_fld='Sw_hstokes', mrg_type='copy') end if end if @@ -2419,7 +2539,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_pstokes_x', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_pstokes_x', rc=rc)) then - call addmap_from(compwav, 'Sw_pstokes_x', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmap_from(compwav, 'Sw_pstokes_x', compocn, mapbilnr_nstod, 'one', wav2ocn_map) call addmrg_to(compocn, 'Sw_pstokes_x', mrg_from=compwav, mrg_fld='Sw_pstokes_x', mrg_type='copy') end if end if @@ -2432,7 +2552,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_pstokes_y', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_pstokes_y', rc=rc)) then - call addmap_from(compwav, 'Sw_pstokes_y', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmap_from(compwav, 'Sw_pstokes_y', compocn, mapbilnr_nstod, 'one', wav2ocn_map) call addmrg_to(compocn, 'Sw_pstokes_y', mrg_from=compwav, mrg_fld='Sw_pstokes_y', mrg_type='copy') end if end if @@ -2875,54 +2995,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if - ! --------------------------------------------------------------------- - ! to ice: frozen runoff from rof and glc - ! --------------------------------------------------------------------- - if (phase == 'advertise') then - call addfld_from(comprof, 'Firr_rofi') ! water flux into sea ice due to runoff (frozen) - do ns = 1, is_local%wrap%num_icesheets - call addfld_from(compglc(ns), 'Figg_rofi') ! glc frozen runoff_iceberg flux to ice - end do - call addfld_to(compice, 'Fixx_rofi') ! total frozen water flux into sea ice - else - if ( fldchk(is_local%wrap%FBExp(compice), 'Fixx_rofi', rc=rc)) then - if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofi', rc=rc)) then - call addmap_from(comprof, 'Forr_rofi', compice, mapconsf, 'none', rof2ocn_ice_rmap) - call addmrg_to(compice, 'Fixx_rofi', mrg_from=comprof, mrg_fld='Firr_rofi', mrg_type='sum') - end if - do ns = 1, is_local%wrap%num_icesheets - if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Figg_rofi', rc=rc)) then - call addmap_from(compglc(ns), 'Figg_rofi', compice, mapconsf, 'one' , glc2ice_rmap) - call addmrg_to(compice, 'Fixx_rofi', mrg_from=compglc(ns), mrg_fld='Figg_rofi', mrg_type='sum') - end if - end do - end if - end if - if (flds_wiso) then - if (phase == 'advertise') then - call addfld_from(comprof, 'Firr_rofi_wiso') ! water flux into sea ice due to runoff (frozen) - do ns = 1, is_local%wrap%num_icesheets - call addfld_from(compglc(ns), 'Figg_rofi_wiso') ! glc frozen runoff_iceberg flux to ice - end do - call addfld_to(compice, 'Fixx_rofi_wiso') ! total frozen water flux into sea ice - else - if ( fldchk(is_local%wrap%FBExp(compice), 'Fixx_rofi_wiso', rc=rc)) then - if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofi_wiso', rc=rc)) then - call addmap_from(comprof, 'Forr_rofi_wiso', compice, mapconsf, 'none', rof2ocn_ice_rmap) - call addmrg_to(compice, 'Fixx_rofi_wiso', & - mrg_from=comprof, mrg_fld='Firr_rofi_wiso', mrg_type='sum') - end if - do ns = 1, is_local%wrap%num_icesheets - if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Figg_rofi_wiso', rc=rc)) then - call addmap_from(compglc(ns), 'Figg_rofi_wiso', compice, mapconsf, 'one' , glc2ice_rmap) - call addmrg_to(compice, 'Fixx_rofi_wiso', & - mrg_from=compglc(ns), mrg_fld='Figg_rofi_wiso', mrg_type='sum') - end if - end do - end if - end if - end if - ! --------------------------------------------------------------------- ! to ice: wave elevation spectrum (field with ungridded dimensions) ! --------------------------------------------------------------------- @@ -2933,7 +3005,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 @@ -2954,7 +3026,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if ( fldchk(is_local%wrap%FBexp(compwav) , 'Si_ifrac', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_ifrac', rc=rc)) then ! By default will be using a custom map - but if one is not available, use a generated bilinear instead - call addmap_from(compice, 'Si_ifrac', compwav, mapbilnr, 'one', ice2wav_smap) + call addmap_from(compice, 'Si_ifrac', compwav, mapbilnr, 'one', ice2wav_map) call addmrg_to(compwav, 'Si_ifrac', mrg_from=compice, mrg_fld='Si_ifrac', mrg_type='copy') end if end if @@ -2968,7 +3040,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) 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_smap) + 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 @@ -2983,7 +3055,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if (fldchk(is_local%wrap%FBexp(compwav) , 'Si_floediam', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_floediam', rc=rc)) then - call addmap_from(compice, 'Si_floediam', compwav, mapbilnr, 'one', ice2wav_smap) + call addmap_from(compice, 'Si_floediam', compwav, mapbilnr, 'one', ice2wav_map) call addmrg_to(compwav, 'Si_floediam', mrg_from=compice, mrg_fld='Si_floediam', mrg_type='copy') end if end if @@ -2997,8 +3069,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBImp(compocn, compocn), 'So_t', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compwav) , 'So_t', rc=rc)) then - ! By default will be using a custom map - but if one is not available, use a generated bilinear instead - call addmap_from(compocn, 'So_t', compwav, mapbilnr, 'one', ocn2wav_smap) + call addmap_from(compocn, 'So_t', compwav, mapbilnr, 'one', ocn2wav_map) call addmrg_to(compwav, 'So_t', mrg_from=compocn, mrg_fld='So_t', mrg_type='copy') end if end if @@ -3012,7 +3083,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if ( fldchk(is_local%wrap%FBImp(compocn, compocn), 'So_u', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compwav) , 'So_u', rc=rc)) then ! By default will be using a custom map - but if one is not available, use a generated bilinear instead - call addmap_from(compocn, 'So_u', compwav, mapbilnr, 'one', ocn2wav_smap) + call addmap_from(compocn, 'So_u', compwav, mapbilnr, 'one', ocn2wav_map) call addmrg_to(compwav, 'So_u', mrg_from=compocn, mrg_fld='So_u', mrg_type='copy') end if end if @@ -3023,7 +3094,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if ( fldchk(is_local%wrap%FBImp(compocn, compocn), 'So_v', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compwav) , 'So_v', rc=rc)) then ! By default will be using a custom map - but if one is not available, use a generated bilinear instead - call addmap_from(compocn, 'So_v', compwav, mapbilnr, 'one', ocn2wav_smap) + call addmap_from(compocn, 'So_v', compwav, mapbilnr, 'one', ocn2wav_map) call addmrg_to(compwav, 'So_v', mrg_from=compocn, mrg_fld='So_v', mrg_type='copy') end if end if @@ -3038,7 +3109,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if ( fldchk(is_local%wrap%FBImp(compocn, compocn), 'So_bldepth', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compwav) , 'So_bldepth', rc=rc)) then ! By default will be using a custom map - but if one is not available, use a generated bilinear instead - call addmap_from(compocn, 'So_bldepth', compwav, mapbilnr, 'one', ocn2wav_smap) + call addmap_from(compocn, 'So_bldepth', compwav, mapbilnr, 'one', ocn2wav_map) call addmrg_to(compwav, 'So_bldepth', mrg_from=compocn, mrg_fld='So_bldepth', mrg_type='copy') end if end if @@ -3107,6 +3178,51 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! FIELDS TO RIVER (comprof) !===================================================================== + ! --------------------------------------------------------------------- + ! to rof: liquid and ice from glc + ! --------------------------------------------------------------------- + do ns = 1, is_local%wrap%num_icesheets + if (phase == 'advertise') then + call addfld_from(compglc(ns), 'Fgrg_rofl') + call addfld_from(compglc(ns), 'Fgrg_rofi') + call addfld_to(comprof, 'Fgrg_rofl') + call addfld_to(comprof, 'Fgrg_rofi') + else + ! Note: we are assuming that the rof mesh has a mask of one everywhere + if ( fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Fgrg_rofl', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(comprof) , 'Fgrg_rofl', rc=rc)) then + call addmap_from(compglc(ns), 'Fgrg_rofl', comprof, mapconsd, 'gfrac' , 'unset') + ! Custom merge in med_phases_prep_rof + end if + if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Fgrg_rofi', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(comprof) , 'Fgrg_rofi', rc=rc)) then + call addmap_from(compglc(ns), 'Fgrg_rofi', comprof, mapconsd, 'gfrac', 'unset') + ! Custom merge in med_phases_prep_rof + end if + end if + end do + + ! --------------------------------------------------------------------- + ! to rof: liquid and ice from glc water isoptopes + ! --------------------------------------------------------------------- + do ns = 1, is_local%wrap%num_icesheets + if (phase == 'advertise') then + call addfld_from(compglc(ns), 'Fgrg_rofl_wiso') + call addfld_from(compglc(ns), 'Fgrg_rofi_wiso') + call addfld_to(comprof, 'Fgrg_rofl_wiso') + call addfld_to(comprof, 'Fgrg_rofi_wiso') + else + if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Fgrg_rofl_wiso' , rc=rc)) then + call addmap_from(compglc(ns), 'Fgrg_rofl_wiso', comprof, mapconsd, 'one' , 'unset') + ! TODO: implement custom merge + end if + if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Fgrg_rofi_wiso' , rc=rc)) then + call addmap_from(compglc(ns), 'Fgrg_rofi_wiso', comprof, mapconsd, 'one', 'unset') + ! TODO: implement custom merge + end if + end if + end do + ! --------------------------------------------------------------------- ! to rof: water flux from land (liquid surface) ! --------------------------------------------------------------------- @@ -3116,9 +3232,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 @@ -3131,9 +3247,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 @@ -3146,9 +3262,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 @@ -3161,9 +3277,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 @@ -3176,9 +3292,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 @@ -3208,14 +3324,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 @@ -3223,7 +3339,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') @@ -3245,177 +3361,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 - - !===================================================================== - ! DMS EXCHANGE - !===================================================================== - - ! Get dms flux from ocn and send to atm - if (phase == 'advertise') then - call addfld_from(compocn, 'Faoo_dms_ocn') - call addfld_to(compatm, 'Faoo_dms_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') - end if - end if - end subroutine esmFldsExchange_cesm end module esmFldsExchange_cesm_mod diff --git a/mediator/esmFldsExchange_ufs_mod.F90 b/mediator/esmFldsExchange_ufs_mod.F90 index aa8088306..57c266b59 100644 --- a/mediator/esmFldsExchange_ufs_mod.F90 +++ b/mediator/esmFldsExchange_ufs_mod.F90 @@ -131,9 +131,10 @@ subroutine esmFldsExchange_ufs(gcomp, phase, rc) deallocate(flds) ! from med: fields returned by the atm/ocn flux computation, otherwise unadvertised - allocate(flds(8)) - flds = (/'So_tref ', 'So_qref ', 'So_ustar ', 'So_re ','So_ssq ', 'So_u10 ', & - 'So_duu10n', 'Faox_lat '/) + allocate(flds(12)) + flds = (/'So_tref ', 'So_qref ', 'So_ustar ', 'So_re ', 'So_ssq ', & + 'So_u10 ', 'So_duu10n ', 'Faox_lat ', 'So_ugustOut ', 'So_u10withGust', & + 'So_u10res ', 'Faxa_rainc '/) do n = 1,size(flds) fldname = trim(flds(n)) if (phase == 'advertise') then diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index b29befff5..ea864e928 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -627,6 +627,22 @@ # Note that the fields sent from glc->med do NOT have elevation classes, # but the fields from med->lnd are broken into multiple elevation classes # + - standard_name: Fgrg_rofi + canonical_units: kg m-2 s-1 + description: glc import tomed - glacier frozen_runoff_flux_to_ocean + # + - standard_name: Fgrg_rofi_wiso + canonical_units: kg m-2 s-1 + description: glc import to med - glacier_frozen_runoff_flux_to_ocean for 16O, 18O, HDO + # + - standard_name: Fgrg_rofl + canonical_units: kg m-2 s-1 + description: glc import to med - glacier liquid runoff flux to ocean + # + - standard_name: Fgrg_rofl_wiso + canonical_units: kg m-2 s-1 + description: glc import to med - glacier_frozen_runoff_flux_to_ocean for 16O, 18O, HDO + # - standard_name: Figg_rofi canonical_units: kg m-2 s-1 description: glc import to med - glc frozen runoff_iceberg flux to ice @@ -677,22 +693,6 @@ canonical_units: m description: glc export from med (elevation classes 1->glc_nec) # - - standard_name: Fogg_rofi - canonical_units: kg m-2 s-1 - description: glc export from med - glacier_frozen_runoff_flux_to_ocean - # - - standard_name: Fogg_rofi_wiso - canonical_units: kg m-2 s-1 - description: glc export from med - glacier_frozen_runoff_flux_to_ocean for 16O, 18O, HDO - # - - standard_name: Fogg_rofl - canonical_units: kg m-2 s-1 - description: glc export from med - glacier liquid runoff flux to ocean - # - - standard_name: Fogg_rofl_wiso - canonical_units: kg m-2 s-1 - description: glc export from med - glacier_frozen_runoff_flux_to_ocean for 16O, 18O, HDO - # #----------------------------------- # section: ice import to med #----------------------------------- @@ -899,12 +899,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 @@ -1214,6 +1226,10 @@ canonical_units: kg m-2 s-1 description: river export to ocean - water flux due to runoff (frozen) # + - standard_name: Forr_rofi_glc + canonical_units: kg m-2 s-1 + description: river export to ocean - water flux due to runoff originating from glc (frozen) + # - standard_name: Forr_rofi_wiso canonical_units: kg m-2 s-1 description: river import to med - water flux due to runoff (frozen) for 16O, 18O, HDO @@ -1222,29 +1238,13 @@ canonical_units: kg m-2 s-1 description: river import to med - water flux due to runoff (liquid) # - - standard_name: Forr_rofl_wiso + - standard_name: Forr_rofl_glc canonical_units: kg m-2 s-1 - description: river import to med - water flux due to runoff (frozen) for 16O, 18O, HDO + description: river import to med - water flux due to runoff originating from glc (liquid) # - - standard_name: Firr_rofi - canonical_units: kg m-2 s-1 - description: river export - water flux into sea ice due to runoff (frozen) - # - - standard_name: Firr_rofi_wiso - canonical_units: kg m-2 s-1 - description: river export - water flux into sea ice due to runoff (frozen) for 16O, 18O, HDO - # - #----------------------------------- - # section: river export from med (computed in med) - #----------------------------------- - # - - standard_name: Fixx_rofi - canonical_units: kg m-2 s-1 - description: frozen runoff to ice from river and lnd-ice - # - - standard_name: Fixx_rofi_wiso + - standard_name: Forr_rofl_wiso canonical_units: kg m-2 s-1 - description: frozen runoff to ice from river and lnd-ice for 16O, 18O, HDO + description: river import to med - water flux due to runoff (frozen) for 16O, 18O, HDO # #----------------------------------- # section: wav import to med diff --git a/mediator/med.F90 b/mediator/med.F90 index bb542dbd3..74c832829 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -1641,7 +1641,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 @@ -1943,6 +1943,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 !--------------------------------------- @@ -2141,7 +2145,7 @@ subroutine DataInitialize(gcomp, rc) do n1 = 1,ncomps if (maintask) then write(logunit,*) - write(logunit,'(a)') trim(subname)//" "//trim(compname(n1)) + write(logunit,'(a,2L2)') trim(subname)//" "//trim(compname(n1)), is_local%wrap%comp_present(n1), ESMF_StateIsCreated(is_local%wrap%NStateImp(n1),rc=rc) end if if (is_local%wrap%comp_present(n1) .and. ESMF_StateIsCreated(is_local%wrap%NStateImp(n1),rc=rc)) then call State_GetScalar(scalar_value=real_nx, & @@ -2169,12 +2173,14 @@ 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) 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) - end if + endif end do if (maintask) write(logunit,*) diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index fe218fc81..1617ca738 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 @@ -666,8 +666,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) @@ -1005,7 +1010,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 @@ -1216,8 +1221,15 @@ subroutine med_phases_diag_rof( gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call diag_rof(is_local%wrap%FBImp(comprof,comprof), 'Forr_rofi' , f_watr_ioff, ic, areas, budget_local, minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_rof(is_local%wrap%FBImp(comprof,comprof), 'Firr_rofi' , f_watr_ioff, ic, areas, budget_local, minus=.true., rc=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) + 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 + call diag_rof(is_local%wrap%FBImp(comprof,comprof), 'Forr_rofi_glc' , f_watr_ioff, ic, areas, budget_local, minus=.true., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if if (flds_wiso) then call diag_rof_wiso(is_local%wrap%FBExp(comprof), 'Forr_flood_wiso', & @@ -1250,6 +1262,14 @@ subroutine med_phases_diag_rof( gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call diag_rof(is_local%wrap%FBExp(comprof), 'Flrl_rofi' , f_watr_ioff, ic, areas, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (fldbun_fldchk(is_local%wrap%FBExp(comprof), 'Fgrg_rofl', rc=rc)) then + call diag_rof(is_local%wrap%FBExp(comprof), 'Fgrg_rofl' , f_watr_roff, ic, areas, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + if (fldbun_fldchk(is_local%wrap%FBExp(comprof), 'Fgrg_rofi', rc=rc)) then + call diag_rof(is_local%wrap%FBExp(comprof), 'Fgrg_rofi' , f_watr_ioff, ic, areas, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if if (flds_wiso) then call diag_rof_wiso(is_local%wrap%FBExp(comprof), 'Flrl_rofl_wiso', & @@ -1371,9 +1391,9 @@ subroutine med_phases_diag_glc( gcomp, rc) do ns = 1,is_local%wrap%num_icesheets areas => is_local%wrap%mesh_info(compglc(ns))%areas - call diag_glc(is_local%wrap%FBImp(compglc(ns),compglc(ns)), 'Fogg_rofl', f_watr_roff, ic, areas, budget_local, minus=.true., rc=rc) + call diag_glc(is_local%wrap%FBImp(compglc(ns),compglc(ns)), 'Fgrg_rofl', f_watr_roff, ic, areas, budget_local, minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_glc(is_local%wrap%FBImp(compglc(ns),compglc(ns)), 'Fogg_rofi', f_watr_ioff, ic, areas, budget_local, minus=.true., rc=rc) + call diag_glc(is_local%wrap%FBImp(compglc(ns),compglc(ns)), 'Fgrg_rofi', f_watr_ioff, ic, areas, budget_local, minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call diag_glc(is_local%wrap%FBImp(compglc(ns),compglc(ns)), 'Figg_rofi', f_watr_ioff, ic, areas, budget_local, minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1552,11 +1572,21 @@ subroutine med_phases_diag_ocn( gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call diag_ocn(is_local%wrap%FBExp(compocn), 'Faxa_snow' , f_watr_snow , ic, areas, sfrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_rofl' , f_watr_roff , ic, areas, sfrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_rofi' , f_watr_ioff , ic, areas, sfrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + if ( fldbun_fldchk(is_local%wrap%FBExp(compocn), 'Forr_rofl_glc' , rc=rc)) then + call diag_ocn(is_local%wrap%FBExp(compocn), 'Forr_rofl_glc' , f_watr_roff , ic, areas, sfrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + if ( fldbun_fldchk(is_local%wrap%FBExp(compocn), 'Forr_rofi_glc' , rc=rc)) then + call diag_ocn(is_local%wrap%FBExp(compocn), 'Forr_rofi_glc' , f_watr_ioff , ic, areas, sfrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + if (flds_wiso) then call diag_ocn_wiso(is_local%wrap%FBMed_aoflux_o, 'Faox_evap_wiso', & f_watr_evap_16O, f_watr_evap_18O, f_watr_evap_HDO, ic, areas, ofrac, budget_local, rc=rc) @@ -1912,8 +1942,6 @@ subroutine med_phases_diag_ice_med2ice( gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call diag_ice_send(is_local%wrap%FBExp(compice), 'Faxa_snow', f_watr_snow, areas, lats, ifrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_ice_send(is_local%wrap%FBExp(compice), 'Fixx_rofi', f_watr_ioff, areas, lats, ifrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return if ( fldbun_fldchk(is_local%wrap%FBExp(compice), 'Fioo_q', rc=rc)) then call fldbun_getdata1d(is_local%wrap%FBExp(compice), 'Fioo_q', data, rc=rc) @@ -1932,14 +1960,12 @@ subroutine med_phases_diag_ice_med2ice( gcomp, rc) ic = c_inh_send budget_local(f_heat_latf,ic,ip) = -budget_local(f_watr_snow,ic,ip)*shr_const_latice - budget_local(f_heat_ioff,ic,ip) = -budget_local(f_watr_ioff,ic,ip)*shr_const_latice if (trim(budget_table_version) == 'v0') then budget_local(f_watr_frz ,ic,ip) = budget_local(f_heat_frz ,ic,ip)*HFLXtoWFLX end if ic = c_ish_send budget_local(f_heat_latf,ic,ip) = -budget_local(f_watr_snow,ic,ip)*shr_const_latice - budget_local(f_heat_ioff,ic,ip) = -budget_local(f_watr_ioff,ic,ip)*shr_const_latice if (trim(budget_table_version) == 'v0') then budget_local(f_watr_frz ,ic,ip) = budget_local(f_heat_frz ,ic,ip)*HFLXtoWFLX end if 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 cd64bf497..e2b439637 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 @@ -192,11 +201,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__ @@ -224,6 +233,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) ' !----------------------------------------------------------- @@ -231,6 +244,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 @@ -454,9 +514,6 @@ subroutine med_internalstate_coupling(gcomp, rc) med_coupling_allowed(compice,compocn) = .true. med_coupling_allowed(comprof,compocn) = .true. med_coupling_allowed(compwav,compocn) = .true. - do ns = 1,is_local%wrap%num_icesheets - med_coupling_allowed(compglc(ns),compocn) = .true. - end do ! to ice med_coupling_allowed(compatm,compice) = .true. @@ -469,6 +526,9 @@ subroutine med_internalstate_coupling(gcomp, rc) ! to river med_coupling_allowed(complnd,comprof) = .true. + do ns = 1,is_local%wrap%num_icesheets + med_coupling_allowed(compglc(ns),comprof) = .true. + end do ! to wave med_coupling_allowed(compatm,compwav) = .true. @@ -480,7 +540,7 @@ subroutine med_internalstate_coupling(gcomp, rc) isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent .and. isSet) then - ! are multiple ocean depths for temperature and salinity sent from the ocn to glc? + ! multiple ocean depths for temperature and salinity sent from the ocn to glc read(cvalue,*) is_local%wrap%ocn2glc_coupling else is_local%wrap%ocn2glc_coupling = .false. diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index f4abadaf6..6966a37d2 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -1086,7 +1086,15 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, & 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_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index 33bc0abaa..7697b5740 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -1075,9 +1075,9 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) taux=aoflux_out%taux, tauy=aoflux_out%tauy, tref=aoflux_out%tref, qref=aoflux_out%qref, & ocn_surface_flux_scheme=ocn_surface_flux_scheme, & add_gusts=add_gusts, & - duu10n=aoflux_out%duu10n, & + duu10n=aoflux_out%duu10n, & ugust_out = aoflux_out%ugust_out, & - u10res = aoflux_out%u10res, & + u10res = aoflux_out%u10res, & ustar_sv=aoflux_out%ustar, re_sv=aoflux_out%re, ssq_sv=aoflux_out%ssq, & missval=0.0_r8) @@ -1102,7 +1102,7 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) ocn_surface_flux_scheme=ocn_surface_flux_scheme, & sen=aoflux_out%sen, lat=aoflux_out%lat, lwup=aoflux_out%lwup, evap=aoflux_out%evap, & taux=aoflux_out%taux, tauy=aoflux_out%tauy, tref=aoflux_out%tref, qref=aoflux_out%qref, & - duu10n=aoflux_out%duu10n, & + duu10n=aoflux_out%duu10n, & missval=0.0_r8) #ifdef UFS_AOFLUX end if @@ -1111,7 +1111,7 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) #endif do n = 1,aoflux_in%lsize - if (aoflux_in%mask(n) /= 0) then + if (aoflux_in%mask(n) /= 0) then aoflux_out%u10(n) = aoflux_out%u10res(n) aoflux_out%u10_withGust(n) = sqrt(aoflux_out%duu10n(n)) end if @@ -1601,8 +1601,14 @@ 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 - call fldbun_getfldptr(fldbun_a, 'Faxa_rainc', aoflux_in%rainc, xgrid=xgrid, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + 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 ! extra fields for ufs.frac.aoflux diff --git a/mediator/med_phases_post_glc_mod.F90 b/mediator/med_phases_post_glc_mod.F90 index ac32ae8b8..959f2873b 100644 --- a/mediator/med_phases_post_glc_mod.F90 +++ b/mediator/med_phases_post_glc_mod.F90 @@ -68,7 +68,7 @@ module med_phases_post_glc_mod logical :: cism_evolve = .false. logical :: glc2lnd_coupling = .false. - logical :: glc2ocn_coupling = .false. + logical :: glc2rof_coupling = .false. logical :: glc2ice_coupling = .false. character(*) , parameter :: u_FILE_u = & @@ -120,8 +120,8 @@ subroutine med_phases_post_glc(gcomp, rc) end do ! determine if there will be any glc to ocn coupling do ns = 1,is_local%wrap%num_icesheets - if (is_local%wrap%med_coupling_active(compglc(ns),compocn)) then - glc2ocn_coupling = .true. + if (is_local%wrap%med_coupling_active(compglc(ns),comprof)) then + glc2rof_coupling = .true. exit end if end do @@ -134,7 +134,7 @@ subroutine med_phases_post_glc(gcomp, rc) end do if (maintask) then write(logunit,'(a,L1)') trim(subname) // 'glc2lnd_coupling is ',glc2lnd_coupling - write(logunit,'(a,L1)') trim(subname) // 'glc2ocn_coupling is ',glc2ocn_coupling + write(logunit,'(a,L1)') trim(subname) // 'glc2rof_coupling is ',glc2rof_coupling write(logunit,'(a,L1)') trim(subname) // 'glc2ice_coupling is ',glc2ice_coupling end if @@ -152,19 +152,19 @@ subroutine med_phases_post_glc(gcomp, rc) end if !--------------------------------------- - ! glc->ocn mapping - ! merging with rof->ocn fields is done in med_phases_prep_ocn + ! glc->rof mapping !--------------------------------------- - if (glc2ocn_coupling) then + + if (glc2rof_coupling) then do ns = 1,is_local%wrap%num_icesheets - if (is_local%wrap%med_coupling_active(compglc(ns),compocn)) then + if (is_local%wrap%med_coupling_active(compglc(ns),comprof)) then call med_map_field_packed( & FBSrc=is_local%wrap%FBImp(compglc(ns),compglc(ns)), & - FBDst=is_local%wrap%FBImp(compglc(ns),compocn), & + FBDst=is_local%wrap%FBImp(compglc(ns),comprof), & FBFracSrc=is_local%wrap%FBFrac(compglc(ns)), & - field_normOne=is_local%wrap%field_normOne(compglc(ns),compocn,:), & - packed_data=is_local%wrap%packed_data(compglc(ns),compocn,:), & - routehandles=is_local%wrap%RH(compglc(ns),compocn,:), rc=rc) + field_normOne=is_local%wrap%field_normOne(compglc(ns),comprof,:), & + packed_data=is_local%wrap%packed_data(compglc(ns),comprof,:), & + routehandles=is_local%wrap%RH(compglc(ns),comprof,:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if end do diff --git a/mediator/med_phases_post_ocn_mod.F90 b/mediator/med_phases_post_ocn_mod.F90 index bfc234507..b253de664 100644 --- a/mediator/med_phases_post_ocn_mod.F90 +++ b/mediator/med_phases_post_ocn_mod.F90 @@ -83,6 +83,7 @@ subroutine med_phases_post_ocn(gcomp, rc) ! Accumulate ocn input for glc if there is ocn->glc coupling if (is_local%wrap%ocn2glc_coupling) then + call ESMF_LogWrite(subname//' DEBUG: calling med_phases_prep_glc_accum_ocn', ESMF_LOGMSG_INFO) call med_phases_prep_glc_accum_ocn(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if diff --git a/mediator/med_phases_post_rof_mod.F90 b/mediator/med_phases_post_rof_mod.F90 index 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 edb74f38b..d0a132420 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 @@ -30,6 +30,9 @@ module med_phases_prep_atm_mod public :: med_phases_prep_atm + 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__ @@ -50,7 +53,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)' !------------------------------------------------------------------------------- @@ -181,8 +184,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) @@ -192,30 +200,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 (Mediator_compute_enthalpy) then diff --git a/mediator/med_phases_prep_glc_mod.F90 b/mediator/med_phases_prep_glc_mod.F90 index 1fecf1a86..1681aa9b1 100644 --- a/mediator/med_phases_prep_glc_mod.F90 +++ b/mediator/med_phases_prep_glc_mod.F90 @@ -20,9 +20,9 @@ module med_phases_prep_glc_mod use ESMF , only : ESMF_Field, ESMF_FieldGet, ESMF_FieldCreate use ESMF , only : ESMF_Mesh, ESMF_MESHLOC_ELEMENT, ESMF_TYPEKIND_R8, ESMF_KIND_R8 use ESMF , only : ESMF_DYNAMICMASK, ESMF_DynamicMaskSetR8R8R8, ESMF_DYNAMICMASKELEMENTR8R8R8 - use ESMF , only : ESMF_FieldRegrid + use 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 @@ -37,6 +37,7 @@ module med_phases_prep_glc_mod use med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans use med_methods_mod , only : field_getdata2d => med_methods_Field_getdata2d use med_methods_mod , only : field_getdata1d => med_methods_Field_getdata1d + use med_methods_mod , only : fldchk => med_methods_FB_FldChk use med_utils_mod , only : chkerr => med_utils_ChkErr use med_time_mod , only : med_time_alarmInit use glc_elevclass_mod , only : glc_get_num_elevation_classes @@ -106,7 +107,7 @@ module med_phases_prep_glc_mod integer , public :: ocnAccum2glc_cnt character(len=14) :: fldnames_fr_ocn(2) = (/'So_t_depth','So_s_depth'/) ! TODO: what else needs to be added here type(ESMF_DynamicMask) :: dynamicOcnMask - integer, parameter :: num_ocndepths = 7 + integer, parameter :: num_ocndepths = 30 type(ESMF_Clock) :: prepglc_clock character(*), parameter :: u_FILE_u = & @@ -319,7 +320,7 @@ subroutine med_phases_prep_glc_init(gcomp, rc) end if ! ------------------------------- - ! If ocn->glc couplng is active + ! If ocn->glc coupling is active ! ------------------------------- if (is_local%wrap%ocn2glc_coupling) then @@ -355,8 +356,8 @@ subroutine med_phases_prep_glc_init(gcomp, rc) ! Create a dynamic mask object ! The dynamic mask object further holds a pointer to the routine that will be called in order to ! handle dynamically masked elements - in this case its DynOcnMaskProc (see below) - call ESMF_DynamicMaskSetR8R8R8(dynamicOcnMask, dynamicSrcMaskValue=czero, & - dynamicMaskRoutine=DynOcnMaskProc, rc=rc) + call ESMF_DynamicMaskSetR8R8R8(dynamicOcnMask, dynamicMaskRoutine=DynOcnMaskProc, & + dynamicSrcMaskValue=1.e30_r8, handleAllElements=.true., rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if @@ -520,6 +521,7 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) logical :: isPresent, isSet logical :: write_histaux_l2x1yrg character(len=*) , parameter :: subname=' (med_phases_prep_glc) ' + !--------------------------------------- call t_startf('MED:'//subname) @@ -618,17 +620,19 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) if (do_avg) then ! Always average import from accumulated land import data do n = 1, size(fldnames_fr_lnd) - call fldbun_getdata2d(FBlndAccum2glc_l, fldnames_fr_lnd(n), data2d, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (lndAccum2glc_cnt > 0) then - ! If accumulation count is greater than 0, do the averaging - data2d(:,:) = data2d(:,:) / real(lndAccum2glc_cnt) - else - ! If accumulation count is 0, then simply set the averaged field bundle values from the land - ! to the import field bundle values - call fldbun_getdata2d(is_local%wrap%FBImp(complnd,complnd), fldnames_fr_lnd(n), data2d_import, rc) + if (fldchk(FBlndAccum2glc_l, fldnames_fr_lnd(n), rc=rc)) then + call fldbun_getdata2d(FBlndAccum2glc_l, fldnames_fr_lnd(n), data2d, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - data2d(:,:) = data2d_import(:,:) + if (lndAccum2glc_cnt > 0) then + ! If accumulation count is greater than 0, do the averaging + data2d(:,:) = data2d(:,:) / real(lndAccum2glc_cnt) + else + ! If accumulation count is 0, then simply set the averaged field bundle values from the land + ! to the import field bundle values + call fldbun_getdata2d(is_local%wrap%FBImp(complnd,complnd), fldnames_fr_lnd(n), data2d_import, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + data2d(:,:) = data2d_import(:,:) + end if end if end do @@ -663,8 +667,13 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) if (chkErr(rc,__LINE__,u_FILE_u)) return ! Do mapping of ocn to glc with dynamic masking call ESMF_FieldRegrid(lfield_src, lfield_dst, & - routehandle=is_local%wrap%RH(compocn,compglc(ns),mapbilnr), dynamicMask=dynamicOcnMask, rc=rc) + routehandle=is_local%wrap%RH(compocn,compglc(ns),mapbilnr), dynamicMask=dynamicOcnMask, & + zeroregion=ESMF_REGION_EMPTY, rc=rc) if (chkErr(rc,__LINE__,u_FILE_u)) return + call fldbun_getdata2d(is_local%wrap%FBExp(compglc(ns)), fldnames_fr_ocn(n), data2d, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + ! reset values of 0 to spval + where (data2d == 0._r8) data2d = shr_const_spval end do end do ocnAccum2glc_cnt = 0 @@ -803,8 +812,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 @@ -1043,7 +1052,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 @@ -1057,7 +1066,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) ' !--------------------------------------------------------------- @@ -1137,8 +1146,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 @@ -1147,9 +1156,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 @@ -1244,7 +1253,7 @@ subroutine dynOcnMaskProc(dynamicMaskList, dynamicSrcMaskValue, dynamicDstMaskVa integer , intent(out) :: rc ! local variables - integer :: i, j + integer :: no, ni real(ESMF_KIND_R8) :: renorm !--------------------------------------------------------------- @@ -1254,20 +1263,22 @@ subroutine dynOcnMaskProc(dynamicMaskList, dynamicSrcMaskValue, dynamicDstMaskVa ! the regridding (which is done explicitly here) if (associated(dynamicMaskList)) then - do i=1, size(dynamicMaskList) - dynamicMaskList(i)%dstElement = czero ! set to zero + do no = 1, size(dynamicMaskList) + dynamicMaskList(no)%dstElement = czero ! set to zero renorm = 0.d0 ! reset - do j = 1, size(dynamicMaskList(i)%factor) - if (dynamicSrcMaskValue /= dynamicMaskList(i)%srcElement(j)) then - dynamicMaskList(i)%dstElement = dynamicMaskList(i)%dstElement + & - (dynamicMaskList(i)%factor(j) * dynamicMaskList(i)%srcElement(j)) - renorm = renorm + dynamicMaskList(i)%factor(j) + do ni = 1, size(dynamicMaskList(no)%factor) + ! Need to multiply by .90 to handle averaging of input fields before remapping is called + if ( dynamicMaskList(no)%srcElement(ni) > 0.d0 .and. & + dynamicMaskList(no)%srcElement(ni) < dynamicSrcMaskValue*.90) then + dynamicMaskList(no)%dstElement = dynamicMaskList(no)%dstElement + & + (dynamicMaskList(no)%factor(ni) * dynamicMaskList(no)%srcElement(ni)) + renorm = renorm + dynamicMaskList(no)%factor(ni) endif enddo if (renorm > 0.d0) then - dynamicMaskList(i)%dstElement = dynamicMaskList(i)%dstElement / renorm + dynamicMaskList(no)%dstElement = dynamicMaskList(no)%dstElement / renorm else if (present(dynamicSrcMaskValue)) then - dynamicMaskList(i)%dstElement = dynamicSrcMaskValue + dynamicMaskList(no)%dstElement = dynamicSrcMaskValue else rc = ESMF_RC_ARG_BAD ! error detected return diff --git a/mediator/med_phases_prep_rof_mod.F90 b/mediator/med_phases_prep_rof_mod.F90 index 55b2dae82..f0ec87c37 100644 --- a/mediator/med_phases_prep_rof_mod.F90 +++ b/mediator/med_phases_prep_rof_mod.F90 @@ -12,7 +12,7 @@ module med_phases_prep_rof_mod use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use ESMF , only : ESMF_FieldBundle, ESMF_Field - use med_internalstate_mod , only : complnd, comprof, mapconsf, mapconsd, mapfcopy + use med_internalstate_mod , only : complnd, compglc, comprof, mapconsf, mapfcopy use med_internalstate_mod , only : InternalState, maintask, logunit use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_constants_mod , only : czero => med_constants_czero @@ -23,6 +23,7 @@ module med_phases_prep_rof_mod use med_methods_mod , only : fldbun_reset => med_methods_FB_reset use med_methods_mod , only : fldbun_average => med_methods_FB_average use med_methods_mod , only : field_getdata1d => med_methods_Field_getdata1d + use med_methods_mod , only : fldbun_fldchk => med_methods_FB_fldchk use med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans use perf_mod , only : t_startf, t_stopf @@ -61,6 +62,8 @@ module med_phases_prep_rof_mod type(ESMF_FieldBundle), public :: FBlndAccum2rof_l type(ESMF_FieldBundle), public :: FBlndAccum2rof_r + character(len=9) :: fldnames_fr_glc(2) = (/'Fgrg_rofl', 'Fgrg_rofi'/) + character(*) , parameter :: u_FILE_u = & __FILE__ @@ -276,11 +279,11 @@ subroutine med_phases_prep_rof(gcomp, rc) ! local variables type(InternalState) :: is_local - integer :: n + integer :: n,ns,nf integer :: count logical :: exists - real(r8), pointer :: dataptr(:) - real(r8), pointer :: dataptr1d(:) + real(r8), pointer :: dataptr_in(:) + real(r8), pointer :: dataptr_out(:) type(ESMF_Field) :: lfield type(med_fldList_type), pointer :: fldList character(len=*),parameter :: subname='(med_phases_prep_rof_mod: med_phases_prep_rof)' @@ -319,12 +322,12 @@ subroutine med_phases_prep_rof(gcomp, rc) if (exists) then call ESMF_FieldBundleGet(FBlndAccum2rof_l, fieldName=trim(lnd2rof_flds(n)), field=lfield, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call field_getdata1d(lfield, dataptr1d, rc=rc) + call field_getdata1d(lfield, dataptr_out, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (count == 0) then - dataptr1d(:) = czero + dataptr_out(:) = czero else - dataptr1d(:) = dataptr1d(:) / real(count, r8) + dataptr_out(:) = dataptr_out(:) / real(count, r8) end if end if end do @@ -359,12 +362,12 @@ subroutine med_phases_prep_rof(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return else ! This will ensure that no irrig is sent from the land - call fldbun_getdata1d(FBlndAccum2rof_r, irrig_flux_field, dataptr, rc) - dataptr(:) = czero + call fldbun_getdata1d(FBlndAccum2rof_r, irrig_flux_field, dataptr_out, rc) + dataptr_out(:) = czero end if !--------------------------------------- - ! auto merges to create FBExp(comprof) - assumes that all data is coming from FBlndAccum2rof_r + ! create FBExp(comprof) !--------------------------------------- if (dbug_flag > 1) then @@ -373,10 +376,35 @@ subroutine med_phases_prep_rof(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if + ! data coming from FBlndAccum2rof_r call med_merge_auto(compsrc=complnd, FBout=is_local%wrap%FBExp(comprof), & FBfrac=is_local%wrap%FBFrac(comprof), FBin=FBlndAccum2rof_r, fldListTo=fldList, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + ! custom merge for glc->rof + ! glc->rof is mapped in med_phases_post_glc + do ns = 1,is_local%wrap%num_icesheets + if (is_local%wrap%med_coupling_active(compglc(ns),comprof)) then + do nf = 1,size(fldnames_fr_glc) + if ( fldbun_fldchk(is_local%wrap%FBImp(compglc(ns),comprof), fldnames_fr_glc(nf), rc=rc) .and. & + fldbun_fldchk(is_local%wrap%FBExp(comprof), fldnames_fr_glc(nf), rc=rc) ) then + call fldbun_getdata1d(is_local%wrap%FBImp(compglc(ns),comprof), & + trim(fldnames_fr_glc(nf)), dataptr_in, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call fldbun_getdata1d(is_local%wrap%FBExp(comprof), & + trim(fldnames_fr_glc(nf)), dataptr_out , rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Determine export data + if (ns == 1) then + dataptr_out(:) = dataptr_in(:) + else + dataptr_out(:) = dataptr_out(:) + dataptr_in(:) + end if + end if + end do + end if + end do + ! Check for nans in fields export to rof call FB_check_for_nans(is_local%wrap%FBExp(comprof), maintask, logunit, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -402,9 +430,9 @@ subroutine med_phases_prep_rof(gcomp, rc) if (exists) then call ESMF_FieldBundleGet(FBlndAccum2rof_l, fieldName=trim(lnd2rof_flds(n)), field=lfield, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call field_getdata1d(lfield, dataptr1d, rc=rc) + call field_getdata1d(lfield, dataptr_out, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - dataptr1d(:) = czero + dataptr_out(:) = czero end if end do diff --git a/mediator/med_phases_restart_mod.F90 b/mediator/med_phases_restart_mod.F90 index 1bbbb0fbf..6bbdb6b75 100644 --- a/mediator/med_phases_restart_mod.F90 +++ b/mediator/med_phases_restart_mod.F90 @@ -342,13 +342,14 @@ subroutine med_phases_restart_write(gcomp, rc) call med_io_write(io_file, next_tod , 'curr_tod' , whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - do n = 1,ncomps + do n = 2,ncomps if (is_local%wrap%comp_present(n)) then - nx = is_local%wrap%nx(n) - ny = is_local%wrap%ny(n) if (is_local%wrap%ntile(n) > 0) then nx = is_local%wrap%ntile(n)*is_local%wrap%ny(n)*is_local%wrap%nx(n) ny = 1 + else + nx = is_local%wrap%nx(n) + ny = is_local%wrap%ny(n) end if ! Write import field bundles if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(n,n),rc=rc)) then diff --git a/ufs/ccpp/data/MED_typedefs.meta b/ufs/ccpp/data/MED_typedefs.meta index 772358535..c14616a6a 100644 --- a/ufs/ccpp/data/MED_typedefs.meta +++ b/ufs/ccpp/data/MED_typedefs.meta @@ -862,7 +862,7 @@ long_name = model 2m diagnostics use the temperature and humidity calculated by the lake model units = flag dimensions = () - type = integer + type = logical [lkm] standard_name = control_for_lake_model_execution_method long_name = control for lake model execution: 0=no lake, 1=lake, 2=lake+nsst