From e187b541738670e0c202f9b8ca9e936fdaad77d2 Mon Sep 17 00:00:00 2001 From: Don Dazlich Date: Sat, 27 Aug 2022 17:03:44 -0600 Subject: [PATCH 001/123] Add mpas-ocean and seaice to the components --- cime_config/config_component_cesm.xml | 2 ++ mediator/esmFldsExchange_cesm_mod.F90 | 27 +++++++++++++++++++++++++++ mediator/fd_cesm.yaml | 10 ++++++++++ 3 files changed, 39 insertions(+) diff --git a/cime_config/config_component_cesm.xml b/cime_config/config_component_cesm.xml index ba4bb69c0..9895227ef 100644 --- a/cime_config/config_component_cesm.xml +++ b/cime_config/config_component_cesm.xml @@ -326,6 +326,7 @@ 8 1 + $ATM_NCPL $ATM_NCPL $ATM_NCPL $ATM_NCPL @@ -362,6 +363,7 @@ FALSE TRUE + TRUE TRUE TRUE FALSE diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index a1b1a4897..5fbf7f291 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -1533,6 +1533,20 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmrg(fldListTo(compocn)%flds, 'Si_ifrac', mrg_from=compice, mrg_fld='Si_ifrac', mrg_type='copy') end if + ! --------------------------------------------------------------------- + ! to ocn: seaice basal pressure + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compice)%flds, 'Si_bpress') + call addfld(fldListTo(compocn)%flds, 'Si_bpress') + else + if ( fldchk(is_local%wrap%FBImp(compice, compice), 'Si_bpress', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compocn) , 'Si_bpress', rc=rc)) then + call addmap(fldListFr(compice)%flds, 'Si_bpress', compocn, mapfcopy, 'unset', 'unset') + call addmrg(fldListTo(compocn)%flds, 'Si_bpress', mrg_from=compice, mrg_fld='Si_bpress', mrg_type='copy') + end if + end if + ! --------------------------------------------------------------------- ! to ocn: downward longwave heat flux from atm ! to ocn: downward direct near-infrared incident solar radiation from atm @@ -2717,6 +2731,19 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmrg(fldListTo(compice)%flds, 'Fioo_q', mrg_from=compocn, mrg_fld='Fioo_q', mrg_type='copy') end if end if + ! --------------------------------------------------------------------- + ! to ice: frazil from ocn + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compocn)%flds, 'Fioo_frazil') + call addfld(fldListTo(compice)%flds, 'Fioo_frazil') + else + if ( fldchk(is_local%wrap%FBImp(compocn, compocn), 'Fioo_frazil', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compice) , 'Fioo_frazil', rc=rc)) then + call addmap(fldListFr(compocn)%flds, 'Fioo_frazil', compice, mapfcopy, 'unset', 'unset') + call addmrg(fldListTo(compice)%flds, 'Fioo_frazil', mrg_from=compocn, mrg_fld='Fioo_frazil', mrg_type='copy') + end if + end if !----------------------------- ! to ice: Ratio of ocean surface level abund. H2_16O/H2O/Rstd from ocean !----------------------------- diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index 55da80619..91cfcf3a9 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -737,6 +737,11 @@ canonical_units: m description: sea-ice export - volume of snow per unit area # + - standard_name: Si_bpress + alias: basal_pressure + canonical_units: Pa + description: sea-ice export - ice basal pressure + # #----------------------------------- # section: ocean export to mediator #----------------------------------- @@ -746,6 +751,11 @@ canonical_units: W m-2 description: ocean export # + - standard_name: Fioo_frazil + alias: frazil_mass_flux + canonical_units: kg m-2 s-1 + description: ocean export + # - standard_name: Faoo_fco2_ocn canonical_units: moles m-2 s-1 description: ocean export From f13e16e414e115e268b2dd300b665e628e5f2429 Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Fri, 26 Jul 2024 10:23:37 -0400 Subject: [PATCH 002/123] CMEPS Sync with Trigrid capability (#122) --- .github/workflows/extbuild.yml | 26 +- .github/workflows/srt.yml | 82 +- cesm/driver/esm.F90 | 4 - cesm/flux_atmocn/shr_flux_mod.F90 | 17 +- cesm/nuopc_cap_share/seq_drydep_mod.F90 | 2 - cesm/nuopc_cap_share/shr_dust_emis_mod.F90 | 222 ++++ cime_config/buildexe | 6 +- cime_config/buildnml | 8 +- cime_config/config_component.xml | 56 - cime_config/config_component_cesm.xml | 2 + cime_config/namelist_definition_drv.xml | 331 ++---- cime_config/namelist_definition_drv_flds.xml | 27 + cime_config/runseq/driver_config.py | 8 +- cime_config/runseq/runseq_TG.py | 6 +- cime_config/runseq/runseq_general.py | 41 +- mediator/esmFldsExchange_cesm_mod.F90 | 1000 +++++++++--------- mediator/esmFldsExchange_ufs_mod.F90 | 7 +- mediator/fd_cesm.yaml | 893 +++++++++------- mediator/med.F90 | 12 +- mediator/med_diag_mod.F90 | 50 +- mediator/med_fraction_mod.F90 | 149 ++- mediator/med_internalstate_mod.F90 | 74 +- mediator/med_phases_aofluxes_mod.F90 | 17 +- mediator/med_phases_cdeps_mod.F90 | 5 +- mediator/med_phases_history_mod.F90 | 25 +- mediator/med_phases_post_glc_mod.F90 | 24 +- mediator/med_phases_post_ocn_mod.F90 | 1 + mediator/med_phases_post_rof_mod.F90 | 330 +++++- mediator/med_phases_prep_atm_mod.F90 | 65 +- mediator/med_phases_prep_glc_mod.F90 | 121 ++- mediator/med_phases_prep_rof_mod.F90 | 52 +- mediator/med_phases_profile_mod.F90 | 9 +- mediator/med_phases_restart_mod.F90 | 7 +- 33 files changed, 2205 insertions(+), 1474 deletions(-) create mode 100644 cesm/nuopc_cap_share/shr_dust_emis_mod.F90 diff --git a/.github/workflows/extbuild.yml b/.github/workflows/extbuild.yml index 0614d5acb..e1c69cd7b 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 @@ -71,17 +71,21 @@ jobs: parallelio_path: $HOME/pio - 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 @@ -89,13 +93,13 @@ jobs: esmfmkfile: $HOME/ESMF/lib/libg/Linux.gfortran.64.openmpi.default/esmf.mk pio_path: $HOME/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 ESMFMKFILE=$HOME/ESMF/lib/libg/Linux.gfortran.64.openmpi.default/esmf.mk 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/flux_atmocn/shr_flux_mod.F90 b/cesm/flux_atmocn/shr_flux_mod.F90 index 58f7ae923..d86805a5b 100644 --- a/cesm/flux_atmocn/shr_flux_mod.F90 +++ b/cesm/flux_atmocn/shr_flux_mod.F90 @@ -143,7 +143,8 @@ SUBROUTINE flux_atmOcn(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & & ocn_surface_flux_scheme, & & add_gusts, & & duu10n, & - & ugust_out, & + & ugust_out, & + & u10res, & & ustar_sv ,re_sv ,ssq_sv, & & missval) @@ -194,6 +195,7 @@ SUBROUTINE flux_atmOcn(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & real(R8),intent(out) :: qref (nMax) ! diag: 2m ref humidity (kg/kg) real(R8),intent(out) :: duu10n(nMax) ! diag: 10m wind speed squared (m/s)^2 real(R8),intent(out) :: ugust_out(nMax) ! diag: gustiness addition to U10 (m/s) + real(R8),intent(out) :: u10res(nMax) ! diag: gustiness addition to U10 (m/s) real(R8),intent(out),optional :: ustar_sv(nMax) ! diag: ustar real(R8),intent(out),optional :: re_sv (nMax) ! diag: sqrt of exchange coefficient (water) @@ -243,6 +245,7 @@ SUBROUTINE flux_atmOcn(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & real(R8) :: cp ! specific heat of moist air real(R8) :: fac ! vertical interpolation factor real(R8) :: spval ! local missing value + real(R8) :: wind0 ! resolved large-scale 10m wind (no gust added) !!++ COARE only real(R8) :: zo,zot,zoq ! roughness lengths real(R8) :: hsb,hlb ! sens & lat heat flxs at zbot @@ -343,12 +346,13 @@ SUBROUTINE flux_atmOcn(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & !--- compute some needed quantities --- if (add_gusts) then - vmag = max(seq_flux_atmocn_minwind, sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2) + ugust(min(rainc(n),6.94444e-4_r8)) ) + vmag = max(seq_flux_atmocn_minwind, sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2 + (1.0_R8*ugust(min(rainc(n),6.94444e-4_r8))**2)) ) ugust_out(n) = ugust(min(rainc(n),6.94444e-4_r8)) else vmag = max(seq_flux_atmocn_minwind, sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2) ) ugust_out(n) = 0.0_r8 end if + wind0 = max(seq_flux_atmocn_minwind, sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2) ) if (use_coldair_outbreak_mod) then ! Cold Air Outbreak Modification: @@ -356,10 +360,14 @@ SUBROUTINE flux_atmOcn(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & ! based on Mahrt & Sun 1995,MWR if (tdiff(n).lt.td0) then + ! if add_gusts wind0 and vmag are different, both need this factor. vscl=min((1._R8+alpha*(abs(tdiff(n)-td0)**0.5_R8/abs(vmag))),maxscl) vmag=vmag*vscl + vscl=min((1._R8+alpha*(abs(tdiff(n)-td0)**0.5_R8/abs(wind0))),maxscl) + wind0=wind0*vscl endif endif + ssq = 0.98_R8 * qsat(ts(n)) / rbot(n) ! sea surf hum (kg/kg) delt = thbot(n) - ts(n) ! pot temp diff (K) delq = qbot(n) - ssq ! spec hum dif (kg/kg) @@ -460,6 +468,7 @@ SUBROUTINE flux_atmOcn(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & qref(n) = qbot(n) - delq*fac duu10n(n) = u10n*u10n ! 10m wind speed squared + u10res(n) = u10n * (wind0/vmag) ! resolved 10m wind !------------------------------------------------------------ ! optional diagnostics, needed for water tracer fluxes (dcn) @@ -472,6 +481,7 @@ SUBROUTINE flux_atmOcn(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & !------------------------------------------------------------ ! no valid data here -- out of domain !------------------------------------------------------------ + sen (n) = spval ! sensible heat flux (W/m^2) lat (n) = spval ! latent heat flux (W/m^2) lwup (n) = spval ! long-wave upward heat flux (W/m^2) @@ -484,7 +494,8 @@ SUBROUTINE flux_atmOcn(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & tref (n) = spval ! 2m reference height temperature (K) qref (n) = spval ! 2m reference height humidity (kg/kg) duu10n(n) = spval ! 10m wind speed squared (m/s)^2 - ugust_out(n) = spval ! gustiness addition (m/s) + ugust_out(n) = spval ! gustiness addition (m/s) + u10res(n) = spval ! 10m resolved wind (no gusts) (m/s) if (present(ustar_sv)) ustar_sv(n) = spval if (present(re_sv )) re_sv (n) = spval 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/buildexe b/cime_config/buildexe index 1d7366718..4923f016d 100755 --- a/cime_config/buildexe +++ b/cime_config/buildexe @@ -108,10 +108,12 @@ def _main_func(): # always relink if os.path.isfile(exename): os.remove(exename) - + exename = os.path.relpath(exename, bld_root) cmd = "{} exec_se -j {} EXEC_SE={} COMP_NAME=driver {} -f {} "\ .format(gmake, gmake_j, exename, gmake_args, makefile) - + pio = os.environ.get("PIO") + if pio: + os.environ["PIO_LIBDIR"] = os.path.join(pio,"lib") rc, out, err = run_cmd(cmd,from_dir=bld_root) expect(rc==0,"Command {} failed rc={}\nout={}\nerr={}".format(cmd,rc,out,err)) 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 dbf3b11e3..a19814827 100644 --- a/cime_config/config_component_cesm.xml +++ b/cime_config/config_component_cesm.xml @@ -299,6 +299,7 @@ 1 1 + 1 $ATM_NCPL $ATM_NCPL 1 @@ -537,6 +538,7 @@ FALSE TRUE + TRUE TRUE diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 3e4d6bf6b..0f8622af1 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 @@ -885,6 +872,17 @@ off + + logical + control + MED_attributes + + If true, remove negative runoff by downweighting all positive runoff globally. + + + .true. + + integer @@ -2086,6 +2084,80 @@ + + + + + + logical + aux_hist + ALLCOMP_attributes + + .false. + + Auxiliary mediator wav2med average history output every day. + Note that ww3dev will use this configuration variable and send + the fields needed for wav2med auxiliary file + + + char + aux_hist + MED_attributes + + Sw_hs_avg:Sw_Tm1_avg:Sw_thm_avg:Sw_u_avg:Sw_v_avg:Sw_ustokes_avg:Sw_vstokes_avg:Sw_tusx_avg:Sw_tusy_avg:Sw_thp0_avg:Sw_fp0_avg:Sw_phs0_avg:Sw_phs1_avg:Sw_pdir0_avg:Sw_pdir1_avg:Sw_pTm10_avg:Sw_pTm11_avg + + Auxiliary mediator wav2med file1 colon delimited output + fields. NOTE: these are assumed to be time averaged over a day in + the WW3 cap - so the settings of histaux_wav2med_file1_history_n + and histaux_wav2med_file1_history_option should be 1 and ndays, + respectively. + + + char + aux_hist + MED_attributes + + ndays + + Auxiliary mediator wav2med file1 output option + + + integer + aux_hist + MED_attributes + + 1 + + Auxiliary mediator wav2med file1 output frequency (used for option type) + + + logical + aux_hist + MED_attributes + + .false. + + Auxiliary mediator wav2med file1 time averaged flag for file output. + If this flag is set to .false. only instantaneous output will be created in the auxiliary file. + + + char + aux_hist + MED_attributes + + wav.24h.avg + + + + integer + aux_hist + MED_attributes + Number of time samples per file. + + 30 + + + @@ -2195,54 +2267,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 @@ -2267,42 +2291,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 - - @@ -2635,24 +2623,6 @@ - - - - - - - - - - - - - - - - - - char time @@ -2874,137 +2844,6 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 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/cime_config/runseq/driver_config.py b/cime_config/runseq/driver_config.py index 9694c7503..7b8756e10 100644 --- a/cime_config/runseq/driver_config.py +++ b/cime_config/runseq/driver_config.py @@ -58,7 +58,7 @@ def __compute_glc(self, case, coupling_times): med_to_glc = False elif (comp_glc == 'cism'): if not case.get_value("CISM_EVOLVE"): - med_to_glc = False + run_glc = False # If CISM is not evolving only get data back from cism at the initial time # However will still need to call the exchange at the end if the stop_option @@ -77,6 +77,12 @@ def __compute_glc(self, case, coupling_times): glc_coupling_time = stop_n * 86400 else: glc_coupling_time = 86400 + elif (comp_glc == 'dglc'): + glc_coupling_time = coupling_times["glc_cpl_dt"] + stop_option = case.get_value('STOP_OPTION') + stop_n = case.get_value('STOP_N') + if stop_option == 'nsteps': + glc_coupling_time = stop_n*coupling_times["atm_cpl_dt"] elif (comp_glc == 'xglc'): glc_coupling_time = coupling_times["glc_cpl_dt"] else: diff --git a/cime_config/runseq/runseq_TG.py b/cime_config/runseq/runseq_TG.py index dea8aede5..acf56a87b 100644 --- a/cime_config/runseq/runseq_TG.py +++ b/cime_config/runseq/runseq_TG.py @@ -34,8 +34,10 @@ def gen_runseq(case, coupling_times): runseq.add_action ("MED med_phases_post_lnd" , run_lnd) runseq.add_action ("MED med_phases_prep_glc" , med_to_glc) runseq.add_action ("MED -> GLC :remapMethod=redist" , med_to_glc) - runseq.add_action ("GLC" , run_glc and med_to_glc) - runseq.add_action ("GLC -> MED :remapMethod=redist" , run_glc) + runseq.add_action ("GLC" , run_glc) + # Need to do GLC -> MED even if not running GLC; otherwise, we get a + # failure in InitializeRealize ("Object being used before creation") + runseq.add_action ("GLC -> MED :remapMethod=redist" , med_to_glc) runseq.add_action ("MED med_phases_history_write" , True) runseq.leave_time_loop(True) diff --git a/cime_config/runseq/runseq_general.py b/cime_config/runseq/runseq_general.py index ddbfca598..04a0d6f4f 100644 --- a/cime_config/runseq/runseq_general.py +++ b/cime_config/runseq/runseq_general.py @@ -20,7 +20,7 @@ def gen_runseq(case, coupling_times): cpl_seq_option = case.get_value('CPL_SEQ_OPTION') coupling_mode = case.get_value('COUPLING_MODE') diag_mode = case.get_value('BUDGETS') - xcompset = case.get_value("COMP_ATM") == 'xatm' + xcompset = case.get_value("COMP_ATM") == 'xatm' cpl_add_aoflux = not xcompset and case.get_value('ADD_AOFLUX_TO_RUNSEQ') # It is assumed that if a component will be run it will send information to the mediator @@ -35,19 +35,6 @@ def gen_runseq(case, coupling_times): run_rof, med_to_rof, rof_cpl_time = driver_config['rof'] run_wav, med_to_wav, wav_cpl_time = driver_config['wav'] - comp_glc = case.get_value("COMP_GLC") - run_glc = False - post_glc = False - if (comp_glc == 'cism'): - run_glc = True - if case.get_value("CISM_EVOLVE"): - post_glc = True - else: - post_glc = False - elif (comp_glc == 'xglc'): - run_glc = True - post_glc = True - # Note: assume that atm_cpl_dt, lnd_cpl_dt, ice_cpl_dt and wav_cpl_dt are the same if lnd_cpl_time != atm_cpl_time: @@ -59,18 +46,32 @@ def gen_runseq(case, coupling_times): if rof_cpl_time < ocn_cpl_time: expect(False, "assume that rof_cpl_time is always greater than or equal to ocn_cpl_time") + if run_glc: + # It wouldn't make sense to run GLC unless we also do MED -> GLC to transfer fields to GLC, + # and some of the below logic controlling what appears in the run sequence depends on this + # (i.e., depends on the fact that, if run_glc is True, then med_to_glc is also True). + expect(med_to_glc, "if run_glc is True, then med_to_glc must also be True") + rof_outer_loop = run_rof and rof_cpl_time > atm_cpl_time ocn_outer_loop = run_ocn and ocn_cpl_time > atm_cpl_time + # Note that we do some aspects of the GLC outer loop even if run_glc is False + # (as long as med_to_glc is True). + # + # Note that, in contrast to the other outer_loop variables, this doesn't check glc_cpl_time. + # This is for consistency with the logic that was in place before adding this variable; + # this seems to implicitly assume that glc_cpl_time > atm_cpl_time. + glc_outer_loop = med_to_glc + inner_loop = ((atm_cpl_time < ocn_cpl_time) or (atm_cpl_time < rof_cpl_time) or - (run_glc and atm_cpl_time < glc_cpl_time) or + (glc_outer_loop and atm_cpl_time < glc_cpl_time) or atm_cpl_time == ocn_cpl_time) with RunSeq(os.path.join(caseroot, "CaseDocs", "nuopc.runseq")) as runseq: #------------------ - runseq.enter_time_loop(glc_cpl_time, newtime=run_glc, active=med_to_glc) + runseq.enter_time_loop(glc_cpl_time, newtime=glc_outer_loop) #------------------ #------------------ @@ -199,8 +200,10 @@ def gen_runseq(case, coupling_times): runseq.add_action("MED med_phases_prep_glc" , med_to_glc) runseq.add_action("MED -> GLC :remapMethod=redist" , med_to_glc) - runseq.add_action("GLC" , run_glc and med_to_glc) - runseq.add_action("GLC -> MED :remapMethod=redist" , run_glc) - runseq.add_action("MED med_phases_post_glc" , run_glc and post_glc) + runseq.add_action("GLC" , run_glc) + # Need to do GLC -> MED even if not running GLC; otherwise, we get a + # failure in InitializeRealize ("Object being used before creation") + runseq.add_action("GLC -> MED :remapMethod=redist" , med_to_glc) + runseq.add_action("MED med_phases_post_glc" , run_glc) shutil.copy(os.path.join(caseroot, "CaseDocs", "nuopc.runseq"), rundir) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index c7cee8d98..7055fdf7e 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) - - ! 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) + ! 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 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) @@ -1368,7 +1412,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if ! --------------------------------------------------------------------- - ! to atm: unmerged ugust_out from ocn + ! to atm: unmerged ugust_out from ocn ! --------------------------------------------------------------------- if (phase == 'advertise') then call addfld_aoflux('So_ugustOut') @@ -1385,6 +1429,39 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if + ! --------------------------------------------------------------------- + ! to atm: 10 m winds including/excluding gust component + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld_aoflux('So_u10withGust') + call addfld_to(compatm, 'So_u10withGust') + else + if ( fldchk(is_local%wrap%FBexp(compatm), 'So_u10withGust', rc=rc)) then + if (fldchk(is_local%wrap%FBMed_aoflux_o, 'So_u10withGust', rc=rc)) then + if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then + call addmap_aoflux('So_u10withGust', compatm, mapconsf, 'ofrac', ocn2atm_map) + end if + call addmrg_to(compatm , 'So_u10withGust', & + mrg_from=compmed, mrg_fld='So_u10withGust', mrg_type='merge', mrg_fracname='ofrac') + end if + end if + end if + + if (phase == 'advertise') then + call addfld_aoflux('So_u10res') + call addfld_to(compatm, 'So_u10res') + else + if ( fldchk(is_local%wrap%FBexp(compatm), 'So_u10res', rc=rc)) then + if (fldchk(is_local%wrap%FBMed_aoflux_o, 'So_u10res', rc=rc)) then + if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then + call addmap_aoflux('So_u10res', compatm, mapconsf, 'ofrac', ocn2atm_map) + end if + call addmrg_to(compatm , 'So_u10res', & + mrg_from=compmed, mrg_fld='So_u10res', mrg_type='merge', mrg_fracname='ofrac') + end if + end if + end if + ! --------------------------------------------------------------------- ! to atm: surface snow depth from ice (needed for cam) ! to atm: mean ice volume per unit area from ice @@ -1474,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 @@ -1484,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 @@ -1494,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') @@ -1507,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) ! --------------------------------------------------------------------- @@ -1520,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 !----------------------------------------------------------------------------- @@ -1534,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 !----------------------------------------------------------------------------- @@ -1549,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' @@ -1561,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 !----------------------------------------------------------------------------- @@ -1574,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) !===================================================================== @@ -1804,7 +1972,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addfld_from(compatm, 'Faxa_snowl') call addfld_to(compocn, 'Faxa_snow' ) else - ! TODO: why are we not merging Faxa_rain and Faxa_snow if they are sent from atm wiht ofrac + ! TODO: why are we not merging Faxa_rain and Faxa_snow if they are sent from atm with ofrac ! Note that the mediator atm/ocn flux calculation needs Faxa_rainc for the gustiness parameterization ! which by default is not actually used if ( fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainl', rc=rc) .and. & @@ -1936,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 @@ -2153,134 +2347,118 @@ 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 - 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') + ! 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 + 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 + end if + end if + + ! 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 + 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 - ! 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 + + ! 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 - 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 - end if - end if + !----------------------------- + ! from wav: for daily averaged fields for + ! output to auxiliary file only + !----------------------------- + if (phase == 'advertise') then + call addfld_from(compwav, 'Sw_ustokes_avg') + call addfld_from(compwav, 'Sw_vstokes_avg') + call addfld_from(compwav, 'Sw_hs_avg') + call addfld_from(compwav, 'Sw_phs0_avg') + call addfld_from(compwav, 'Sw_phs1_avg') + call addfld_from(compwav, 'Sw_pdir0_avg') + call addfld_from(compwav, 'Sw_pdir1_avg') + call addfld_from(compwav, 'Sw_pTm10_avg') + call addfld_from(compwav, 'Sw_pTm11_avg') + call addfld_from(compwav, 'Sw_Tm1_avg') + call addfld_from(compwav, 'Sw_thm_avg') + call addfld_from(compwav, 'Sw_thp0_avg') + call addfld_from(compwav, 'Sw_fp0_avg') + call addfld_from(compwav, 'Sw_u_avg') + call addfld_from(compwav, 'Sw_v_avg') + call addfld_from(compwav, 'Sw_tusx_avg') + call addfld_from(compwav, 'Sw_tusy_avg') end if !----------------------------- @@ -2292,7 +2470,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 @@ -2305,7 +2483,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 @@ -2318,7 +2496,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 @@ -2331,7 +2509,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 @@ -2344,7 +2522,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 @@ -2357,7 +2535,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 @@ -2800,54 +2978,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) ! --------------------------------------------------------------------- @@ -2858,7 +2988,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 @@ -2879,7 +3009,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 @@ -2893,7 +3023,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 @@ -2908,7 +3038,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 @@ -2922,8 +3052,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 @@ -2937,7 +3066,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 @@ -2948,7 +3077,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 @@ -2963,7 +3092,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 @@ -2974,22 +3103,36 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (phase == 'advertise') then call addfld_from(compatm, 'Sa_u') call addfld_to(compwav, 'Sa_u') + call addfld_from(compatm, 'Sa_u10m') + call addfld_to(compwav, 'Sa_u10m') else if ( fldchk(is_local%wrap%FBexp(compwav) , 'Sa_u', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_u', rc=rc)) then call addmap_from(compatm, 'Sa_u', compwav, mapbilnr, 'one', atm2wav_map) call addmrg_to(compwav, 'Sa_u', mrg_from=compatm, mrg_fld='Sa_u', mrg_type='copy') end if + if ( fldchk(is_local%wrap%FBexp(compwav) , 'Sa_u10m', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_u10m', rc=rc)) then + call addmap_from(compatm, 'Sa_u10m', compwav, mapbilnr, 'one', atm2wav_map) + call addmrg_to(compwav, 'Sa_u10m', mrg_from=compatm, mrg_fld='Sa_u10m', mrg_type='copy') + end if end if if (phase == 'advertise') then call addfld_from(compatm, 'Sa_v') call addfld_to(compwav, 'Sa_v') + call addfld_from(compatm, 'Sa_v10m') + call addfld_to(compwav, 'Sa_v10m') else if ( fldchk(is_local%wrap%FBexp(compwav) , 'Sa_v', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_v', rc=rc)) then call addmap_from(compatm, 'Sa_v', compwav, mapbilnr, 'one', atm2wav_map) call addmrg_to(compwav, 'Sa_v', mrg_from=compatm, mrg_fld='Sa_v', mrg_type='copy') end if + if ( fldchk(is_local%wrap%FBexp(compwav) , 'Sa_v10m', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_v10m', rc=rc)) then + call addmap_from(compatm, 'Sa_v10m', compwav, mapbilnr, 'one', atm2wav_map) + call addmrg_to(compwav, 'Sa_v10m', mrg_from=compatm, mrg_fld='Sa_v10m', mrg_type='copy') + end if end if ! --------------------------------------------------------------------- @@ -3018,6 +3161,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) ! --------------------------------------------------------------------- @@ -3027,9 +3215,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 @@ -3042,9 +3230,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 @@ -3057,9 +3245,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 @@ -3072,9 +3260,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 @@ -3087,9 +3275,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 @@ -3119,14 +3307,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 @@ -3156,158 +3344,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if - !===================================================================== - ! CO2 EXCHANGE - !===================================================================== - - call NUOPC_CompAttributeGet(gcomp, name='flds_co2a', value=cvalue, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) flds_co2a - call ESMF_LogWrite('flds_co2a = '// trim(cvalue), ESMF_LOGMSG_INFO) - - call NUOPC_CompAttributeGet(gcomp, name='flds_co2b', value=cvalue, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) flds_co2b - call ESMF_LogWrite('flds_co2b = '// trim(cvalue), ESMF_LOGMSG_INFO) - - call NUOPC_CompAttributeGet(gcomp, name='flds_co2c', value=cvalue, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) flds_co2c - call ESMF_LogWrite('flds_co2c = '// trim(cvalue), ESMF_LOGMSG_INFO) - - if (flds_co2a) then - ! --------------------------------------------------------------------- - ! to lnd and ocn: prognostic CO2 at the lowest atm model level - ! --------------------------------------------------------------------- - if (phase == 'advertise') then - call addfld_from(compatm, 'Sa_co2prog') - call addfld_to(complnd, 'Sa_co2prog') - call addfld_to(compocn, 'Sa_co2prog') - else - call addmap_from(compatm, 'Sa_co2prog', complnd, mapbilnr, 'one', atm2lnd_map) - call addmap_from(compatm, 'Sa_co2prog', compocn, mapbilnr, 'one', atm2ocn_map) - - call addmrg_to(complnd, 'Sa_co2prog', & - mrg_from=compatm, mrg_fld='Sa_co2prog', mrg_type='copy') - call addmrg_to(compocn, 'Sa_co2prog', & - mrg_from=compatm, mrg_fld='Sa_co2prog', mrg_type='copy') - end if - - ! --------------------------------------------------------------------- - ! to lnd and ocn: diagnostic CO2 at the lowest atm model level - ! --------------------------------------------------------------------- - if (phase == 'advertise') then - call addfld_from(compatm, 'Sa_co2diag') - call addfld_to(complnd, 'Sa_co2diag') - call addfld_to(compocn, 'Sa_co2diag') - else - call addmap_from(compatm, 'Sa_co2diag', complnd, mapbilnr, 'one', atm2lnd_map) - call addmap_from(compatm, 'Sa_co2diag', compocn, mapbilnr, 'one', atm2ocn_map) - - call addmrg_to(complnd, 'Sa_co2diag', & - mrg_from=compatm, mrg_fld='Sa_co2diag', mrg_type='copy') - call addmrg_to(compocn, 'Sa_co2diag', & - mrg_from=compatm, mrg_fld='Sa_co2diag', mrg_type='copy') - end if - - else if (flds_co2b) then - - ! --------------------------------------------------------------------- - ! to lnd: prognostic CO2 at the lowest atm model level - ! --------------------------------------------------------------------- - if (phase == 'advertise') then - call addfld_from(compatm, 'Sa_co2prog') - call addfld_to(complnd, 'Sa_co2prog') - else - call addmap_from(compatm, 'Sa_co2prog', complnd, mapbilnr, 'one', atm2lnd_map) - call addmrg_to(complnd, 'Sa_co2prog', & - mrg_from=compatm, mrg_fld='Sa_co2prog', mrg_type='copy') - end if - - ! --------------------------------------------------------------------- - ! to lnd: diagnostic CO2 at the lowest atm model level - ! --------------------------------------------------------------------- - if (phase == 'advertise') then - call addfld_from(compatm, 'Sa_co2diag') - call addfld_to(complnd, 'Sa_co2diag') - else - call addmap_from(compatm, 'Sa_co2diag', complnd, mapbilnr, 'one', atm2lnd_map) - call addmrg_to(complnd, 'Sa_co2diag', & - mrg_from=compatm, mrg_fld='Sa_co2diag', mrg_type='copy') - end if - - ! --------------------------------------------------------------------- - ! to atm: surface flux of CO2 from land - ! --------------------------------------------------------------------- - if (phase == 'advertise') then - call addfld_from(complnd, 'Fall_fco2_lnd') - call addfld_to(compatm, 'Fall_fco2_lnd') - else - call addmap_from(complnd, 'Fall_fco2_lnd', compatm, mapconsf, 'one', lnd2atm_map) - call addmrg_to(compatm, 'Fall_fco2_lnd', & - mrg_from=complnd, mrg_fld='Fall_fco2_lnd', mrg_type='copy_with_weights', mrg_fracname='lfrac') - end if - - else if (flds_co2c) then - - ! --------------------------------------------------------------------- - ! to lnd and ocn: prognostic CO2 at the lowest atm model level - ! --------------------------------------------------------------------- - if (phase == 'advertise') then - call addfld_from(compatm, 'Sa_co2prog') - call addfld_to(complnd, 'Sa_co2prog') - call addfld_to(compocn, 'Sa_co2prog') - else - call addmap_from(compatm, 'Sa_co2prog', complnd, mapbilnr, 'one', atm2lnd_map) - call addmap_from(compatm, 'Sa_co2prog', compocn, mapbilnr, 'one', atm2ocn_map) - - call addmrg_to(complnd, 'Sa_co2prog', & - mrg_from=compatm, mrg_fld='Sa_co2prog', mrg_type='copy') - call addmrg_to(compocn, 'Sa_co2prog', & - mrg_from=compatm, mrg_fld='Sa_co2prog', mrg_type='copy') - end if - - ! --------------------------------------------------------------------- - ! to lnd and ocn: diagnostic CO2 at the lowest atm model level - ! --------------------------------------------------------------------- - if (phase == 'advertise') then - call addfld_from(compatm, 'Sa_co2diag') - call addfld_to(complnd, 'Sa_co2diag') - call addfld_to(compocn, 'Sa_co2diag') - else - call addmap_from(compatm, 'Sa_co2diag', complnd, mapbilnr, 'one', atm2lnd_map) - call addmap_from(compatm, 'Sa_co2diag', compocn, mapbilnr, 'one', atm2ocn_map) - - call addmrg_to(complnd, 'Sa_co2diag', & - mrg_from=compatm, mrg_fld='Sa_co2diag', mrg_type='copy') - call addmrg_to(compocn, 'Sa_co2diag', & - mrg_from=compatm, mrg_fld='Sa_co2diag', mrg_type='copy') - end if - - ! --------------------------------------------------------------------- - ! to atm: surface flux of CO2 from land - ! --------------------------------------------------------------------- - if (phase == 'advertise') then - call addfld_from(complnd, 'Fall_fco2_lnd') - call addfld_to(compatm, 'Fall_fco2_lnd') - else - call addmap_from(complnd, 'Fall_fco2_lnd', compatm, mapconsf, 'one', lnd2atm_map) - call addmrg_to(compatm, 'Fall_fco2_lnd', & - mrg_from=complnd, mrg_fld='Fall_fco2_lnd', mrg_type='copy_with_weights', mrg_fracname='lfrac') - end if - - ! --------------------------------------------------------------------- - ! to atm: surface flux of CO2 from ocn - ! --------------------------------------------------------------------- - if (phase == 'advertise') then - call addfld_from(compocn, 'Faoo_fco2_ocn') - call addfld_to(compatm, 'Faoo_fco2_ocn') - else - call addmap_from(compocn, 'Faoo_fco2_ocn', compatm, mapconsd, 'one', ocn2atm_map) - ! custom merge in med_phases_prep_atm - end if - endif - end subroutine esmFldsExchange_cesm end module esmFldsExchange_cesm_mod diff --git a/mediator/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 eaef1dc78..c6d57857c 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -3,844 +3,950 @@ institution: National ESPC, CSC & MCL Working Groups description: Community-based dictionary for shared coupling fields entries: - # - #----------------------------------- - # section: mediator export for atm/ocn flux calculation - #----------------------------------- - # + # + #----------------------------------- + # Current the following sections are below + # section: fields computed in med + # section: lnd import to med + # section: lnd export from med (computed in med) + # section: atm import to med + # section: atm export from med (computed in med) + # section: glc import to med + # section: glc export from med (computed in med) + # section: ice import to med + # section: ocn import to med + # section: ocn export from med (computed in med) + # section: river import to med + # section: river export from med (computed in med) + # section: wav import to med + #----------------------------------- + # + #----------------------------------- + # section: fields computed in med + #----------------------------------- + # + - standard_name: cpl_scalars + canonical_units: unitless + # + - standard_name: frac + canonical_units: 1 + # + - standard_name: mask + canonical_units: 1 + # + - standard_name: area + canonical_units: radians**2 + description: med area for component + # - standard_name: Faox_evap alias: mean_evap_rate_atm_into_ocn canonical_units: kg m-2 s-1 - description: mediator export - atm/ocn evaporation water flux + description: med export - atm/ocn evaporation water flux computed in medidator # - standard_name: Faox_evap_wiso canonical_units: kg m-2 s-1 - description: mediator export - atm/ocn evaporation water flux 16O, 18O, HDO + description: med export - atm/ocn evaporation water flux 16O, 18O, HDO computed in medidator # - standard_name: Faox_lat alias: mean_laten_heat_flx_atm_into_ocn canonical_units: W m-2 - description: mediator export - atm/ocn surface latent heat flux + description: med export - atm/ocn surface latent heat flux computed in medidator # - standard_name: Faox_sen alias: mean_sensi_heat_flx_atm_into_ocn canonical_units: W m-2 - description: mediator export - atm/ocn surface sensible heat flux + description: med export - atm/ocn surface sensible heat flux computed in medidator # - standard_name: Faox_lwup alias: mean_up_lw_flx_ocn canonical_units: W m-2 - description: mediator export - long wave radiation flux over the ocean + description: med export - ocn long wave radiation flux over the ocean computed in medidator # - standard_name: Faox_taux alias: stress_on_air_ocn_zonal canonical_units: N m-2 - description: mediator export + description: med export - atm/ocn zonal surface stress computed in medidator # - standard_name: Faox_tauy alias: stress_on_air_ocn_merid canonical_units: N m-2 - description: mediator export + description: med export - atm/ocn meridional surface stress computed in medidator # - - standard_name: area - canonical_units: radians**2 - description: mediator area for component + - standard_name: Fwxx_taux + alias: mean_zonal_moment_flx + canonical_units: N m-2 + description: wave import to med - zonal surface stress + # + - standard_name: Fwxx_tauy + alias: mean_merid_moment_flx + canonical_units: N m-2 + description: wave import to med - meridional surface stress # #----------------------------------- - # section: land export + # section: lnd import to med #----------------------------------- # - standard_name: Fall_evap canonical_units: kg m-2 s-1 - description: land export + description: lnd import to med # - standard_name: Fall_evap_wiso canonical_units: kg m-2 s-1 - description: land export + description: lnd import to med # - standard_name: Fall_fco2_lnd canonical_units: moles m-2 s-1 - description: land export + description: lnd import to med # - standard_name: Fall_fire canonical_units: kg/m2/sec - description: land export - wild fire emission fluxes (1->10) + description: lnd import to med - wild fire emission fluxes (1->10) # - standard_name: Fall_flxdst canonical_units: kg m-2 s-1 - description: land export - dust fluxes from land (sizes 1->4) + description: lnd import to med - dust fluxes from lnd (sizes 1->4) # - standard_name: Fall_lat canonical_units: W m-2 - description: land export + description: lnd import to med # - standard_name: Fall_lwup canonical_units: W m-2 - description: land export + description: lnd import to med # - standard_name: Fall_sen canonical_units: W m-2 - description: land export + description: lnd import to med # - standard_name: Fall_swnet canonical_units: W m-2 - description: land export + description: lnd import to med # - standard_name: Fall_taux canonical_units: N m-2 - description: land export + description: lnd import to med # - standard_name: Fall_tauy canonical_units: N m-2 - description: land export + description: lnd import to med # - standard_name: Fall_voc canonical_units: molecules/m2/sec - description: land export - MEGAN voc emission fluxes from land (1->20) + description: lnd import to med - MEGAN voc emission fluxes from lnd (1->20) # - standard_name: Sl_anidf canonical_units: 1 - description: land export + description: lnd import to med # - standard_name: Sl_anidr canonical_units: 1 - description: land export + description: lnd import to med # - standard_name: Sl_avsdf canonical_units: 1 - description: land export + description: lnd import to med # - standard_name: Sl_avsdr canonical_units: 1 - description: land export + description: lnd import to med # - standard_name: Sl_ddvel canonical_units: cm/sec - description: land export - dry deposition velocities from (1->80) + description: lnd import to med - dry deposition velocities from (1->80) # - standard_name: Sl_fv canonical_units: m s-1 - description: land export + description: lnd import to med # - standard_name: Sl_fztop canonical_units: m - description: land export + description: lnd import to med # - standard_name: Sl_lfrac canonical_units: 1 - description: land export + description: lnd import to med # - standard_name: Sl_lfrin canonical_units: 1 - description: land export + description: lnd import to med # - standard_name: Sl_qref canonical_units: kg kg-1 - description: land export + description: lnd import to med # - standard_name: Sl_qref_wiso canonical_units: kg kg-1 - description: land export + description: lnd import to med # - standard_name: Sl_ram1 canonical_units: s/m - description: land export + description: lnd import to med # - standard_name: Sl_snowh canonical_units: m - description: land export + description: lnd import to med # - standard_name: Sl_snowh_wiso canonical_units: m - description: land export + description: lnd import to med # - standard_name: Sl_soilw canonical_units: m3/m3 - description: land export + description: lnd import to med # - standard_name: Sl_t canonical_units: K - description: land export + description: lnd import to med # - - standard_name: Sl_topo_elev - canonical_units: m - description: land export to mediator in elevation classes (1->glc_nec) + - standard_name: Flrl_irrig + canonical_units: kg m-2 s-1 + description: lnd export to river # - - standard_name: Sl_topo + - standard_name: Flrl_rofdto + canonical_units: kg m-2 s-1 + description: lnd export to river + # + - standard_name: Flrl_rofgwl + canonical_units: kg m-2 s-1 + description: lnd export to river + # + - standard_name: Flrl_rofi + canonical_units: kg m-2 s-1 + description: lnd export to river + # + - standard_name: Flrl_rofsub + canonical_units: kg m-2 s-1 + description: lnd export to river + # + - standard_name: Flrl_rofsur + canonical_units: kg m-2 s-1 + description: lnd export to river + # + - standard_name: Sl_topo_elev canonical_units: m - description: mediator export to glc - no levation classes + description: lnd import to med with elevation classes (1->glc_nec) # - standard_name: Sl_tsrf_elev canonical_units: deg C - description: land export to mediator in elevation classes (1->glc_nec) + description: lnd import to med with elevation classes (1->glc_nec) + # + - standard_name: Flgl_qice_elev + canonical_units: kg m-2 s-1 + description: lnd import to med in elevation classes (1->glc_nec) + # + #----------------------------------- + # section: lnd export from med (computed in med) + #----------------------------------- + # + - standard_name: Sl_topo + canonical_units: m + description: lnd export from med with no elevation classes (computed in med) # - standard_name: Sl_tsrf canonical_units: deg C - description: mediator export to gcl with no elevation classes + description: lnd export from med with no elevation classes (computed in med) # - standard_name: Sl_tref canonical_units: K - description: mediator export to glc - no levation classes + description: lnd export from med with no elevation classes (computed in med) # - standard_name: Sl_u10 canonical_units: m - description: land export + description: lnd import to med with no elevation classes (computed in med) + # + - standard_name: Flgl_qice + canonical_units: kg m-2 s-1 + description: lnd export to med no elevation classes (computed in med) # #----------------------------------- - # section: atmosphere export + # section: atm import to med #----------------------------------- # - standard_name: Faxa_nhx canonical_units: kg m-2 s-1 - description: atmosphere export + description: atm import to med # - standard_name: Faxa_noy canonical_units: kg m-2 s-1 - description: atmosphere export + description: atm import to med # - standard_name: Faxa_bcph canonical_units: kg m-2 s-1 - description: atmosphere export + description: atm import to med # - standard_name: Faxa_ocph canonical_units: kg m-2 s-1 - description: atmosphere export + description: atm import to med # - standard_name: Faxa_dstdry canonical_units: kg m-2 s-1 - description: atmosphere export + description: atm import to med # - standard_name: Faxa_dstwet canonical_units: kg m-2 s-1 - description: atmosphere export + description: atm import to med # - standard_name: Faxa_swdn alias: mean_down_sw_flx canonical_units: W m-2 - description: atmosphere export + description: atm import to med mean downward SW heat flux # - standard_name: Faxa_lwdn alias: mean_down_lw_flx canonical_units: W m-2 - description: atmosphere export + description: atm import to med mean downward SW heat flux # - standard_name: Faxa_ndep canonical_units: kg(N)/m2/sec - description: atmosphere export to land and ocean - currently nhx and noy + description: atm import to med - currently nhx and noy # - standard_name: Faxa_prec_wiso canonical_units: kg m-2 s-1 - description: atmosphere export + description: atm import to med # - standard_name: Faxa_rain alias: mean_prec_rate canonical_units: kg m-2 s-1 - description: atmosphere export + description: atm import to med # - standard_name: Faxa_rain_wiso alias: mean_prec_rate_wiso canonical_units: kg m-2 s-1 - description: atmosphere export + description: atm import to med # - standard_name: Faxa_rainc canonical_units: kg m-2 s-1 - description: atmosphere export + description: atm import to med # - standard_name: Faxa_rainc_wiso canonical_units: kg m-2 s-1 - description: atmosphere export + description: atm import to med # - standard_name: Faxa_rainl canonical_units: kg m-2 s-1 - description: atmosphere export + description: atm import to med # - standard_name: Faxa_rainl_wiso canonical_units: kg m-2 s-1 - description: atmosphere export + description: atm import to med # - standard_name: Faxa_snow alias: mean_fprec_rate canonical_units: kg m-2 s-1 - description: atmosphere export + description: atm import to med # - standard_name: Faxa_snow_wiso canonical_units: kg m-2 s-1 - description: atmosphere export + description: atm import to med # - standard_name: Faxa_snowc canonical_units: kg m-2 s-1 - description: atmosphere export + description: atm import to med # - standard_name: Faxa_snowc_wiso canonical_units: kg m-2 s-1 - description: atmosphere export + description: atm import to med # - standard_name: Faxa_snowl canonical_units: kg m-2 s-1 - description: atmosphere export + description: atm import to med # - standard_name: Faxa_snowl_wiso canonical_units: kg m-2 s-1 - description: atmosphere export + description: atm import to med # - standard_name: Faxa_swnet canonical_units: W m-2 - description: atmosphere export + description: atm import to med # - standard_name: Faxa_lwnet canonical_units: W m-2 - description: atmosphere export + description: atm import to med # - standard_name: Faxa_swndf alias: mean_down_sw_ir_dif_flx canonical_units: W m-2 - description: atmosphere export - mean surface downward nir diffuse flux + description: atm import to med - mean surface downward nir diffuse flux # - standard_name: Faxa_swndr alias: mean_down_sw_ir_dir_flx canonical_units: W m-2 - description: atmosphere export - mean surface downward nir direct flux + description: atm import to med - mean surface downward nir direct flux # - standard_name: Faxa_swvdf alias: mean_down_sw_vis_dif_flx canonical_units: W m-2 - description: atmosphere export - mean surface downward uv+vis diffuse flux + description: atm import to med - mean surface downward uv+vis diffuse flux # - standard_name: Faxa_swvdr alias: mean_down_sw_vis_dir_flx canonical_units: W m-2 - description: atmosphere export - mean surface downward uv+visvdirect flux + description: atm import to med - mean surface downward uv+visvdirect flux # - standard_name: Sa_co2diag canonical_units: 1e-6 mol/mol - description: atmosphere export - diagnostic CO2 at the lowest model level + description: atm import to med - diagnostic CO2 at the lowest model level # - standard_name: Sa_co2prog canonical_units: 1e-6 mol/mol - description: atmosphere export - prognostic CO2 at the lowest model level + description: atm import to med - prognostic CO2 at the lowest model level # - standard_name: Sa_o3 canonical_units: mol/mol - description: atmosphere export - O3 in the lowest model layer (prognosed or prescribed) + description: atm import to med - O3 in the lowest model layer (prognosed or prescribed) # - standard_name: Sa_lightning canonical_units: /min - description: atmosphere export - lightning flash freqency + description: atm import to med - lightning flash freqency # - standard_name: Sa_topo alias: inst_surface_height canonical_units: m - description: atmosphere export - topographic height + description: atm import to med - topographic height # - standard_name: Sa_dens alias: air_density_height_lowest canonical_units: kg m-3 - description: atmosphere export - density at the lowest model layer + description: atm import to med - density at the lowest model layer # - standard_name: Sa_pbot alias: inst_pres_height_lowest canonical_units: Pa - description: atmosphere export - pressure at lowest model layer + description: atm import to med - pressure at lowest model layer # - standard_name: Sa_pslv alias: inst_pres_height_surface canonical_units: Pa - description: atmosphere export + description: atm import to med # - standard_name: Sa_ptem canonical_units: K - description: atmosphere export - bottom layer potential temperature + description: atm import to med - bottom layer potential temperature # - standard_name: Sa_shum alias: inst_spec_humid_height_lowest canonical_units: kg kg-1 - description: atmosphere export - bottom layer specific humidity + description: atm import to med - bottom layer specific humidiaty # - standard_name: Sa_shum_wiso alias: inst_spec_humid_height_lowest_wiso canonical_units: kg kg-1 - description: atmosphere export - bottom layer specific humidity 16O, 18O, HDO + description: atm import to med - bottom layer specific humidity 16O, 18O, HDO # - standard_name: Sa_tbot alias: inst_temp_height_lowest canonical_units: K - description: atmosphere export - bottom layer temperature + description: atm import to med - bottom layer temperature # - standard_name: Sa_tskn alias: inst_temp_skin_temperature canonical_units: K - description: atmosphere export - sea surface skin temperature + description: atm import to med - sea surface skin temperature # - standard_name: Sa_u alias: inst_zonal_wind_height_lowest canonical_units: m s-1 - description: atmosphere export - bottom layer zonal wind + description: atm import to med - bottom layer zonal wind # - standard_name: Sa_v alias: inst_merid_wind_height_lowest canonical_units: m s-1 - description: atmosphere export - bottom layer meridional wind + description: atm import to med - bottom layer meridional wind + # + - standard_name: Sa_u10m + canonical_units: m s-1 + description: atm import to med - 10m zonal wind + # + - standard_name: Sa_v10m + canonical_units: m s-1 + description: atm import to med- 10m meridional wind # - standard_name: Sa_wspd alias: inst_wind_speed_height_lowest canonical_units: m s-1 - description: atmosphere export - bottom layer wind speed + description: atm import to med - bottom layer wind speed # - standard_name: Sa_z alias: inst_height_lowest canonical_units: m - description: atmosphere export - bottom layer height + description: atm import to med - bottom layer height # - standard_name: Faxa_taux alias: mean_zonal_moment_flx_atm canonical_units: N m-2 - description: atmosphere export - zonal component of momentum flux + description: atm import to med - zonal component of momentum flux # - standard_name: Faxa_tauy alias: mean_merid_moment_flx_atm canonical_units: N m-2 - description: atmosphere export - meridional component of momentum flux + description: atm import to med - meridional component of momentum flux # - standard_name: Faxa_lat alias: mean_laten_heat_flx_atm canonical_units: W m-2 - description: atmosphere export + description: atm import to med # - standard_name: Faxa_sen alias: mean_sensi_heat_flx_atm canonical_units: W m-2 - description: atmosphere export + description: atm import to med # #----------------------------------- - # section: atmosphere import + # section: atm export from med (computed in med) #----------------------------------- # - standard_name: Faxx_evap canonical_units: kg m-2 s-1 - description: to atm merged water evaporation flux + description: atm export from meditor - merged water evaporation flux # - standard_name: Faxx_evap_wiso canonical_units: kg m-2 s-1 - description: to atm merged water evaporation flux for 16O, 18O and HDO + description: atm export from med - merged water evaporation flux for 16O, 18O and HDO # - standard_name: Faxx_lat alias: mean_laten_heat_flx canonical_units: W m-2 - description: to to atm merged latent heat flux + description: atm export from med - merged latent heat flux # - standard_name: Faxx_lwup canonical_units: W m-2 - description: to atm merged outgoing longwave radiation + description: atm export from med - merged outgoing longwave radiation # - standard_name: Faxx_sen alias: mean_sensi_heat_flx canonical_units: W m-2 - description: to atm merged sensible heat flux + description: atm export from med - merged sensible heat flux # - standard_name: Faxx_taux alias: mean_zonal_moment_flx canonical_units: N m-2 - description: to atm merged zonal surface stress + description: atm export from med - merged zonal surface stress # - standard_name: Faxx_tauy alias: mean_merid_moment_flx canonical_units: N m-2 - description: to atm merged meridional surface stress + description: atm export from med - merged meridional surface stress # - standard_name: Sx_anidf canonical_units: 1 - description: atmosphere import - description: to atm merged surface diffuse albedo (near-infrared radiation) + description: atm export from med - merged surface diffuse albedo (near-infrared radiation) # - standard_name: Sx_anidr canonical_units: 1 - description: to atm merged direct surface albedo (near-infrared radiation) + description: atm export from med - merged direct surface albedo (near-infrared radiation) # - standard_name: Sx_avsdf canonical_units: 1 - description: to atm merged surface diffuse albedo (visible radation) + description: atm export from med - merged surface diffuse albedo (visible radation) # - standard_name: Sx_avsdr canonical_units: 1 - description: to atm merged direct surface albedo (visible radiation) + description: atm export from med - merged direct surface albedo (visible radiation) # - standard_name: Sx_qref canonical_units: kg kg-1 - description: atmosphere import + description: atm export from med # - standard_name: Sx_qref_wiso canonical_units: kg kg-1 - description: atmosphere import + description: atm export from med # - standard_name: Sx_t alias: surface_temperature canonical_units: K - description: atmosphere import + description: atm export from med # - standard_name: Sx_tref canonical_units: K - description: atmosphere import + description: atm export from med # - standard_name: Sx_u10 canonical_units: m - description: atmosphere import + description: atm export from med # - standard_name: So_ugustOut canonical_units: m/s - description: atmosphere import + description: atm export from med + # + - standard_name: So_u10withGust + canonical_units: m/s + description: atm export from med + # + - standard_name: So_u10res + canonical_units: m/s + description: atm export from med # #----------------------------------- - # section: land-ice export + # section: glc import to med + #----------------------------------- + # # 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: land-ice export - glc frozen runoff_iceberg flux to ice + description: glc import to med - glc frozen runoff_iceberg flux to ice # - standard_name: Figg_rofi_wiso canonical_units: kg m-2 s-1 - description: land-ice export - glc frozen runoff_iceberg flux to ice for 16O, 18O, HDO + description: glc import to med - glc frozen runoff_iceberg flux to ice for 16O, 18O, HDO # - standard_name: Flgg_hflx canonical_units: W m-2 - description: land-ice export to mediator (no elevation classes) - Downward heat flux from glacier interior, from mediator, elev class 0 - # - - standard_name: Flgg_hflx_elev - canonical_units: W m-2 - description: mediator land-ice export to lnd (elevation classes 1->glc_nec) - Downward heat flux from glacier interior, from mediator, elev class 1->glc_nec + description: glc import to med to med (no elevation classes) + Downward heat flux from glacier interior, from med, elev class 0 # - standard_name: Sg_area canonical_units: area internal to the CISM grid in radians**2 - description: land-ice export to mediator (no elevation classes) + description: glc import to med to med (no elevation classes) # - standard_name: Sg_ice_covered canonical_units: 1 - description: land-ice export to mediator (no elevation classes) - # - - standard_name: Sg_ice_covered_elev - canonical_units: 1 - description: mediator land-ice export to lnd (elevation classes 1->glc_nec) + description: glc import to med (no elevation classes) # - standard_name: Sg_icemask canonical_units: 1 - description: land-ice export + description: glc import to med # - standard_name: Sg_icemask_coupled_fluxes canonical_units: 1 - description: land-ice export + description: glc import to med # - standard_name: Sg_topo canonical_units: m - description: land-ice export to mediator (no elevation classes) + description: glc import to med (no elevation classes) # - - standard_name: Sg_topo_elev - canonical_units: m - description: mediator land-ice export to lnd (elevation classes 1->glc_nec) - # - - standard_name: Fogg_rofi - canonical_units: kg m-2 s-1 - description: land-ice export - glacier_frozen_runoff_flux_to_ocean + #----------------------------------- + # section: glc export from med (computed in med) + #----------------------------------- # - - standard_name: Fogg_rofi_wiso - canonical_units: kg m-2 s-1 - description: land-ice export - glacier_frozen_runoff_flux_to_ocean for 16O, 18O, HDO + - standard_name: Flgg_hflx_elev + canonical_units: W m-2 + description: glc export from med (elevation classes 1->glc_nec) + Downward heat flux from glacier interior, from med, elev class 1->glc_nec # - - standard_name: Fogg_rofl - canonical_units: kg m-2 s-1 - description: land-ice export - glacier liquid runoff flux to ocean + - standard_name: Sg_ice_covered_elev + canonical_units: 1 + description: glc export from med (elevation classes 1->glc_nec) # - - standard_name: Fogg_rofl_wiso - canonical_units: kg m-2 s-1 - description: land-ice export - glacier_frozen_runoff_flux_to_ocean for 16O, 18O, HDO + - standard_name: Sg_topo_elev + canonical_units: m + description: glc export from med (elevation classes 1->glc_nec) # #----------------------------------- - # section: sea-ice export + # section: ice import to med #----------------------------------- # - standard_name: Faii_evap alias: mean_evap_rate_atm_into_ice canonical_units: kg m-2 s-1 - description: sea-ice export + description: ice import to med # - standard_name: Faii_evap_wiso canonical_units: kg m-2 s-1 - description: sea-ice export for 16O, 18O, HDO + description: ice import to med for 16O, 18O, HDO # - standard_name: Faii_lat alias: mean_laten_heat_flx_atm_into_ice canonical_units: W m-2 - description: sea-ice export to atm - atm/ice latent heat flux + description: ice import to med - atm/ice latent heat flux # - standard_name: Faii_sen alias: mean_sensi_heat_flx_atm_into_ice canonical_units: W m-2 - description: sea-ice export to atm - atm/ice sensible heat flux + description: ice import to med - atm/ice sensible heat flux # - standard_name: Faii_lwup alias: mean_up_lw_flx_ice canonical_units: W m-2 - description: sea-ice export -outgoing logwave radiation + description: ice import to med -outgoing logwave radiation # - standard_name: Faii_swnet canonical_units: W m-2 - description: sea-ice export to atm + description: ice import to med to atm # - standard_name: Faii_taux alias: stress_on_air_ice_zonal canonical_units: N m-2 - description: sea-ice export to atm - air ice zonal stress + description: ice import to med - air ice zonal stress # - standard_name: Faii_tauy alias: stress_on_air_ice_merid canonical_units: N m-2 - description: sea-ice export - air ice meridional stress + description: ice import to med - air ice meridional stress # - standard_name: Fioi_bcphi canonical_units: kg m-2 s-1 - description: sea-ice export to ocean - hydrophilic black carbon flux to ocean + description: ice import to med to ocean - hydrophilic black carbon flux to ocean # - standard_name: Fioi_bcpho canonical_units: kg m-2 s-1 - description: sea-ice export to ocean - hydrophobic black carbon flux to ocean + description: ice import to med to ocean - hydrophobic black carbon flux to ocean # - standard_name: Fioi_flxdst canonical_units: kg m-2 s-1 - description: sea-ice export to ocean - dust aerosol flux to ocean + description: ice import to med to ocean - dust aerosol flux to ocean # - standard_name: Fioi_melth alias: net_heat_flx_to_ocn canonical_units: W m-2 - description: sea-ice export to ocean - net heat flux to ocean + description: ice import to med to ocean - net heat flux to ocean # - standard_name: Fioi_melth_wiso canonical_units: kg m-2 s-1 - description: sea-ice export to ocean - isotope head flux to ocean for 16O, 18O, HDO + description: ice import to med to ocean - isotope head flux to ocean for 16O, 18O, HDO # - standard_name: Fioi_melth_HDO canonical_units: kg m-2 s-1 - description: sea-ice export to ocean - isotope head flux to ocean + description: ice import to med to ocean - isotope head flux to ocean # - standard_name: Fioi_meltw alias: mean_fresh_water_to_ocean_rate canonical_units: kg m-2 s-1 - description: sea-ice export to ocean - fresh water to ocean (h2o flux from melting) + description: ice import to med to ocean - fresh water to ocean (h2o flux from melting) # - standard_name: Fioi_meltw_wiso alias: mean_fresh_water_to_ocean_rate_wiso canonical_units: kg m-2 s-1 - description: sea-ice export to ocean - fresh water to ocean (h2o flux from melting) for 16O, 18O, HDO + description: ice import to med to ocean - fresh water to ocean (h2o flux from melting) for 16O, 18O, HDO # - standard_name: Fioi_salt alias: mean_salt_rate canonical_units: kg m-2 s-1 - description: sea-ice export to ocean - salt to ocean (salt flux from melting) + description: ice import to med - salt to ocean (salt flux from melting) # - standard_name: Fioi_swpen alias: mean_sw_pen_to_ocn canonical_units: W m-2 - description: sea-ice export to ocean - flux of shortwave through ice to ocean + description: ice import to med - flux of shortwave through ice to ocean # - standard_name: Fioi_swpen_vdr alias: mean_sw_pen_to_ocn_vis_dir_flx canonical_units: W m-2 - description: sea-ice export to ocean - flux of vis dir shortwave through ice to ocean + description: ice import to med - flux of vis dir shortwave through ice to ocean # - standard_name: Fioi_swpen_vdf alias: mean_sw_pen_to_ocn_vis_dif_flx canonical_units: W m-2 - description: sea-ice export to ocean - flux of vif dir shortwave through ice to ocean + description: ice import to med - flux of vif dir shortwave through ice to ocean # - standard_name: Fioi_swpen_idr alias: mean_sw_pen_to_ocn_ir_dir_flx canonical_units: W m-2 - description: sea-ice export to ocean - flux of ir dir shortwave through ice to ocean + description: ice import to med - flux of ir dir shortwave through ice to ocean # - standard_name: Fioi_swpen_idf alias: mean_sw_pen_to_ocn_ir_dif_flx canonical_units: W m-2 - description: sea-ice export to ocean - flux of ir dif shortwave through ice to ocean + description: ice import to med - flux of ir dif shortwave through ice to ocean # - standard_name: Fioi_taux alias: stress_on_ocn_ice_zonal canonical_units: N m-2 - description: sea-ice export to ocean - ice ocean zonal stress + description: ice import to med - ice ocean zonal stress # - standard_name: Fioi_tauy alias: stress_on_ocn_ice_merid canonical_units: N m-2 - description: sea-ice export to ocean - ice ocean meridional stress + description: ice import to med - ice ocean meridional stress # - standard_name: Si_anidf alias: inst_ice_ir_dif_albedo canonical_units: 1 - description: sea-ice export to atm + description: ice import to med # - standard_name: Si_anidr alias: inst_ice_ir_dir_albedo canonical_units: 1 - description: sea-ice export to atm + description: ice import to med # - standard_name: Si_avsdf alias: inst_ice_vis_dif_albedo canonical_units: 1 - description: sea-ice export to atm + description: ice import to med # - standard_name: Si_avsdr alias: inst_ice_vis_dir_albedo canonical_units: 1 - description: sea-ice export to atm + description: ice import to med # - standard_name: Si_ifrac alias: ice_fraction canonical_units: 1 - description: sea-ice export to atm - ice fraction (varies with time) + description: ice import to med - ice fraction (varies with time) # - standard_name: Si_ifrac_n alias: ice_fraction_n canonical_units: 1 - description: sea-ice export - ice fraction per category (varies with time) + description: ice import to med - ice fraction per category (varies with time) # - standard_name: Si_imask alias: ice_mask canonical_units: 1 - description: sea-ice export - ice mask + description: ice import to med - ice mask # - standard_name: Si_qref canonical_units: kg kg-1 - description: sea-ice export to atm + description: ice import to med # - standard_name: Si_qref_wiso canonical_units: kg kg-1 - description: sea-ice export to atm + description: ice import to med # - standard_name: Si_t alias: sea_ice_surface_temperature canonical_units: K - description: sea-ice export + description: ice import to med # - standard_name: Si_tref canonical_units: K - description: sea-ice export + description: ice import to med # - standard_name: Si_u10 canonical_units: m - description: sea-ice export + description: ice import to med # - standard_name: Si_vice alias: mean_ice_volume canonical_units: m - description: sea-ice export - volume of ice per unit area + description: ice import to med - volume of ice per unit area # - standard_name: Si_snowh canonical_units: m - description: sea-ice export - surface_snow_water_equivalent + description: ice import to med - surface_snow_water_equivalent # - standard_name: Si_vsno alias: mean_snow_volume canonical_units: m - description: sea-ice export - volume of snow per unit area + description: ice import to med - volume of snow per unit area # - standard_name: Si_thick canonical_units: m - description: sea-ice export - ice thickness + description: ice import to med - ice thickness # - standard_name: Si_floediam canonical_units: m - description: sea-ice export - ice floe diameter + description: ice import to med - ice floe diameter # #----------------------------------- - # section: ocean export to mediator + # section: ocn import to med #----------------------------------- # - standard_name: Fioo_q alias: freezing_melting_potential canonical_units: W m-2 - description: ocean export + description: ocn import to med # - standard_name: Faoo_fco2_ocn canonical_units: moles m-2 s-1 - description: ocean export + description: ocn import to med - surface flux of CO2 (downward positive) + # + - 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: ocean export + description: ocn import to med # - standard_name: So_anidr canonical_units: 1 - description: ocean export + description: ocn import to med # - standard_name: So_avsdf canonical_units: 1 - description: ocean export + description: ocn import to med # - standard_name: So_avsdr canonical_units: 1 - description: ocean export + description: ocn import to med # - standard_name: So_bldepth alias: mixed_layer_depth canonical_units: m - description: ocean export + description: ocn import to med # - standard_name: So_dhdx alias: sea_surface_slope_zonal canonical_units: m m-1 - description: ocean export + description: ocn import to med # - standard_name: So_dhdy alias: sea_surface_slope_merid canonical_units: m m-1 - description: ocean export + description: ocn import to med # - standard_name: So_duu10n canonical_units: m2 s-2 - description: ocean export + description: ocn import to med # - standard_name: So_fswpen canonical_units: 1 - description: ocean export + description: ocn import to med # - standard_name: So_ofrac canonical_units: 1 - description: ocean export + description: ocn import to med # - standard_name: So_omask alias: ocean_mask canonical_units: 1 - description: ocean export + description: ocn import to med # - standard_name: So_qref canonical_units: kg kg-1 - description: ocean export + description: ocn import to med # - standard_name: So_qref_wiso canonical_units: kg kg-1 - description: ocean export + description: ocn import to med # - standard_name: So_re canonical_units: 1 - description: ocean export + description: ocn import to med # - standard_name: So_qref_wiso canonical_units: kg kg-1 - description: ocean export + description: ocn import to med # - standard_name: So_roce_wiso canonical_units: unitless - description: ocean export + description: ocn import to med # - standard_name: So_s alias: s_surf canonical_units: g kg-1 - description: ocean export + description: ocn import to med # - standard_name: So_s_depth alias: s_surf_depths @@ -849,12 +955,12 @@ # - standard_name: So_ssq canonical_units: kg kg-1 - description: ocean export + description: ocn import to med # - standard_name: So_t alias: sea_surface_temperature canonical_units: K - description: ocean export + description: ocn import to med # - standard_name: So_t_depth alias: sea_surface_temperature_depths @@ -863,292 +969,244 @@ # - standard_name: So_tref canonical_units: K - description: ocean export + description: ocn import to med # - standard_name: So_u alias: ocn_current_zonal canonical_units: m s-1 - description: ocean export + description: ocn import to med # - standard_name: So_u10 canonical_units: m - description: ocean export + description: ocn import to med # - standard_name: So_ustar canonical_units: m s-1 - description: ocean export + description: ocn import to med # - standard_name: So_v alias: ocn_current_merid canonical_units: m s-1 - description: ocean export - # - #----------------------------------- - # section: river export - #----------------------------------- - # - - 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 - # - - standard_name: Fixx_rofi - canonical_units: kg m-2 s-1 - description: frozen runoff to ice from river and land-ice - # - - standard_name: Fixx_rofi_wiso - canonical_units: kg m-2 s-1 - description: frozen runoff to ice from river and land-ice for 16O, 18O, HDO + description: ocn import to med # #----------------------------------- - # section: lnd export to glc - #----------------------------------- - # - - standard_name: Flgl_qice - canonical_units: kg m-2 s-1 - description: mediator export to glc no elevation classes - # - - standard_name: Flgl_qice_elev - canonical_units: kg m-2 s-1 - description: land export to mediator in elevation classes (1->glc_nec) - # - #----------------------------------- - # section: lnd export to river - #----------------------------------- - # - - standard_name: Flrl_irrig - canonical_units: kg m-2 s-1 - description: land export to river - # - - standard_name: Flrl_rofdto - canonical_units: kg m-2 s-1 - description: land export to river - # - - standard_name: Flrl_rofgwl - canonical_units: kg m-2 s-1 - description: land export to river - # - - standard_name: Flrl_rofi - canonical_units: kg m-2 s-1 - description: land export to river - # - - standard_name: Flrl_rofsub - canonical_units: kg m-2 s-1 - description: land export to river - # - - standard_name: Flrl_rofsur - canonical_units: kg m-2 s-1 - description: land export to river - # - #----------------------------------- - # section: river export - #----------------------------------- - # - - standard_name: Flrr_flood - canonical_units: kg m-2 s-1 - description: river export to land - water flux due to flooding - # - - standard_name: Flrr_flood_wiso - canonical_units: kg m-2 s-1 - description: river export to land - water flux due to flooding for 16O, 18O, HDO - # - - standard_name: Flrr_volr - canonical_units: m - description: river export to land - river channel total water volume - # - - standard_name: Flrr_volr_wiso - canonical_units: m - description: river export to land - river channel total water volume from 16O, 18O, HDO - # - - standard_name: Flrr_volrmch - canonical_units: m - description: river export to land - river channel main channel water volume - # - - standard_name: Flrr_volrmch_wiso - canonical_units: m - description: river export to land - river channel main channel water volume from 16O, 18O, HDO - # - - standard_name: Sr_tdepth - canonical_units: m - description: river export to land - tributary channel water depth - # - - standard_name: Sr_tdepth_max - canonical_units: m - description: river export to land - tributary channel bankfull depth - # - - standard_name: Forr_rofi - canonical_units: kg m-2 s-1 - description: river export to ocean - water flux due to runoff (frozen) - # - - standard_name: Forr_rofi_wiso - canonical_units: kg m-2 s-1 - description: river export to ocean - water flux due to runoff (frozen) for 16O, 18O, HDO - # - - standard_name: Forr_rofl - canonical_units: kg m-2 s-1 - description: river export to ocean - water flux due to runoff (liquid) - # - - standard_name: Forr_rofl_wiso - canonical_units: kg m-2 s-1 - description: river export to ocean - water flux due to runoff (frozen) for 16O, 18O, HDO - # - #----------------------------------- - # section: ocean import + # section: ocn export from med (computed in med) #----------------------------------- # - standard_name: Foxx_hrain alias: heat_content_lprec canonical_units: W m-2 - description: to ocn heat content of rain + description: med export to ocn heat content of rain # - standard_name: Foxx_hsnow alias: heat_content_fprec canonical_units: W m-2 - description: to ocn heat content of snow + description: med export to ocn heat content of snow # - standard_name: Foxx_hevap alias: heat_content_evap canonical_units: W m-2 - description: to ocn heat content of evaporation + description: med export to ocn heat content of evaporation # - standard_name: Foxx_hcond alias: heat_content_cond canonical_units: W m-2 - description: to ocn heat content of condensation + description: med export to ocn heat content of condensation # - standard_name: Foxx_hrofl alias: heat_content_rofl canonical_units: W m-2 - description: to ocn heat content of liquid runoff + description: med export to ocn heat content of liquid runoff # - standard_name: Foxx_hrofi alias: heat_content_rofi canonical_units: W m-2 - description: to ocn heat content of ice runoff + description: med export to ocn heat content of ice runoff # - standard_name: Foxx_evap alias: mean_evap_rate canonical_units: kg m-2 s-1 - description: ocean import - specific humidity flux + description: med export to ocn - specific humidity flux # - standard_name: Foxx_evap_wiso alias: mean_evap_rate_wiso canonical_units: kg m-2 s-1 - description: ocean import - specific humidity flux 16O, 18O, HDO + description: med export to ocn - specific humidity flux 16O, 18O, HDO # - standard_name: Foxx_lat canonical_units: W m-2 - description: ocean import - latent heat flux into ocean + description: med export to ocn - latent heat flux into ocean # - standard_name: Foxx_lat_wiso canonical_units: W m-2 - description: ocean import - latent heat flux into ocean for 16O, 18O, HDO + description: med export to ocn - latent heat flux into ocean for 16O, 18O, HDO # - standard_name: Foxx_lat canonical_units: W m-2 - description: ocean import - latent heat flux into ocean for HDO + description: med export to ocn - latent heat flux into ocean for HDO # - standard_name: Foxx_sen alias: mean_sensi_heat_flx canonical_units: W m-2 - description: ocean import - sensible heat flux into ocean + description: med export to ocn - sensible heat flux into ocean # - standard_name: Foxx_lwup canonical_units: W m-2 - description: ocean import - surface upward longwave heat flux + description: med export to ocn - surface upward longwave heat flux # - standard_name: Foxx_lwnet alias: mean_net_lw_flx canonical_units: W m-2 - description: ocean import - mean NET long wave radiation flux to ocean + description: med export to ocn - mean NET long wave radiation flux to ocean # - standard_name: mean_runoff_rate canonical_units: kg m-2 s-1 - description: ocean import - total runoff to ocean + description: med export to ocn - total runoff to ocean # - standard_name: mean_runoff_heat_flux canonical_units: kg m-2 s-1 - description: ocean import - heat content of runoff + description: med export to ocn - heat content of runoff # - standard_name: mean_calving_rate canonical_units: kg m-2 s-1 - description: ocean import - total calving to ocean + description: med export to ocn - total calving to ocean # - standard_name: mean_calving_heat_flux canonical_units: kg m-2 s-1 - description: ocean import - heat content of calving + description: med export to ocn - heat content of calving # - standard_name: Foxx_rofi canonical_units: kg m-2 s-1 - description: ocean import - water flux due to runoff (frozen) + description: med export to ocn - water flux due to runoff (frozen) # - standard_name: Foxx_rofi_wiso canonical_units: kg m-2 s-1 - description: ocean import - water flux due to runoff (frozen) for 16O, 18O, HDO + description: med export to ocn - water flux due to runoff (frozen) for 16O, 18O, HDO # - standard_name: Foxx_rofl alias: mean_runoff_rate canonical_units: kg m-2 s-1 - description: ocean import - water flux due to runoff (liquid) + description: med export to ocn - water flux due to runoff (liquid) # - standard_name: Foxx_rofl_wiso canonical_units: kg m-2 s-1 - description: ocean import - water flux due to runoff (liquid) for 16O, 18O, HDO + description: med export to ocn - water flux due to runoff (liquid) for 16O, 18O, HDO # - standard_name: Foxx_swnet alias: mean_net_sw_flx canonical_units: W m-2 - description: ocean import - net shortwave radiation to ocean + description: med export to ocn - net shortwave radiation to ocean # - standard_name: Foxx_swnet_vdr alias: mean_net_sw_vis_dir_flx canonical_units: W m-2 - description: ocean import - net shortwave visible direct radiation to ocean + description: med export to ocn - net shortwave visible direct radiation to ocean # - standard_name: Foxx_swnet_vdf alias: mean_net_sw_vis_dif_flx canonical_units: W m-2 - description: ocean import - net shortwave visible diffuse radiation to ocean + description: med export to ocn - net shortwave visible diffuse radiation to ocean # - standard_name: Foxx_swnet_idr alias: mean_net_sw_ir_dir_flx canonical_units: W m-2 - description: ocean import - net shortwave ir direct radiation to ocean + description: med export to ocn - net shortwave ir direct radiation to ocean # - standard_name: Foxx_swnet_idf alias: mean_net_sw_ir_dif_flx canonical_units: W m-2 - description: ocean import - net shortwave ir diffuse radiation to ocean + description: med export to ocn - net shortwave ir diffuse radiation to ocean # - standard_name: Foxx_swnet_afracr canonical_units: W m-2 - description: ocean import - net shortwave radiation times atmosphere fraction + description: med export to ocn - net shortwave radiation times atmosphere fraction # - standard_name: Foxx_taux alias: mean_zonal_moment_flx canonical_units: N m-2 - description: ocean import - zonal surface stress + description: med export to ocn - zonal surface stress # - standard_name: Foxx_tauy alias: mean_merid_moment_flx canonical_units: N m-2 - description: ocean import - meridional surface stress + description: med export to ocn - meridional surface stress # - standard_name: Fioi_swpen_ifrac_n alias: mean_sw_pen_to_ocn_ifrac_n canonical_units: W m-2 - description: ocean import - net shortwave radiation penetrating into ice and ocean times ice fraction for thickness category 1 + description: med export to ocn - net shortwave radiation penetrating into ice and ocean times ice fraction for thickness category 1 # - standard_name: Sf_afrac canonical_units: 1 - description: ocean import - fractional atmosphere coverage wrt ocean + description: med export to ocn - fractional atmosphere coverage wrt ocean # - standard_name: Sf_afracr canonical_units: 1 - description: ocean import - fractional atmosphere coverage used in radiation computations wrt ocean + description: med export to ocn - fractional atmosphere coverage used in radiation computations wrt ocean + # + #----------------------------------- + # section: river import to med + #----------------------------------- + # + - standard_name: Flrr_flood + canonical_units: kg m-2 s-1 + description: river import to med - water flux due to flooding + # + - standard_name: Flrr_flood_wiso + canonical_units: kg m-2 s-1 + description: river import to med - water flux due to flooding for 16O, 18O, HDO + # + - standard_name: Flrr_volr + canonical_units: m + description: river import to med - river channel total water volume + # + - standard_name: Flrr_volr_wiso + canonical_units: m + description: river import to med - river channel total water volume from 16O, 18O, HDO + # + - standard_name: Flrr_volrmch + canonical_units: m + description: river import to med - river channel main channel water volume + # + - standard_name: Flrr_volrmch_wiso + canonical_units: m + description: river import to med - river channel main channel water volume from 16O, 18O, HDO + # + - standard_name: Sr_tdepth + canonical_units: m + description: river import to med - tributary channel water depth + # + - standard_name: Sr_tdepth_max + canonical_units: m + description: river import to med - tributary channel bankfull depth + # + - standard_name: Forr_rofi + canonical_units: kg m-2 s-1 + description: river export to ocean - water flux due to runoff (frozen) + # + - 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 + # + - standard_name: Forr_rofl + canonical_units: kg m-2 s-1 + description: river import to med - water flux due to runoff (liquid) + # + - standard_name: Forr_rofl_glc + canonical_units: kg m-2 s-1 + description: river import to med - water flux due to runoff originating from glc (liquid) + # + - standard_name: Forr_rofl_wiso + canonical_units: kg m-2 s-1 + description: river import to med - water flux due to runoff (frozen) for 16O, 18O, HDO + # + #----------------------------------- + # section: wav import to med + #----------------------------------- # - standard_name: Sw_hstokes canonical_units: m @@ -1173,37 +1231,76 @@ - standard_name: Sw_pstokes_y canonical_units: m/s description: Northward partitioned stokes drift components - # - standard_name: Sw_elevation_spectrum alias: wave_elevation_spectrum canonical_units: m2/s description: wave elevation spectrum - # - #----------------------------------- - # section: wave import - #----------------------------------- + - standard_name: Sw_ustokes_avg + canonical_units: m/s + description: Daily averaged stokes drift u component (only needed for med history output) # - - standard_name: Fwxx_taux - alias: mean_zonal_moment_flx - canonical_units: N m-2 - description: wave import - zonal surface stress + - standard_name: Sw_vstokes_avg + canonical_units: m/s + description: Daily averaged stokes drift v component (only needed for med history output) # - - standard_name: Fwxx_tauy - alias: mean_merid_moment_flx - canonical_units: N m-2 - description: wave import - meridional surface stress - - #----------------------------------- - # mediator fields - #----------------------------------- + - standard_name: Sw_hs_avg + canonical_units: m + description: Daily averaged significant wave hight (only needed for med history output) # - - standard_name: cpl_scalars - canonical_units: unitless + - standard_name: Sw_phs0_avg + canonical_units: m + description: Daily averaged averaged wind sea swh (only needed for med history output) # - - standard_name: frac - canonical_units: 1 + - standard_name: Sw_phs1_avg + canonical_units: m + description: Daily averaged swell swh (only needed for med history output) # - - standard_name: mask - canonical_units: 1 + - standard_name: Sw_pdir0_avg + canonical_units: degrees + description: Daily averaged wind sea swh (only needed for med history output) + # + - standard_name: Sw_pdir1_avg + canonical_units: degrees + description: Daily averaged swell swh (only needed for med history output) + # + - standard_name: Sw_pTm10_avg + canonical_units: s + description: Daily averaged wind sea mean wave Tm1 period (only needed for med history output) + # + - standard_name: Sw_pTm11_avg + canonical_units: s + description: Daily average swell mean wave Tm1 period (only needed for med history output) + # + - standard_name: Sw_Tm1_avg + canonical_units: s + description: Daily averaged mean wave period of the first moment (only needed for med history output) + # + - standard_name: Sw_thm_avg + canonical_units: degrees + description: Daily averaged mean wave direction (only needed for med history output) + # + - standard_name: Sw_thp0_avg + canonical_units: degrees + description: Daily averaged peak wave direction (only needed for med history output) + # + - standard_name: Sw_fp0_avg + canonical_units: 1/s + description: Daily averaged peak wave frequency (only needed for med history output) + # + - standard_name: Sw_u_avg + canonical_units: m/s + description: Daily averaged surface wind zonal (only needed for med history output) + # + - standard_name: Sw_v_avg + canonical_units: m/s + description: Daily averaged surface wind meridional (only needed for med history output) + # + - standard_name: Sw_tusx_avg + canonical_units: m2/s + description: Daily averaged stokes zonal transport vector (only needed for med history output) + # + - standard_name: Sw_tusy_avg + canonical_units: m2/s + description: Daily averaged stokes meridional transport vector (only needed for med history output) diff --git a/mediator/med.F90 b/mediator/med.F90 index dc0f68cf2..4e1f916f3 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -1622,7 +1622,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 @@ -1924,6 +1924,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 !--------------------------------------- @@ -2122,7 +2126,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, & @@ -2150,12 +2154,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 8ea6651ea..69ff44f2e 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) @@ -986,7 +991,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 @@ -1197,8 +1202,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', & @@ -1231,6 +1243,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', & @@ -1352,9 +1372,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 @@ -1533,11 +1553,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) @@ -1893,8 +1923,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) @@ -1913,14 +1941,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 e45331f76..d09903be5 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -115,6 +115,15 @@ module med_internalstate_mod real(r8), pointer :: lons(:) => null() end type mesh_info_type + logical , public :: samegrid_atmlnd = .true. ! true=>atm and lnd are on the same grid + character(len=CS), public :: mrg_fracname_lnd2atm_state + character(len=CS), public :: mrg_fracname_lnd2atm_flux + character(len=CS), public :: map_fracname_lnd2atm + character(len=CS), public :: mrg_fracname_lnd2rof + character(len=CS), public :: map_fracname_lnd2rof + character(len=CS), public :: mrg_fracname_lnd2glc + character(len=CS), public :: map_fracname_lnd2glc + ! private internal state to keep instance data type InternalStateStruct @@ -191,11 +200,11 @@ module med_internalstate_mod type(mesh_info_type) , pointer :: mesh_info(:) type(ESMF_FieldBundle) , pointer :: FBArea(:) ! needed for mediator history writes - end type InternalStateStruct + end type InternalStateStruct - type, public :: InternalState + type, public :: InternalState type(InternalStateStruct), pointer :: wrap - end type InternalState + end type InternalState character(len=*), parameter :: u_FILE_u = & __FILE__ @@ -223,6 +232,10 @@ subroutine med_internalstate_init(gcomp, rc) character(len=CX) :: msgString character(len=3) :: name integer :: num_icesheets + character(len=CL) :: atm_mesh_name + character(len=CL) :: lnd_mesh_name + logical :: isPresent_lnd, isSet_lnd + logical :: isPresent_atm, isSet_atm character(len=*),parameter :: subname=' (internalstate init) ' !----------------------------------------------------------- @@ -230,6 +243,53 @@ subroutine med_internalstate_init(gcomp, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! determine if atm and lnd have the same mesh + call NUOPC_CompAttributeGet(gcomp, name='mesh_atm', value=atm_mesh_name, & + isPresent=isPresent_atm, isSet=isSet_atm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(gcomp, name='mesh_lnd', value=lnd_mesh_name, & + isPresent=isPresent_lnd, isSet=isSet_lnd, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if ((isPresent_lnd .and. isSet_lnd) .and. (isPresent_atm .and. isSet_atm)) then + if (trim(atm_mesh_name) == trim(lnd_mesh_name)) then + samegrid_atmlnd = .true. + else + samegrid_atmlnd = .false. + end if + else + samegrid_atmlnd = .true. + end if + + ! See med_fraction_mod for the following definitions + if (samegrid_atmlnd) then + map_fracname_lnd2atm = 'lfrin' ! in fraclist_a + mrg_fracname_lnd2atm_state = 'lfrac' ! in fraclist_a + mrg_fracname_lnd2atm_flux = 'lfrac' ! in fraclist_a + map_fracname_lnd2rof = 'lfrac' ! in fraclist_r + mrg_fracname_lnd2rof = 'lfrac' ! in fraclist_r + map_fracname_lnd2glc = 'lfrac' ! in fraclist_g + mrg_fracname_lnd2glc = 'lfrac' ! in fraclist_g + else + map_fracname_lnd2atm = 'lfrin' ! in fraclist_a + mrg_fracname_lnd2atm_state = 'lfrac' ! in fraclist_a + mrg_fracname_lnd2atm_flux = 'lfrin' ! in fraclist_a + map_fracname_lnd2rof = 'lfrin' ! in fraclist_r + mrg_fracname_lnd2rof = 'lfrin' ! in fraclist_r + map_fracname_lnd2glc = 'lfrin' ! in fraclist_g + mrg_fracname_lnd2rof = 'lfrin' ! in fraclist_g + endif + + if (maintask) then + write(logunit,'(a,i8)') trim(subname)//' map_fracname_lnd2atm = '//trim(map_fracname_lnd2atm) //' in fraclist_a' + write(logunit,'(a,i8)') trim(subname)//' mrg_fracname_lnd2atm_state = '//trim(mrg_fracname_lnd2atm_state)//' in fraclist_a' + write(logunit,'(a,i8)') trim(subname)//' mrg_fracname_lnd2atm_flux = '//trim(mrg_fracname_lnd2atm_flux) //' in fraclist_a' + write(logunit,'(a,i8)') trim(subname)//' map_fracname_lnd2rof = '//trim(map_fracname_lnd2rof) //' in fraclist_r' + write(logunit,'(a,i8)') trim(subname)//' mrg_fracname_lnd2rof = '//trim(mrg_fracname_lnd2rof) //' in fraclist_r' + write(logunit,'(a,i8)') trim(subname)//' map_fracname_lnd2glc = '//trim(map_fracname_lnd2glc) //' in fraclist_g' + write(logunit,'(a,i8)') trim(subname)//' mrg_fracname_lnd2rof = '//trim(mrg_fracname_lnd2rof) //' in fraclist_g' + end if + ! Determine if glc is present call NUOPC_CompAttributeGet(gcomp, name='GLC_model', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -451,9 +511,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. @@ -466,6 +523,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. @@ -477,7 +537,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_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index 5252e6edc..406160cb0 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -149,6 +149,8 @@ module med_phases_aofluxes_mod real(R8) , pointer :: u10 (:) => null() ! diagnostic: 10m wind speed real(R8) , pointer :: duu10n (:) => null() ! diagnostic: 10m wind speed squared real(R8) , pointer :: ugust_out (:) => null() ! diagnostic: gust wind added + real(R8) , pointer :: u10_withGust(:) => null() ! diagnostic: gust wind added + real(R8) , pointer :: u10res (:) => null() ! diagnostic: no gust wind added real(R8) , pointer :: ustar (:) => null() ! saved ustar real(R8) , pointer :: re (:) => null() ! saved re real(R8) , pointer :: ssq (:) => null() ! saved sq @@ -1073,8 +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, & ustar_sv=aoflux_out%ustar, re_sv=aoflux_out%re, ssq_sv=aoflux_out%ssq, & missval=0.0_r8) @@ -1099,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 @@ -1109,7 +1112,8 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) do n = 1,aoflux_in%lsize if (aoflux_in%mask(n) /= 0) then - aoflux_out%u10(n) = sqrt(aoflux_out%duu10n(n)) + aoflux_out%u10(n) = aoflux_out%u10res(n) + aoflux_out%u10_withGust(n) = sqrt(aoflux_out%duu10n(n)) end if enddo @@ -1712,6 +1716,13 @@ subroutine set_aoflux_out_pointers(fldbun, lsize, aoflux_out, xgrid, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call fldbun_getfldptr(fldbun, 'So_duu10n', aoflux_out%duu10n, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + + call fldbun_getfldptr(fldbun, 'So_ugustOut', aoflux_out%ugust_out, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call fldbun_getfldptr(fldbun, 'So_u10withGust', aoflux_out%u10_withGust, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call fldbun_getfldptr(fldbun, 'So_u10res', aoflux_out%u10res, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return call fldbun_getfldptr(fldbun, 'Faox_taux', aoflux_out%taux, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call fldbun_getfldptr(fldbun, 'Faox_tauy', aoflux_out%tauy, xgrid=xgrid, rc=rc) diff --git a/mediator/med_phases_cdeps_mod.F90 b/mediator/med_phases_cdeps_mod.F90 index 72ac560cc..4f37b6f79 100644 --- a/mediator/med_phases_cdeps_mod.F90 +++ b/mediator/med_phases_cdeps_mod.F90 @@ -7,7 +7,6 @@ module med_phases_cdeps_mod use ESMF, only: ESMF_Field, ESMF_FieldGet use ESMF, only: ESMF_FieldBundleGet, ESMF_FieldBundleIsCreated use ESMF, only: ESMF_FieldBundleCreate - use ESMF, only: ESMF_GridCompGetInternalState use ESMF, only: ESMF_SUCCESS, ESMF_LOGMSG_INFO use med_internalstate_mod, only: InternalState @@ -180,12 +179,12 @@ subroutine med_phases_cdeps_run(gcomp, rc) ! Fill file abd variable lists with data do l = 1, sdat_config%stream(streamid)%nfiles fileList(l) = trim(sdat_config%stream(streamid)%file(l)%name) - if (maintask) write(logunit,'(a,i2,x,a)') trim(subname)//": file ", l, trim(fileList(l)) + if (maintask) write(logunit,'(a,i2,2x,a)') trim(subname)//": file ", l, trim(fileList(l)) end do do l = 1, sdat_config%stream(streamid)%nvars varList(l,1) = trim(sdat_config%stream(streamid)%varlist(l)%nameinfile) varList(l,2) = trim(sdat_config%stream(streamid)%varlist(l)%nameinmodel) - if (maintask) write(logunit,'(a,i2,x,a)') trim(subname)//": variable ", l, trim(varList(l,1))//" -> "//trim(varList(l,2)) + if (maintask) write(logunit,'(a,i2,2x,a)') trim(subname)//": variable ", l, trim(varList(l,1))//" -> "//trim(varList(l,2)) end do ! Set PIO related variables diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 52b20c035..0a6a7775d 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -519,19 +519,20 @@ subroutine med_phases_history_write_med(gcomp, rc) end subroutine med_phases_history_write_med !=============================================================================== - subroutine med_phases_history_write_lnd2glc(gcomp, fldbun, rc) + subroutine med_phases_history_write_lnd2glc(gcomp, fldbun_lnd, rc, fldbun_glc) - ! Write yearly average of lnd -> glc fields + ! Write yearly average of lnd -> glc fields on both land and glc grids - use med_internalstate_mod, only : complnd + use med_internalstate_mod, only : complnd, compglc use med_constants_mod , only : SecPerDay => med_constants_SecPerDay use med_io_mod , only : med_io_write_time, med_io_define_time use med_io_mod , only : med_io_date2yyyymmdd, med_io_sec2hms, med_io_ymd2date ! input/output variables type(ESMF_GridComp) , intent(in) :: gcomp - type(ESMF_FieldBundle) , intent(in) :: fldbun + type(ESMF_FieldBundle) , intent(in) :: fldbun_lnd integer , intent(out) :: rc + type(ESMF_FieldBundle) , intent(in), optional :: fldbun_glc(:) ! local variables type(file_desc_t) :: io_file @@ -550,7 +551,7 @@ subroutine med_phases_history_write_lnd2glc(gcomp, fldbun, rc) real(r8) :: time_val ! time coordinate output real(r8) :: time_bnds(2) ! time bounds output character(len=CL) :: hist_file - integer :: m + integer :: m,n logical :: isPresent character(len=*), parameter :: subname='(med_phases_history_write_lnd2glc)' !--------------------------------------- @@ -623,9 +624,21 @@ subroutine med_phases_history_write_lnd2glc(gcomp, fldbun, rc) call med_io_write_time(io_file, time_val, time_bnds, nt=1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - call med_io_write(io_file, fldbun, whead(m), wdata(m), is_local%wrap%nx(complnd), is_local%wrap%ny(complnd), & + + call med_io_write(io_file, fldbun_lnd, whead(m), wdata(m), & + is_local%wrap%nx(complnd), is_local%wrap%ny(complnd), & nt=1, pre=trim(compname(complnd))//'Imp', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (present(fldbun_glc)) then + do n = 1,size(fldbun_glc) + call med_io_write(io_file, fldbun_glc(n), whead(m), wdata(m), & + is_local%wrap%nx(compglc(n)), is_local%wrap%ny(compglc(n)), & + nt=1, pre=trim(compname(compglc(n)))//'Exp', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do + end if + end do ! end of loop over m ! Close history file 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..f58c901d4 100644 --- a/mediator/med_phases_post_rof_mod.F90 +++ b/mediator/med_phases_post_rof_mod.F90 @@ -2,10 +2,49 @@ 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 + + character(len=13), parameter :: fields_to_remove_negative_runoff(4) = & + ['Forr_rofl ', & + 'Forr_rofi ', & + 'Forr_rofl_glc', & + 'Forr_rofi_glc'] character(*) , parameter :: u_FILE_u = & __FILE__ @@ -14,20 +53,62 @@ 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)' + !--------------------------------------- - 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 + 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', 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 + else + remove_negative_runoff = .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 .and. flds_wiso) then + call shr_sys_abort('remove_negative_runoff must be set to false when flds_wiso is true') + end if + + if (maintask) then + write(logunit,'(a,l7)') trim(subname)//' remove_negative_runoff = ', remove_negative_runoff + end if + + if (dbug_flag > 20) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + end if + call t_stopf('MED:'//subname) + end subroutine med_phases_post_rof_init + + subroutine med_phases_post_rof(gcomp, rc) ! input/output variables type(ESMF_GridComp) :: gcomp @@ -36,6 +117,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 +135,30 @@ 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) then + do n = 1, size(fields_to_remove_negative_runoff) + call ESMF_FieldBundleGet(FBrof_r, fieldName=trim(fields_to_remove_negative_runoff(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(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 +171,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 +184,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 +209,196 @@ subroutine med_phases_post_rof(gcomp, rc) end subroutine med_phases_post_rof + subroutine med_phases_post_rof_create_rof_field_bundle(gcomp, rc) + !--------------------------------------------------------------- + ! Create FBrof_r + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(InternalState) :: is_local + integer :: n + type(ESMF_Mesh) :: mesh + type(ESMF_Field) :: field + integer, parameter :: dbug_threshold = 20 ! threshold for writing debug information in this subroutine + character(len=*), parameter :: subname='(med_phases_post_rof_mod: med_phases_post_rof_create_rof_field_bundle)' + !--------------------------------------- + + rc = ESMF_SUCCESS + + call t_startf('MED:'//subname) + if (dbug_flag > dbug_threshold) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + end if + + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call fldbun_getmesh(is_local%wrap%FBImp(comprof,comprof), mesh, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldBundleGet(is_local%wrap%FBImp(comprof,comprof), fieldCount=num_rof_fields, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(rof_field_names(num_rof_fields)) + call ESMF_FieldBundleGet(is_local%wrap%FBImp(comprof,comprof), fieldNameList=rof_field_names, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Note that, for simplicity, we'll add all rof fields to this local FieldBundle, even + ! though we only need to modify a subset of the fields. + FBrof_r = ESMF_FieldBundleCreate(name='FBrof_r', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + do n = 1, num_rof_fields + field = ESMF_FieldCreate(mesh, ESMF_TYPEKIND_R8, name=rof_field_names(n), meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleAdd(FBrof_r, (/field/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do + + if (dbug_flag > dbug_threshold) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + end if + call t_stopf('MED:'//subname) + + end subroutine med_phases_post_rof_create_rof_field_bundle + + subroutine med_phases_post_rof_remove_negative_runoff(gcomp, field_name, rc) + !--------------------------------------------------------------- + ! For one runoff field, remove negative runoff by downweighting all positive runoff to + ! spread the negative runoff globally. + + ! input/output variables + type(ESMF_GridComp) :: gcomp + character(len=*), intent(in) :: field_name ! name of runoff flux field to process + integer, intent(out) :: rc + + ! local variables + type(InternalState) :: is_local + type(ESMF_VM) :: vm + real(r8), pointer :: runoff_flux(:) ! temporary 1d pointer + real(r8), pointer :: areas(:) + real(r8) :: local_positive(1), global_positive(1) + real(r8) :: local_negative(1), global_negative(1) + real(r8) :: global_sum + real(r8) :: multiplier + real(r8) :: local_positive_final(1), global_positive_final(1) + real(r8) :: local_negative_final(1), global_negative_final(1) + real(r8) :: global_sum_final + integer :: n + + integer, parameter :: dbug_threshold = 20 ! threshold for writing debug information in this subroutine + character(len=*), parameter :: subname='(med_phases_post_rof_mod: med_phases_post_rof_remove_negative_runoff)' + !--------------------------------------- + + rc = ESMF_SUCCESS + + call t_startf('MED:'//subname) + if (dbug_flag > dbug_threshold) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + end if + + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Note that we don't use rof fractions in the global sum. This is consistent with the + ! global budget calculations in med_diag_mod and is because the rof fractions are 1 + ! everywhere. + areas => is_local%wrap%mesh_info(comprof)%areas + + call fldbun_getdata1d(FBrof_r, trim(field_name), runoff_flux, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + local_positive(1) = 0.0_r8 + local_negative(1) = 0.0_r8 + do n = 1, size(runoff_flux) + if (runoff_flux(n) >= 0.0_r8) then + local_positive(1) = local_positive(1) + areas(n) * runoff_flux(n) + else + local_negative(1) = local_negative(1) + areas(n) * runoff_flux(n) + end if + end do + + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMAllreduce(vm, senddata=local_positive, recvdata=global_positive, count=1, & + reduceflag=ESMF_REDUCE_SUM, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMAllreduce(vm, senddata=local_negative, recvdata=global_negative, count=1, & + reduceflag=ESMF_REDUCE_SUM, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + global_sum = global_positive(1) + global_negative(1) + if (maintask .and. dbug_flag > dbug_threshold) then + write(logunit,'(a)') subname//' Before correction: '//trim(field_name) + write(logunit,'(a,e27.17)') subname//' global_positive = ', global_positive(1) + write(logunit,'(a,e27.17)') subname//' global_negative = ', global_negative(1) + write(logunit,'(a,e27.17)') subname//' global_sum = ', global_sum + end if + + if (global_sum > 0.0_r8) then + ! There is enough positive runoff to absorb all of the negative runoff; so set + ! negative runoff to 0 and downweight positive runoff to conserve. + multiplier = global_sum/global_positive(1) + do n = 1, size(runoff_flux) + if (runoff_flux(n) > 0.0_r8) then + runoff_flux(n) = runoff_flux(n) * multiplier + else + runoff_flux(n) = 0.0_r8 + end if + end do + else if (global_sum < 0.0_r8) then + ! There is more negative than positive runoff. Hopefully this happens rarely, if + ! ever; so set positive runoff to 0 and downweight negative runoff to minimize + ! negative runoff and conserve. + multiplier = global_sum/global_negative(1) + do n = 1, size(runoff_flux) + if (runoff_flux(n) < 0.0_r8) then + runoff_flux(n) = runoff_flux(n) * multiplier + else + runoff_flux(n) = 0.0_r8 + end if + end do + else + ! global_sum == 0 - i.e., positive and negative exactly balance (very rare, unless + ! the fluxes are already 0 everywhere!); set all fluxes to 0 in this case. + do n = 1, size(runoff_flux) + runoff_flux(n) = 0.0_r8 + end do + end if + + if (dbug_flag > dbug_threshold) then + ! Recompute positives, negatives and total sum for output diagnostic purposes + local_positive_final(1) = 0.0_r8 + local_negative_final(1) = 0.0_r8 + do n = 1, size(runoff_flux) + if (runoff_flux(n) >= 0.0_r8) then + local_positive_final(1) = local_positive_final(1) + areas(n) * runoff_flux(n) + else + local_negative_final(1) = local_negative_final(1) + areas(n) * runoff_flux(n) + end if + end do + call ESMF_VMAllreduce(vm, senddata=local_positive_final, recvdata=global_positive_final, count=1, & + reduceflag=ESMF_REDUCE_SUM, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMAllreduce(vm, senddata=local_negative_final, recvdata=global_negative_final, count=1, & + reduceflag=ESMF_REDUCE_SUM, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + global_sum_final = global_positive_final(1) + global_negative_final(1) + if (maintask) then + write(logunit,'(a)') subname//' After correction: '//trim(field_name) + write(logunit,'(a,e27.17)') subname//' global_positive_final = ', global_positive_final(1) + write(logunit,'(a,e27.17)') subname//' global_negative_final = ', global_negative_final(1) + write(logunit,'(a,e27.17)') subname//' global_sum_final = ', global_sum_final + end if + end if + + if (dbug_flag > dbug_threshold) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + end if + call t_stopf('MED:'//subname) + + end subroutine med_phases_post_rof_remove_negative_runoff + end module med_phases_post_rof_mod diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index b9e7582e1..c4d872d1d 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -17,7 +17,7 @@ module med_phases_prep_atm_mod use med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans use med_merge_mod , only : med_merge_auto use med_map_mod , only : med_map_field_packed - use med_internalstate_mod , only : InternalState, maintask, logunit + use med_internalstate_mod , only : InternalState, maintask, logunit, samegrid_atmlnd use med_internalstate_mod , only : compatm, compocn, compice, compname, coupling_mode use esmFlds , only : med_fldlist_GetfldListTo, med_fldlist_type use perf_mod , only : t_startf, t_stopf @@ -32,6 +32,9 @@ module med_phases_prep_atm_mod real(r8), public :: global_htot_corr(1) = 0._r8 ! enthalpy correction from med_phases_prep_ocn + character(len=13) :: fldnames_from_ocn(5) = (/'Faoo_fbrf_ocn','Faoo_fdms_ocn','Faoo_fco2_ocn',& + 'Faoo_fn2o_ocn','Faoo_fnh3_ocn'/) + character(*), parameter :: u_FILE_u = & __FILE__ @@ -52,7 +55,7 @@ subroutine med_phases_prep_atm(gcomp, rc) real(R8), pointer :: dataPtr2(:) real(R8), pointer :: ifrac(:) real(R8), pointer :: ofrac(:) - integer :: n + integer :: n,nf type(med_fldlist_type), pointer :: fldList character(len=*),parameter :: subname='(med_phases_prep_atm)' !------------------------------------------------------------------------------- @@ -183,8 +186,13 @@ subroutine med_phases_prep_atm(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldGet(lfield, farrayPtr=dataptr1, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldBundleGet(is_local%wrap%FBFrac(compatm), fieldName='lfrac', field=lfield, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + if (samegrid_atmlnd) then + call ESMF_FieldBundleGet(is_local%wrap%FBFrac(compatm), fieldName='lfrac', field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + call ESMF_FieldBundleGet(is_local%wrap%FBFrac(compatm), fieldName='lfrin', field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if call ESMF_FieldGet(lfield, farrayPtr=dataptr2, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return do n = 1,size(dataptr1) @@ -194,30 +202,33 @@ subroutine med_phases_prep_atm(gcomp, rc) ! Note - the following needs a custom merge since Faoo_fco2_ocn is scaled by (ifrac+ofrac) ! in the merge to the atm - if ( FB_FldChk(is_local%wrap%FBExp(compatm) , 'Faoo_fco2_ocn', rc=rc) .and. & - FB_FldChk(is_local%wrap%FBImp(compocn,compocn), 'Faoo_fco2_ocn', rc=rc)) then - call ESMF_FieldGet(lfield, farrayPtr=dataptr1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldBundleGet(is_local%wrap%FBFrac(compatm), fieldName='ifrac', field=lfield, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(lfield, farrayPtr=ifrac, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldBundleGet(is_local%wrap%FBFrac(compatm), fieldName='ofrac', field=lfield, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(lfield, farrayPtr=ofrac, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldBundleGet(is_local%wrap%FBImp(compocn,compatm), fieldName='Faoo_fco2_ocn', field=lfield, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(lfield, farrayPtr=dataptr1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldBundleGet(is_local%wrap%FBExp(compatm), fieldName='Faoo_fco2_ocn', field=lfield, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(lfield, farrayPtr=dataptr2, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - do n = 1,size(dataptr2) + call ESMF_FieldBundleGet(is_local%wrap%FBFrac(compatm), fieldName='ifrac', field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayPtr=ifrac, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleGet(is_local%wrap%FBFrac(compatm), fieldName='ofrac', field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayPtr=ofrac, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + do nf = 1,size(fldnames_from_ocn) + if ( FB_FldChk(is_local%wrap%FBExp(compatm) , trim(fldnames_from_ocn(nf)), rc=rc) .and. & + FB_FldChk(is_local%wrap%FBImp(compocn,compocn), trim(fldnames_from_ocn(nf)), rc=rc)) then + call ESMF_FieldBundleGet(is_local%wrap%FBImp(compocn,compatm), & + fieldName=trim(fldnames_from_ocn(nf)), field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayPtr=dataptr1, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleGet(is_local%wrap%FBExp(compatm), & + fieldName=trim(fldnames_from_ocn(nf)), field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayPtr=dataptr2, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + do n = 1,size(dataptr2) dataptr2(n) = (ifrac(n) + ofrac(n)) * dataptr1(n) - end do - end if + end do + end if + end do ! Add enthalpy correction to sensible heat if appropriate if (FB_FldChk(is_local%wrap%FBExp(compatm), 'Faxx_sen', rc=rc)) then diff --git a/mediator/med_phases_prep_glc_mod.F90 b/mediator/med_phases_prep_glc_mod.F90 index 920fb415e..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,36 +620,22 @@ 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 - ! Write auxiliary history file if flag is set and accumulation is being done - if (lndAccum2glc_cnt > 0) then - call NUOPC_CompAttributeGet(gcomp, name="histaux_l2x1yrg", value=cvalue, & - isPresent=isPresent, isSet=isSet, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - read(cvalue,*) write_histaux_l2x1yrg - else - write_histaux_l2x1yrg = .false. - end if - if (write_histaux_l2x1yrg) then - call med_phases_history_write_lnd2glc(gcomp, FBlndAccum2glc_l, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - end if - if (is_local%wrap%ocn2glc_coupling) then ! Average import from accumulated ocn import data do n = 1, size(fldnames_fr_ocn) @@ -679,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 @@ -688,15 +681,39 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) if (chkErr(rc,__LINE__,u_FILE_u)) return end if + ! Determine if auxiliary file will be written + write_histaux_l2x1yrg = .false. + if (lndAccum2glc_cnt > 0) then + call NUOPC_CompAttributeGet(gcomp, name="histaux_l2x1yrg", value=cvalue, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) write_histaux_l2x1yrg + end if + end if + + ! Write auxiliary history file if flag is set and accumulation is being done if (is_local%wrap%lnd2glc_coupling) then ! Map accumulated field bundle from land grid (with elevation classes) to glc grid (without elevation classes) ! and set FBExp(compglc(ns)) data ! Zero land accumulator and accumulated field bundles on land grid call med_phases_prep_glc_map_lnd2glc(gcomp, rc) if (chkErr(rc,__LINE__,u_FILE_u)) return + + if (write_histaux_l2x1yrg) then + call med_phases_history_write_lnd2glc(gcomp, FBlndAccum2glc_l, & + fldbun_glc=is_local%wrap%FBExp(compglc(:)), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + lndAccum2glc_cnt = 0 call fldbun_reset(FBlndAccum2glc_l, value=czero, rc=rc) if (chkErr(rc,__LINE__,u_FILE_u)) return + else + if (write_histaux_l2x1yrg) then + call med_phases_history_write_lnd2glc(gcomp, FBlndAccum2glc_l, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if end if if (dbug_flag > 1) then @@ -795,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 @@ -1035,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 @@ -1049,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) ' !--------------------------------------------------------------- @@ -1129,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 @@ -1139,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 @@ -1236,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 !--------------------------------------------------------------- @@ -1246,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_profile_mod.F90 b/mediator/med_phases_profile_mod.F90 index dadfb989c..dee849ae8 100644 --- a/mediator/med_phases_profile_mod.F90 +++ b/mediator/med_phases_profile_mod.F90 @@ -41,7 +41,7 @@ subroutine med_phases_profile(gcomp, rc) use ESMF , only : ESMF_TimeInterval, ESMF_AlarmGet, ESMF_TimeIntervalGet use ESMF , only : ESMF_ClockGetNextTime, ESMF_TimeGet, ESMF_ClockGet use ESMF , only : ESMF_ClockAdvance, ESMF_ClockSet, ESMF_ClockIsStopTime - use ESMF , only : operator(-) + use ESMF , only : operator(-), ESMF_CALKIND_GREGORIAN use NUOPC , only : NUOPC_CompAttributeGet ! write profile output @@ -170,12 +170,13 @@ subroutine med_phases_profile(gcomp, rc) call ESMF_TimeGet(nexttime, timestring=nexttimestr, rc=rc) if (med_utils_ChkErr(rc,__LINE__,u_FILE_u)) return ! get current wall clock time - call ESMF_TimeSet(wallclocktime, rc=rc) + ! s=0 is to prevent an internal divide by 0 error in esmf + call ESMF_TimeSet(wallclockTime, calkindflag=ESMF_CALKIND_GREGORIAN, s=0, rc=rc) if (med_utils_chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeSyncToRealTime(wallclocktime, rc=rc) + call ESMF_TimeSyncToRealTime(wallclockTime, rc=rc) if (med_utils_chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeGet(wallclocktime,timeString=walltimestr, rc=rc) + call ESMF_TimeGet(wallclockTime,timeString=walltimestr, rc=rc) if (med_utils_ChkErr(rc,__LINE__,u_FILE_u)) return ! 1 model day/ x seconds = 1/365 yrs/ (wallclockelapsed s/86400spd 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 From 663554e1c1724ade6292cf0a28a3c19e59caf980 Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Tue, 3 Sep 2024 09:26:55 -0400 Subject: [PATCH 003/123] Sync with ESCOMP; fix aux history files for use_float=.true. (#124) --- cesm/driver/esm.F90 | 3 + cime_config/config_component_cesm.xml | 78 ++++++++++++++++--- cime_config/namelist_definition_drv.xml | 63 +++++++++++++++- mediator/esmFldsExchange_cesm_mod.F90 | 5 +- mediator/fd_cesm.yaml | 10 +++ mediator/med.F90 | 7 +- mediator/med_diag_mod.F90 | 22 ++++-- mediator/med_io_mod.F90 | 99 +++++++++++++++++-------- mediator/med_methods_mod.F90 | 4 +- mediator/med_phases_aofluxes_mod.F90 | 7 +- mediator/med_phases_history_mod.F90 | 22 ++++-- mediator/med_phases_post_rof_mod.F90 | 55 +++++++++----- mediator/med_phases_prep_atm_mod.F90 | 3 +- mediator/med_phases_prep_ocn_mod.F90 | 53 +++++++++---- 14 files changed, 331 insertions(+), 100 deletions(-) diff --git a/cesm/driver/esm.F90 b/cesm/driver/esm.F90 index e2ed64891..d357e9753 100644 --- a/cesm/driver/esm.F90 +++ b/cesm/driver/esm.F90 @@ -877,6 +877,9 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) character(len=5) :: inst_suffix character(CL) :: cvalue logical :: found_comp +#ifdef ESMF_AWARE_THREADING + integer :: cnt +#endif integer :: rank, nprocs, ierr character(len=*), parameter :: subname = "(esm_pelayout.F90:esm_init_pelayout)" !--------------------------------------- diff --git a/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 0f8622af1..222a15b26 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -872,17 +872,28 @@ off - + logical control MED_attributes - If true, remove negative runoff by downweighting all positive runoff globally. + 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 @@ -2415,6 +2426,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/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 7055fdf7e..a521deaa1 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -2202,6 +2202,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! --------------------------------------------------------------------- ! to ocn: enthalpy from atm rain, snow, evaporation ! to ocn: enthalpy from liquid and ice river runoff + ! to ocn: enthalpy from liquid and ice glacier runoff ! to ocn: enthalpy from ice melt ! --------------------------------------------------------------------- ! Note - do not need to add addmap or addmrg for the following since they @@ -2213,6 +2214,8 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addfld_to(compocn, 'Foxx_hcond') call addfld_to(compocn, 'Foxx_hrofl') call addfld_to(compocn, 'Foxx_hrofi') + call addfld_to(compocn, 'Foxx_hrofl_glc') + call addfld_to(compocn, 'Foxx_hrofi_glc') end if ! --------------------------------------------------------------------- @@ -3322,7 +3325,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') diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index c6d57857c..e41c61dff 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -1023,6 +1023,16 @@ canonical_units: W m-2 description: med export to ocn heat content of ice runoff # + - standard_name: Foxx_hrofl_glc + alias: heat_content_rofl_glc + canonical_units: W m-2 + description: med export to ocn heat content of liquid glc runoff + # + - standard_name: Foxx_hrofi_glc + alias: heat_content_rofi_glc + canonical_units: W m-2 + description: med export to ocn heat content of ice glc runoff + # - standard_name: Foxx_evap alias: mean_evap_rate canonical_units: kg m-2 s-1 diff --git a/mediator/med.F90 b/mediator/med.F90 index 4e1f916f3..3133c7f88 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -2154,14 +2154,13 @@ subroutine DataInitialize(gcomp, rc) end if is_local%wrap%nx(n1) = nint(real_nx) is_local%wrap%ny(n1) = nint(real_ny) - endif - if (is_local%wrap%comp_present(n1)) then + write(msgString,'(3i8)') is_local%wrap%nx(n1), is_local%wrap%ny(n1), is_local%wrap%ntile(n1) + call ESMF_LogWrite(trim(subname)//":"//trim(compname(n1))//":"//trim(msgString), ESMF_LOGMSG_INFO) if (maintask) then write(logunit,'(a)') 'global nx,ny,ntile sizes for '//trim(compname(n1))//":"//trim(msgString) end if - call ESMF_LogWrite(trim(subname)//":"//trim(compname(n1))//":"//trim(msgString), ESMF_LOGMSG_INFO) - endif + end if end do if (maintask) write(logunit,*) diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index 69ff44f2e..8bad9d5c8 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -150,6 +150,8 @@ module med_diag_mod integer :: f_heat_cond = unset_index ! heat : heat content of evaporation integer :: f_heat_rofl = unset_index ! heat : heat content of liquid runoff integer :: f_heat_rofi = unset_index ! heat : heat content of ice runoff + integer :: f_heat_rofl_glc = unset_index ! heat : heat content of liquid glc runoff + integer :: f_heat_rofi_glc = unset_index ! heat : heat content of ice glc runoff integer :: f_watr_frz = unset_index ! water: freezing integer :: f_watr_melt = unset_index ! water: melting @@ -330,14 +332,16 @@ subroutine med_diag_init(gcomp, rc) f_heat_beg = f_heat_frz ! field first index for heat f_heat_end = f_heat_sen ! field last index for heat else if (trim(budget_table_version) == 'v1') then - call add_to_budget_diag(budget_diags%fields, f_heat_rain ,'hrain' ) ! field heat : enthalpy of rain - call add_to_budget_diag(budget_diags%fields, f_heat_snow ,'hsnow' ) ! field heat : enthalpy of snow - call add_to_budget_diag(budget_diags%fields, f_heat_evap ,'hevap' ) ! field heat : enthalpy of evaporation - call add_to_budget_diag(budget_diags%fields, f_heat_cond ,'hcond' ) ! field heat : enthalpy of evaporation - call add_to_budget_diag(budget_diags%fields, f_heat_rofl ,'hrofl' ) ! field heat : enthalpy of liquid runoff - call add_to_budget_diag(budget_diags%fields, f_heat_rofi ,'hrofi' ) ! field heat : enthalpy of ice runoff + call add_to_budget_diag(budget_diags%fields, f_heat_rain ,'hrain' ) ! field heat : enthalpy of rain + call add_to_budget_diag(budget_diags%fields, f_heat_snow ,'hsnow' ) ! field heat : enthalpy of snow + call add_to_budget_diag(budget_diags%fields, f_heat_evap ,'hevap' ) ! field heat : enthalpy of evaporation + call add_to_budget_diag(budget_diags%fields, f_heat_cond ,'hcond' ) ! field heat : enthalpy of evaporation + call add_to_budget_diag(budget_diags%fields, f_heat_rofl ,'hrofl' ) ! field heat : enthalpy of liquid runoff + call add_to_budget_diag(budget_diags%fields, f_heat_rofi ,'hrofi' ) ! field heat : enthalpy of ice runoff + call add_to_budget_diag(budget_diags%fields, f_heat_rofl_glc,'hrofl_glc' ) ! field heat : enthalpy of liquid glc runoff + call add_to_budget_diag(budget_diags%fields, f_heat_rofi_glc,'hrofi_glc' ) ! field heat : enthalpy of ice glc runoff f_heat_beg = f_heat_frz ! field first index for heat - f_heat_end = f_heat_rofi ! field last index for heat + f_heat_end = f_heat_rofi_glc ! field last index for heat end if ! ----------------------------------------- @@ -1601,6 +1605,10 @@ subroutine med_phases_diag_ocn( gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hrofi', f_heat_rofi , ic, areas, sfrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hrofl_glc', f_heat_rofl_glc, ic, areas, sfrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hrofi_glc', f_heat_rofi_glc , ic, areas, sfrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return 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 diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index f4abadaf6..1b89f4634 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -870,24 +870,28 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, & ng = maxval(maxIndexPTile) if (tiles) then - lnx = nx - lny = ny - lntile = ng/(lnx*lny) - write(tmpstr,*) subname, 'ng,lnx,lny,lntile = ',ng,lnx,lny,lntile - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) - if (lntile /= ntile) then - call ESMF_LogWrite(trim(subname)//' ERROR: grid2d size and ntile are not consistent ', ESMF_LOGMSG_INFO) - call ESMF_Finalize(endflag=ESMF_END_ABORT) - endif + lnx = ng + lny = 1 + lntile = 1 + if (nx > 0) lnx = nx + if (ny > 0) lny = ny + if (ntile > 0) lntile = ntile + write(tmpstr,*) subname, 'ng,lnx,lny,lntile = ',ng,lnx,lny,lntile + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + if (lnx*lny*lntile /= ng) then + write(tmpstr,*) subname,' ERROR: grid size not consistent ',ng,lnx,lny,lntile + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + call ESMF_Finalize(endflag=ESMF_END_ABORT) + end if else - lnx = ng - lny = 1 - if (nx > 0) lnx = nx - if (ny > 0) lny = ny - if (lnx*lny /= ng) then - write(tmpstr,*) subname,' WARNING: grid2d size not consistent ',ng,lnx,lny - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) - endif + lnx = ng + lny = 1 + if (nx > 0) lnx = nx + if (ny > 0) lny = ny + if (lnx*lny /= ng) then + write(tmpstr,*) subname,' WARNING: grid2d size not consistent ',ng,lnx,lny + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + endif end if deallocate(minIndexPTile, maxIndexPTile) @@ -902,7 +906,7 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, & if (tiles) then rcode = pio_def_dim(io_file, trim(lpre)//'_nx', lnx, dimid3(1)) rcode = pio_def_dim(io_file, trim(lpre)//'_ny', lny, dimid3(2)) - rcode = pio_def_dim(io_file, trim(lpre)//'_ntile', ntile, dimid3(3)) + rcode = pio_def_dim(io_file, trim(lpre)//'_ntile', lntile, dimid3(3)) if (present(nt)) then dimid4(1:3) = dimid3 rcode = pio_inq_dimid(io_file, 'time', dimid4(4)) @@ -1020,10 +1024,18 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, & write(tmpstr,*) subname,' dof = ',ns,size(dof),dof(1),dof(ns) !,minval(dof),maxval(dof) call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) if (tiles) then - call pio_initdecomp(io_subsystem, pio_double, (/lnx,lny,ntile/), dof, iodesc) + if (luse_float) then + call pio_initdecomp(io_subsystem, pio_real, (/lnx,lny,lntile/), dof, iodesc) + else + call pio_initdecomp(io_subsystem, pio_double, (/lnx,lny,lntile/), dof, iodesc) + end if else - call pio_initdecomp(io_subsystem, pio_double, (/lnx,lny/), dof, iodesc) - !call pio_writedof(lpre, (/lnx,lny/), int(dof,kind=PIO_OFFSET_KIND), mpicom) + if (luse_float) then + call pio_initdecomp(io_subsystem, pio_real, (/lnx,lny/), dof, iodesc) + else + call pio_initdecomp(io_subsystem, pio_double, (/lnx,lny/), dof, iodesc) + end if + !call pio_writedof(lpre, (/lnx,lny/), int(dof,kind=PIO_OFFSET_KIND), mpicom) end if deallocate(dof) @@ -1056,10 +1068,18 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, & rcode = pio_inq_varid(io_file, trim(name1), varid) call pio_setframe(io_file,varid,frame) - if (gridToFieldMap(1) == 1) then - call pio_write_darray(io_file, varid, iodesc, fldptr2(:,n), rcode, fillval=lfillvalue) - else if (gridToFieldMap(1) == 2) then - call pio_write_darray(io_file, varid, iodesc, fldptr2(n,:), rcode, fillval=lfillvalue) + if (luse_float) then + if (gridToFieldMap(1) == 1) then + call pio_write_darray(io_file, varid, iodesc, real(fldptr2(:,n),r4), rcode, fillval=real(lfillvalue,r4)) + else if (gridToFieldMap(1) == 2) then + call pio_write_darray(io_file, varid, iodesc, real(fldptr2(n,:),r4), rcode, fillval=real(lfillvalue,r4)) + end if + else + if (gridToFieldMap(1) == 1) then + call pio_write_darray(io_file, varid, iodesc, fldptr2(:,n), rcode, fillval=lfillvalue) + else if (gridToFieldMap(1) == 2) then + call pio_write_darray(io_file, varid, iodesc, fldptr2(n,:), rcode, fillval=lfillvalue) + end if end if end do else if (rank == 1 .or. rank == 0) then @@ -1068,7 +1088,11 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, & call pio_setframe(io_file,varid,frame) ! fix for writing data on exchange grid, which has no data in some PETs if (rank == 0) nullify(fldptr1) - call pio_write_darray(io_file, varid, iodesc, fldptr1, rcode, fillval=lfillvalue) + if (luse_float) then + call pio_write_darray(io_file, varid, iodesc, real(fldptr1,r4), rcode, fillval=real(lfillvalue,r4)) + else + call pio_write_darray(io_file, varid, iodesc, fldptr1, rcode, fillval=lfillvalue) + end if end if ! end if rank is 2 or 1 or 0 end if ! end if not "hgt" @@ -1077,16 +1101,31 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, & ! Fill coordinate variables - why is this being done each time? rcode = pio_inq_varid(io_file, trim(coordvarnames(1)), varid) call pio_setframe(io_file,varid,frame) - call pio_write_darray(io_file, varid, iodesc, ownedElemCoords_x, rcode, fillval=lfillvalue) + if (luse_float) then + call pio_write_darray(io_file, varid, iodesc, real(ownedElemCoords_x,r4), rcode, fillval=real(lfillvalue,r4)) + else + call pio_write_darray(io_file, varid, iodesc, ownedElemCoords_x, rcode, fillval=lfillvalue) + end if rcode = pio_inq_varid(io_file, trim(coordvarnames(2)), varid) call pio_setframe(io_file,varid,frame) - call pio_write_darray(io_file, varid, iodesc, ownedElemCoords_y, rcode, fillval=lfillvalue) - + if (luse_float) then + call pio_write_darray(io_file, varid, iodesc, real(ownedElemCoords_y,r4), rcode, fillval=real(lfillvalue,r4)) + else + call pio_write_darray(io_file, varid, iodesc, ownedElemCoords_y, rcode, fillval=lfillvalue) + end if call pio_syncfile(io_file) call pio_freedecomp(io_file, iodesc) endif - deallocate(ownedElemCoords, ownedElemCoords_x, ownedElemCoords_y) + if(allocated(ownedElemCoords)) then + deallocate(ownedElemCoords) + endif + if(allocated(ownedElemCoords_x)) then + deallocate(ownedElemCoords_x) + endif + if(allocated(ownedElemCoords_y)) then + deallocate(ownedElemCoords_y) + endif if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index d4bdab2a7..1634e7523 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -2609,6 +2609,7 @@ subroutine med_methods_FB_check_for_nans(FB, maintask, logunit, rc) do index=1,fieldCount call med_methods_FB_getNameN(FB, index, fieldname, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleGet(FB, fieldName=fieldname, field=field, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldGet(field, rank=fieldrank, name=fieldname, rc=rc) @@ -2632,9 +2633,8 @@ subroutine med_methods_FB_check_for_nans(FB, maintask, logunit, rc) if (nanfound) then call ESMF_LogWrite('ABORTING JOB', ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) rc = ESMF_FAILURE - return end if - + end subroutine med_methods_FB_check_for_nans !----------------------------------------------------------------------------- diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index 406160cb0..a85d76bcb 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -1604,6 +1604,10 @@ subroutine set_aoflux_in_pointers(fldbun_a, fldbun_o, aoflux_in, lsize, xgrid, r 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 @@ -1717,8 +1721,6 @@ subroutine set_aoflux_out_pointers(fldbun, lsize, aoflux_out, xgrid, rc) call fldbun_getfldptr(fldbun, 'So_duu10n', aoflux_out%duu10n, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call fldbun_getfldptr(fldbun, 'So_ugustOut', aoflux_out%ugust_out, xgrid=xgrid, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return call fldbun_getfldptr(fldbun, 'So_u10withGust', aoflux_out%u10_withGust, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call fldbun_getfldptr(fldbun, 'So_u10res', aoflux_out%u10res, xgrid=xgrid, rc=rc) @@ -1748,7 +1750,6 @@ subroutine set_aoflux_out_pointers(fldbun, lsize, aoflux_out, xgrid, rc) allocate(aoflux_out%evap_18O(lsize)); aoflux_out%evap_18O(:) = 0._R8 allocate(aoflux_out%evap_HDO(lsize)); aoflux_out%evap_HDO(:) = 0._R8 end if - if (add_gusts) then call fldbun_getfldptr(fldbun, 'So_ugustOut', aoflux_out%ugust_out, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 0a6a7775d..c895d6c42 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -357,11 +357,13 @@ subroutine med_phases_history_write(gcomp, rc) end if if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_a,rc=rc)) then call med_io_write(io_file, is_local%wrap%FBMed_ocnalb_a, whead(m), wdata(m), & - is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_alb_atm', rc=rc) + is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_alb_atm', & + ntile=is_local%wrap%ntile(compatm), rc=rc) end if if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a,rc=rc)) then call med_io_write(io_file, is_local%wrap%FBMed_aoflux_a, whead(m), wdata(m), & - is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_aoflux_atm', rc=rc) + is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_aoflux_atm', & + ntile=is_local%wrap%ntile(compatm), rc=rc) end if end do ! end of loop over whead/wdata m index phases @@ -495,7 +497,8 @@ subroutine med_phases_history_write_med(gcomp, rc) end if if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a,rc=rc)) then call med_io_write(instfiles(compmed)%io_file, is_local%wrap%FBMed_aoflux_a, whead(m), wdata(m), & - is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_aoflux_atm', rc=rc) + is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_aoflux_atm', & + ntile=is_local%wrap%ntile(compatm), rc=rc) end if ! If appropriate - write ocn albedos computed in mediator @@ -505,7 +508,8 @@ subroutine med_phases_history_write_med(gcomp, rc) end if if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_a,rc=rc)) then call med_io_write(instfiles(compmed)%io_file, is_local%wrap%FBMed_ocnalb_a, whead(m), wdata(m), & - is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_alb_atm', rc=rc) + is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_alb_atm', & + ntile=is_local%wrap%ntile(compatm), rc=rc) end if end do ! end of loop over m @@ -1058,6 +1062,7 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc) logical :: enable_auxfile character(CL) :: time_units ! units of time variable integer :: nx,ny ! global grid size + integer :: ntile ! number of tiles for tiled domain eg CSG logical :: write_now ! if true, write time sample to file real(r8) :: time_val ! time coordinate output real(r8) :: time_bnds(2) ! time bounds output @@ -1264,6 +1269,7 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc) ! Set shorthand variables nx = is_local%wrap%nx(compid) ny = is_local%wrap%ny(compid) + ntile = is_local%wrap%ntile(compid) ! Increment number of time samples on file auxcomp%files(nf)%nt = auxcomp%files(nf)%nt + 1 @@ -1299,7 +1305,7 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc) call med_io_write(auxcomp%files(nf)%io_file, is_local%wrap%FBimp(compid,compid), & whead(1), wdata(1), nx, ny, nt=auxcomp%files(nf)%nt, & pre=trim(compname(compid))//'Imp', flds=auxcomp%files(nf)%flds, & - use_float=.true., rc=rc) + use_float=.true., ntile=ntile, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! end definition phase @@ -1313,13 +1319,15 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc) ! Write data variables for time nt if (auxcomp%files(nf)%doavg) then call med_io_write(auxcomp%files(nf)%io_file, auxcomp%files(nf)%FBaccum, whead(2), wdata(2), nx, ny, & - nt=auxcomp%files(nf)%nt, pre=trim(compname(compid))//'Imp', flds=auxcomp%files(nf)%flds, rc=rc) + nt=auxcomp%files(nf)%nt, pre=trim(compname(compid))//'Imp', flds=auxcomp%files(nf)%flds, & + use_float=.true., ntile=ntile, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call med_methods_FB_reset(auxcomp%files(nf)%FBaccum, value=czero, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else call med_io_write(auxcomp%files(nf)%io_file, is_local%wrap%FBimp(compid,compid), whead(2), wdata(2), nx, ny, & - nt=auxcomp%files(nf)%nt, pre=trim(compname(compid))//'Imp', flds=auxcomp%files(nf)%flds, rc=rc) + nt=auxcomp%files(nf)%nt, pre=trim(compname(compid))//'Imp', flds=auxcomp%files(nf)%flds, & + use_float=.true., ntile=ntile, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if diff --git a/mediator/med_phases_post_rof_mod.F90 b/mediator/med_phases_post_rof_mod.F90 index f58c901d4..036eeca30 100644 --- a/mediator/med_phases_post_rof_mod.F90 +++ b/mediator/med_phases_post_rof_mod.F90 @@ -38,14 +38,16 @@ module med_phases_post_rof_mod integer :: num_rof_fields character(len=CS), allocatable :: rof_field_names(:) - logical :: remove_negative_runoff - - character(len=13), parameter :: fields_to_remove_negative_runoff(4) = & - ['Forr_rofl ', & - 'Forr_rofi ', & - 'Forr_rofl_glc', & + 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__ @@ -77,12 +79,20 @@ subroutine med_phases_post_rof_init(gcomp, rc) 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', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + 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 + read(cvalue,*) remove_negative_runoff_glc else - remove_negative_runoff = .false. + remove_negative_runoff_glc = .false. end if ! remove_negative_runoff isn't yet set up to handle isotope fields, so ensure that @@ -94,12 +104,13 @@ subroutine med_phases_post_rof_init(gcomp, rc) else flds_wiso = .false. end if - if (remove_negative_runoff .and. flds_wiso) then - call shr_sys_abort('remove_negative_runoff must be set to false when flds_wiso is true') + 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 = ', remove_negative_runoff + 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 if (dbug_flag > 20) then @@ -143,12 +154,22 @@ subroutine med_phases_post_rof(gcomp, rc) data_copy(:) = data_orig(:) end do - if (remove_negative_runoff) then - do n = 1, size(fields_to_remove_negative_runoff) - call ESMF_FieldBundleGet(FBrof_r, fieldName=trim(fields_to_remove_negative_runoff(n)), isPresent=exists, rc=rc) + 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(n), rc) + 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 diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index c4d872d1d..bcdf2ea42 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -258,7 +258,8 @@ subroutine med_phases_prep_atm_enthalpy_correction (gcomp, hcorr, rc) ! Note that this is only called if the following fields are in FBExp(compocn) ! 'Faxa_rain','Foxx_hrain','Faxa_snow' ,'Foxx_hsnow', ! 'Foxx_evap','Foxx_hevap','Foxx_hcond','Foxx_rofl', - ! 'Foxx_hrofl','Foxx_rofi','Foxx_hrofi' + ! 'Foxx_hrofl','Foxx_rofi','Foxx_hrofi','Foxx_rofl_glc', + ! 'Foxx_hrofl_glc','Foxx_rofi_glc','Foxx_hrofi_glc' use ESMF , only : ESMF_VMAllreduce, ESMF_GridCompGet, ESMF_REDUCE_SUM use ESMF , only : ESMF_VM diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index d911d93e1..246ec5866 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -97,6 +97,8 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) real(r8), pointer :: hcond(:) real(r8), pointer :: rofl(:), hrofl(:) real(r8), pointer :: rofi(:), hrofi(:) + real(r8), pointer :: rofl_glc(:), hrofl_glc(:) + real(r8), pointer :: rofi_glc(:), hrofi_glc(:) real(r8), pointer :: areas(:) real(r8), allocatable :: hcorr(:) type(med_fldlist_type), pointer :: fldList @@ -156,20 +158,24 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) !--------------------------------------- !--- custom calculations !--------------------------------------- - ! compute enthaly associated with rain, snow, condensation and liquid river runoff + ! compute enthalpy associated with rain, snow, condensation and liquid river & glc runoff ! the sea-ice model already accounts for the enthalpy flux (as part of melth), so ! enthalpy from meltw **is not** included below - if ( FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_rain' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrain' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_snow' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hsnow' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_evap' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hevap' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hcond' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofl' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrofl' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofi' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrofi' , rc=rc)) then + if ( FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_rain' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrain' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_snow' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hsnow' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_evap' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hevap' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hcond' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofl' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrofl' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofi' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrofi' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Forr_rofl_glc' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrofl_glc' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Forr_rofi_glc' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrofi_glc' , rc=rc)) then call FB_GetFldPtr(is_local%wrap%FBImp(compocn,compocn), 'So_t', tocn, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -201,6 +207,16 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hrofi', hrofi, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Forr_rofl_glc' , rofl_glc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hrofl_glc', hrofl_glc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Forr_rofi_glc' , rofi_glc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hrofi_glc', hrofi_glc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + do n = 1,size(tocn) ! Need max to ensure that will not have an enthalpy contribution if the water is below 0C hrain(n) = max((tocn(n) - shr_const_tkfrz), 0._r8) * rain(n) * shr_const_cpsw @@ -209,6 +225,8 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) hcond(n) = max((tocn(n) - shr_const_tkfrz), 0._r8) * max(evap(n), 0._r8) * shr_const_cpsw hrofl(n) = max((tocn(n) - shr_const_tkfrz), 0._r8) * rofl(n) * shr_const_cpsw hrofi(n) = min((tocn(n) - shr_const_tkfrz), 0._r8) * rofi(n) * shr_const_cpsw + hrofl_glc(n) = max((tocn(n) - shr_const_tkfrz), 0._r8) * rofl_glc(n) * shr_const_cpsw + hrofi_glc(n) = min((tocn(n) - shr_const_tkfrz), 0._r8) * rofi_glc(n) * shr_const_cpsw end do ! Determine enthalpy correction factor that will be added to the sensible heat flux sent to the atm @@ -220,7 +238,7 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) glob_area_inv = 1._r8 / (4._r8 * shr_const_pi) areas => is_local%wrap%mesh_info(compocn)%areas do n = 1,size(tocn) - hcorr(n) = (hrain(n) + hsnow(n) + hcond(n) + hevap(n) + hrofl(n) + hrofi(n)) * & + hcorr(n) = (hrain(n) + hsnow(n) + hcond(n) + hevap(n) + hrofl(n) + hrofi(n) + hrofl_glc(n) + hrofi_glc(n)) * & areas(n) * glob_area_inv end do call med_phases_prep_atm_enthalpy_correction(gcomp, hcorr, rc) @@ -266,6 +284,7 @@ subroutine med_phases_prep_ocn_avg(gcomp, rc) ! local variables type(InternalState) :: is_local integer :: ncnt + logical, save :: first_call = .true. character(len=*),parameter :: subname='(med_phases_prep_ocn_avg)' !--------------------------------------- @@ -306,9 +325,10 @@ subroutine med_phases_prep_ocn_avg(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Check for nans in fields export to ocn - call FB_check_for_nans(is_local%wrap%FBExp(compocn), maintask, logunit, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - + if(.not. first_call) then + call FB_check_for_nans(is_local%wrap%FBExp(compocn), maintask, logunit, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif ! zero accumulator is_local%wrap%ExpAccumOcnCnt = 0 call FB_reset(is_local%wrap%FBExpAccumOcn, value=czero, rc=rc) @@ -320,6 +340,7 @@ subroutine med_phases_prep_ocn_avg(gcomp, rc) call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end if call t_stopf('MED:'//subname) + first_call = .false. end subroutine med_phases_prep_ocn_avg From dc977bcadd1ade1a528dee75f1ad45e8bd80ca0a Mon Sep 17 00:00:00 2001 From: Daniel Rosen Date: Tue, 17 Sep 2024 08:18:34 -0600 Subject: [PATCH 004/123] add fire behavior tendencies to ufs ccpp (#117) * add hflx_fire, evap_fire, cpl_fire Co-authored-by: Grant Firl --- ufs/ccpp/data/MED_typedefs.F90 | 8 ++++++++ ufs/ccpp/data/MED_typedefs.meta | 20 ++++++++++++++++++++ 2 files changed, 28 insertions(+) diff --git a/ufs/ccpp/data/MED_typedefs.F90 b/ufs/ccpp/data/MED_typedefs.F90 index 786ce4711..649ee9b69 100644 --- a/ufs/ccpp/data/MED_typedefs.F90 +++ b/ufs/ccpp/data/MED_typedefs.F90 @@ -183,6 +183,7 @@ module MED_typedefs logical :: restart !< flag whether this is a coldstart (.false.) or a warmstart/restart (.true.) logical :: cplice !< default no cplice collection (used together with cplflx) logical :: cplflx !< flag controlling cplflx collection (default off) + logical :: cpl_fire !< flag controlling fire behavior collection (default off) integer :: kdt !< current forecast iteration real(kind=kind_phys) :: min_lakeice !< minimum lake ice value real(kind=kind_phys) :: min_seaice !< minimum sea ice value @@ -262,7 +263,9 @@ module MED_typedefs real(kind=kind_phys), pointer :: ffhh(:) => null() !< Monin-Obukhov similarity function for heat real(kind=kind_phys), pointer :: ffmm(:) => null() !< Monin-Obukhov similarity function for momentum real(kind=kind_phys), pointer :: evap(:) => null() !< kinematic surface upward latent heat flux (kg kg-1 m s-1) + real(kind=kind_phys), pointer :: evap_fire(:) => null() !< kinematic surface upward latent heat flux of fire (kg kg-1 m s-1) real(kind=kind_phys), pointer :: hflx(:) => null() !< kinematic surface upward sensible heat flux (K m/s) + real(kind=kind_phys), pointer :: hflx_fire(:) => null() !< kinematic surface upward sensible heat flux of fire (K m/s) real(kind=kind_phys), pointer :: tiice(:,:) => null() !< sea ice internal temperature real(kind=kind_phys), pointer :: t2m(:) => null() !< temperature at 2 m real(kind=kind_phys), pointer :: q2m(:) => null() !< specific humidity at 2 m @@ -655,6 +658,7 @@ subroutine control_initialize(model) model%restart = .false. model%cplice = .false. model%cplflx = .false. + model%cpl_fire = .false. model%kdt = 0 ! nint(Model%fhour*con_hr/Model%dtp) model%min_lakeice = 0.15d0 model%min_seaice = 1.0d-11 @@ -767,8 +771,12 @@ subroutine sfcprop_create(sfcprop, im, model) sfcprop%ffmm = clear_val allocate(sfcprop%evap(im)) sfcprop%evap = clear_val + allocate(sfcprop%evap_fire(im)) + sfcprop%evap_fire = clear_val allocate(sfcprop%hflx(im)) sfcprop%hflx = clear_val + allocate(sfcprop%hflx_fire(im)) + sfcprop%hflx_fire = clear_val allocate(sfcprop%tiice(im,model%kice)) sfcprop%tiice = clear_val allocate(sfcprop%t2m(im)) diff --git a/ufs/ccpp/data/MED_typedefs.meta b/ufs/ccpp/data/MED_typedefs.meta index c14616a6a..046e4bfa6 100644 --- a/ufs/ccpp/data/MED_typedefs.meta +++ b/ufs/ccpp/data/MED_typedefs.meta @@ -917,6 +917,12 @@ units = 1 dimensions = () type = integer +[cpl_fire] + standard_name = do_fire_coupling + long_name = flag controlling fire_behavior collection (default off) + units = flag + dimensions = () + type = logical [kdt] standard_name = index_of_timestep long_name = current forecast iteration @@ -1267,6 +1273,13 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys +[evap_fire] + standard_name = surface_upward_specific_humidity_flux_of_fire + long_name = kinematic surface upward latent heat flux of fire + units = kg kg-1 m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys [hflx] standard_name = surface_upward_temperature_flux long_name = kinematic surface upward sensible heat flux @@ -1274,6 +1287,13 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys +[hflx_fire] + standard_name = kinematic_surface_upward_sensible_heat_flux_of_fire + long_name = kinematic surface upward sensible heat flux of fire + units = K m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys [tiice] standard_name = temperature_in_ice_layer long_name = sea ice internal temperature From 24e9eed4ffe8138bef635c8f916f91b142595675 Mon Sep 17 00:00:00 2001 From: Justin Perket Date: Thu, 10 Oct 2024 11:59:40 -0400 Subject: [PATCH 005/123] Enable Data Atmosphere Coupling of GFDL Land Model (#113) --- mediator/esmFldsExchange_ufs_mod.F90 | 32 ++++++++++++++++++++++++++++ 1 file changed, 32 insertions(+) diff --git a/mediator/esmFldsExchange_ufs_mod.F90 b/mediator/esmFldsExchange_ufs_mod.F90 index 57c266b59..9b23a6d5e 100644 --- a/mediator/esmFldsExchange_ufs_mod.F90 +++ b/mediator/esmFldsExchange_ufs_mod.F90 @@ -55,6 +55,9 @@ subroutine esmFldsExchange_ufs(gcomp, phase, rc) character(len=CS) :: fldname character(len=CS), allocatable :: flds(:), oflds(:), aflds(:), iflds(:) character(len=*) , parameter :: subname='(esmFldsExchange_ufs)' + + ! component name + character(len=CS) :: lnd_name = '' !-------------------------------------- rc = ESMF_SUCCESS @@ -76,6 +79,13 @@ subroutine esmFldsExchange_ufs(gcomp, phase, rc) write(msgString,'(A,i6,A)') trim(subname)//': maptype is ',maptype,', '//mapnames(maptype) call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + ! determine which land model is present + if (is_local%wrap%comp_present(complnd)) then + call NUOPC_CompAttributeGet(gcomp, name="LND_model", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + lnd_name = trim(cvalue) + end if + if (trim(coupling_mode) == 'ufs.nfrac.aoflux' .or. trim(coupling_mode) == 'ufs.frac.aoflux') then med_aoflux_to_ocn = .true. else @@ -773,6 +783,28 @@ subroutine esmFldsExchange_ufs(gcomp, phase, rc) end do deallocate(flds) + + if (lnd_name == 'lm4') then + allocate(flds(4)) + flds = (/'Faxa_swndr', 'Faxa_swndf', 'Faxa_swvdr', 'Faxa_swvdf' /) + do n = 1,size(flds) + fldname = trim(flds(n)) + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(complnd)) then + call addfld_from(compatm , fldname) + call addfld_to(complnd , fldname) + end if + else + if ( fldchk(is_local%wrap%FBexp(complnd) , fldname, rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), fldname, rc=rc)) then + call addmap_from(compatm, fldname, complnd, maptype, 'one', 'unset') + call addmrg_to(complnd, fldname, mrg_from=compatm, mrg_fld=fldname, mrg_type='copy') + end if + end if + end do + deallocate(flds) + end if ! lm4 + end subroutine esmFldsExchange_ufs end module esmFldsExchange_ufs_mod From 55576eba972ad53cc6546f00d409fa27361f78bd Mon Sep 17 00:00:00 2001 From: Nicholas Szapiro <149816583+NickSzapiro-NOAA@users.noreply.github.com> Date: Wed, 11 Dec 2024 11:19:10 -0500 Subject: [PATCH 006/123] Flexible restart write times (restart_fh) (#125) * restart_fh using shr_is_restart_fh_mod * Use is_restart_fh revised to avoid thread-local storage inter-component conflicts --- mediator/med_phases_restart_mod.F90 | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/mediator/med_phases_restart_mod.F90 b/mediator/med_phases_restart_mod.F90 index 6bbdb6b75..b161f6b79 100644 --- a/mediator/med_phases_restart_mod.F90 +++ b/mediator/med_phases_restart_mod.F90 @@ -14,6 +14,9 @@ module med_phases_restart_mod use med_phases_prep_glc_mod , only : FBocnAccum2glc_o, ocnAccum2glc_cnt use med_phases_prep_rof_mod , only : FBlndAccum2rof_l, lndAccum2rof_cnt use pio , only : file_desc_t +#ifndef CESMCOUPLED + use shr_is_restart_fh_mod, only : init_is_restart_fh, is_restart_fh, is_restart_fh_type +#endif implicit none private @@ -23,6 +26,9 @@ module med_phases_restart_mod private :: med_phases_restart_alarm_init logical :: write_restart_at_endofrun = .false. +#ifndef CESMCOUPLED + type(is_restart_fh_type) :: restartfh_info ! For flexible restarts in UFS +#endif logical :: whead(2) = (/.true. , .false./) logical :: wdata(2) = (/.false., .true. /) @@ -115,6 +121,10 @@ subroutine med_phases_restart_alarm_init(gcomp, rc) write(logunit,*) end if +#ifndef CESMCOUPLED + call init_is_restart_fh(mcurrtime, timestep_length,maintask, restartfh_info) +#endif + end subroutine med_phases_restart_alarm_init !=============================================================================== @@ -178,6 +188,7 @@ subroutine med_phases_restart_write(gcomp, rc) real(R8) :: tbnds(2) ! CF1.0 time bounds logical :: isPresent logical :: first_time = .true. + logical :: write_restartfh character(len=*), parameter :: subname='(med_phases_restart_write)' !--------------------------------------- @@ -244,6 +255,11 @@ subroutine med_phases_restart_write(gcomp, rc) endif endif +#ifndef CESMCOUPLED + call is_restart_fh(clock, restartfh_info, write_restartfh) + if (write_restartfh) alarmIsOn = .true. +#endif + if (alarmIsOn) then call ESMF_ClockGet(clock, currtime=currtime, starttime=starttime, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return From b5d1cc189fced4abcb13fc70ed2febb2aef61757 Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Mon, 16 Dec 2024 10:41:07 -0500 Subject: [PATCH 007/123] Sync w/ latest ESCOMP/main (#129) --- .github/workflows/extbuild.yml | 4 +- .github/workflows/srt.yml | 20 +- cesm/driver/esm_time_mod.F90 | 347 +------ cesm/nuopc_cap_share/nuopc_shr_methods.F90 | 859 ------------------ cime_config/buildnml | 43 +- cime_config/config_component.xml | 137 ++- cime_config/config_component_cesm.xml | 23 +- cime_config/namelist_definition_drv.xml | 113 ++- cime_config/runseq/driver_config.py | 10 +- cime_config/testdefs/testlist_drv.xml | 10 + .../drv/aoflux_ogrid/user_nl_cpl | 1 + doc/source/addendum/req_attributes_cesm.rst | 27 +- mediator/CMakeLists.txt | 2 +- mediator/Makefile | 7 +- mediator/esmFldsExchange_cesm_mod.F90 | 95 +- mediator/med.F90 | 152 +++- mediator/med_diag_mod.F90 | 29 +- mediator/med_internalstate_mod.F90 | 15 +- mediator/med_map_mod.F90 | 131 ++- mediator/med_phases_aofluxes_mod.F90 | 45 +- mediator/med_phases_history_mod.F90 | 11 +- mediator/med_phases_ocnalb_mod.F90 | 15 +- mediator/med_phases_prep_glc_mod.F90 | 21 +- mediator/med_phases_profile_mod.F90 | 14 +- mediator/med_phases_restart_mod.F90 | 63 +- mediator/med_time_mod.F90 | 302 ------ 26 files changed, 634 insertions(+), 1862 deletions(-) delete mode 100644 cesm/nuopc_cap_share/nuopc_shr_methods.F90 create mode 100644 cime_config/testdefs/testmods_dirs/drv/aoflux_ogrid/user_nl_cpl delete mode 100644 mediator/med_time_mod.F90 diff --git a/.github/workflows/extbuild.yml b/.github/workflows/extbuild.yml index e1c69cd7b..24b18683d 100644 --- a/.github/workflows/extbuild.yml +++ b/.github/workflows/extbuild.yml @@ -23,8 +23,8 @@ jobs: 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.36 + PIO_VERSION: pio2_6_3 + CDEPS_VERSION: cdeps1.0.59 steps: - uses: actions/checkout@v4 # Build the ESMF library, if the cache contains a previous build diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index efec7ba88..fc75ec263 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -18,7 +18,7 @@ jobs: runs-on: ubuntu-latest strategy: matrix: - python-version: [ 3.10.9 ] + python-version: [ 3.x ] env: CC: mpicc FC: mpifort @@ -27,7 +27,7 @@ jobs: LDFLAGS: "-L/usr/lib/x86_64-linux-gnu -lnetcdf -lnetcdff -lpnetcdf" # Versions of all dependencies can be updated here ESMF_VERSION: v8.6.1 - PARALLELIO_VERSION: pio2_6_2 + PARALLELIO_VERSION: pio2_6_3 CIME_MODEL: cesm CIME_DRIVER: nuopc GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} @@ -78,13 +78,15 @@ jobs: # cpl7 is needed - i think that's a bug - name: checkout externals run: | + git config --global user.name "${GITHUB_ACTOR}" + git config --global user.email "${GITHUB_ACTOR_ID}+${GITHUB_ACTOR}@users.noreply.github.com" pushd cesm - ./bin/git-fleximod update ccs_config cdeps share mct parallelio + ./bin/git-fleximod update cime ccs_config cdeps share mct parallelio cd ccs_config git checkout main - cd ../ - git clone https://github.com/ESMCI/cime - cd cime + cd ../cime + git checkout master + git status if [[ ! -e "${PWD}/.gitmodules.bak" ]] then echo "Converting git@github.com to https://github.com urls in ${PWD}/.gitmodules" @@ -172,6 +174,6 @@ jobs: popd # the following can be used by developers to login to the github server in case of errors # see https://github.com/marketplace/actions/debugging-with-tmate for further details - - name: Setup tmate session - if: ${{ failure() }} - uses: mxschmitt/action-tmate@v3 +# - name: Setup tmate session +# if: ${{ failure() }} +# uses: mxschmitt/action-tmate@v3 diff --git a/cesm/driver/esm_time_mod.F90 b/cesm/driver/esm_time_mod.F90 index 3b56bb953..c423b96fc 100644 --- a/cesm/driver/esm_time_mod.F90 +++ b/cesm/driver/esm_time_mod.F90 @@ -11,28 +11,26 @@ module esm_time_mod use ESMF , only : ESMF_TimeInterval, ESMF_TimeIntervalSet, ESMF_TimeIntervalGet use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_FAILURE, ESMF_LOGMSG_ERROR use ESMF , only : ESMF_VM, ESMF_VMGet, ESMF_VMBroadcast - use ESMF , only : ESMF_VMAllReduce, ESMF_REDUCE_MAX + use ESMF , only : ESMF_VMAllReduce, ESMF_REDUCE_MAX, ESMF_ClockGetAlarm use ESMF , only : ESMF_LOGMSG_INFO, ESMF_FAILURE, ESMF_GridCompIsPetLocal use ESMF , only : operator(<), operator(/=), operator(+) use ESMF , only : operator(-), operator(*) , operator(>=) use ESMF , only : operator(<=), operator(>), operator(==) use NUOPC , only : NUOPC_CompAttributeGet use esm_utils_mod , only : chkerr - + use nuopc_shr_methods , only : AlarmInit + implicit none private ! default private - public :: esm_time_clockInit ! initialize driver clock (assumes default calendar) + public :: esm_time_clockinit ! initialize driver clock (assumes default calendar) -! private :: esm_time_timeInit - private :: esm_time_alarmInit private :: esm_time_date2ymd ! Clock and alarm options character(len=*), private, parameter :: & optNONE = "none" , & optNever = "never" , & - optNSteps = "nstep" , & optNSeconds = "nsecond" , & optNMinutes = "nminute" , & optNHours = "nhour" , & @@ -42,6 +40,7 @@ module esm_time_mod optMonthly = "monthly" , & optYearly = "yearly" , & optDate = "date" , & + optEnd = "end" , & optGLCCouplingPeriod = "glc_coupling_period" ! Module data @@ -53,8 +52,8 @@ module esm_time_mod contains !=============================================================================== - subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, maintask, rc) - + subroutine esm_time_clockinit(ensemble_driver, instance_driver, logunit, maintask, rc) + use nuopc_shr_methods, only : get_minimum_timestep, dtime_drv ! input/output variables type(ESMF_GridComp) :: ensemble_driver, instance_driver integer, intent(in) :: logunit @@ -81,20 +80,11 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, maintas integer :: stop_ymd ! Stop date (YYYYMMDD) integer :: stop_tod ! Stop time-of-day character(CS) :: stop_option ! Stop option units - integer :: atm_cpl_dt ! Atmosphere coupling interval - integer :: lnd_cpl_dt ! Land coupling interval - integer :: ice_cpl_dt ! Sea-Ice coupling interval - integer :: ocn_cpl_dt ! Ocean coupling interval - integer :: glc_cpl_dt ! Glc coupling interval - integer :: rof_cpl_dt ! Runoff coupling interval - integer :: wav_cpl_dt ! Wav coupling interval -! integer :: esp_cpl_dt ! Esp coupling interval character(CS) :: glc_avg_period ! Glc avering coupling period logical :: read_restart character(len=CL) :: restart_file character(len=CL) :: restart_pfile character(len=CL) :: cvalue - integer :: dtime_drv ! time-step to use integer :: yr, mon, day ! Year, month, day as integers integer :: unitn ! unit number integer :: ierr ! Return code @@ -105,6 +95,7 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, maintas logical :: isPresent logical :: inDriver logical, save :: firsttime=.true. + logical :: exists character(len=*), parameter :: subname = '('//__FILE__//':esm_time_clockInit) ' !------------------------------------------------------------------------------- @@ -122,44 +113,7 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, maintas if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) start_tod - !--------------------------------------------------------------------------- - ! Determine driver clock timestep - !--------------------------------------------------------------------------- - - call NUOPC_CompAttributeGet(ensemble_driver, name="atm_cpl_dt", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) atm_cpl_dt - - call NUOPC_CompAttributeGet(ensemble_driver, name="lnd_cpl_dt", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) lnd_cpl_dt - - call NUOPC_CompAttributeGet(ensemble_driver, name="ice_cpl_dt", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) ice_cpl_dt - call NUOPC_CompAttributeGet(ensemble_driver, name="ocn_cpl_dt", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) ocn_cpl_dt - - call NUOPC_CompAttributeGet(ensemble_driver, name="glc_cpl_dt", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) glc_cpl_dt - - call NUOPC_CompAttributeGet(ensemble_driver, name="rof_cpl_dt", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) rof_cpl_dt - - call NUOPC_CompAttributeGet(ensemble_driver, name="wav_cpl_dt", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) wav_cpl_dt - - dtime_drv = minval((/atm_cpl_dt, lnd_cpl_dt, ocn_cpl_dt, ice_cpl_dt, glc_cpl_dt, rof_cpl_dt, wav_cpl_dt/)) - if(maintask) then - write(tmpstr,'(i10)') dtime_drv - call ESMF_LogWrite(trim(subname)//': driver time interval is : '// trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - write(logunit,*) trim(subname)//': driver time interval is : '// trim(tmpstr) - endif call ESMF_GridCompGet(ensemble_driver, vm=envm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -177,23 +131,20 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, maintas if (read_restart) then - call NUOPC_CompAttributeGet(instance_driver, name='drv_restart_pointer', value=restart_file, rc=rc) + call NUOPC_CompAttributeGet(instance_driver, name='drv_restart_pointer', value=restart_pfile, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (trim(restart_file) /= 'none') then - - call NUOPC_CompAttributeGet(instance_driver, name="inst_suffix", isPresent=isPresent, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if(isPresent) then - call NUOPC_CompAttributeGet(instance_driver, name="inst_suffix", value=inst_suffix, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - inst_suffix = "" - endif - - restart_pfile = trim(restart_file)//inst_suffix + if (trim(restart_pfile) /= 'none') then if (maintask) then + write(logunit,*) " read rpointer file = "//trim(restart_pfile) + inquire( file=trim(restart_pfile), exist=exists) + if (.not. exists) then + rc = ESMF_FAILURE + call ESMF_LogWrite(trim(subname)//' ERROR rpointer file '//trim(restart_pfile)//' not found', & + ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__) + return + endif call ESMF_LogWrite(trim(subname)//" read rpointer file = "//trim(restart_pfile), & ESMF_LOGMSG_INFO) open(newunit=unitn, file=restart_pfile, form='FORMATTED', status='old',iostat=ierr) @@ -282,6 +233,12 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, maintas call ESMF_TimeSet( RefTime, yy=yr, mm=mon, dd=day, s=ref_tod, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + dtime_drv = get_minimum_timestep(ensemble_driver, rc) + if(maintask) then + write(tmpstr,'(i10)') dtime_drv + call ESMF_LogWrite(trim(subname)//': driver time interval is : '// trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + write(logunit,*) trim(subname)//': driver time interval is : '// trim(tmpstr) + endif call ESMF_TimeIntervalSet( TimeStep, s=dtime_drv, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -335,7 +292,7 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, maintas write(logunit,*) trim(subname)//': driver stop_tod: '// trim(tmpstr) endif - call esm_time_alarmInit(clock, & + call alarmInit(clock, & alarm = alarm_stop, & option = stop_option, & opt_n = stop_n, & @@ -364,260 +321,8 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, maintas if (ChkErr(rc,__LINE__,u_FILE_u)) return firsttime = .false. endif - end subroutine esm_time_clockInit - - !=============================================================================== - - subroutine esm_time_alarmInit( clock, alarm, option, & - opt_n, opt_ymd, opt_tod, RefTime, alarmname, rc) - - ! Setup an alarm in a clock - ! Notes: The ringtime sent to AlarmCreate MUST be the next alarm - ! time. If you send an arbitrary but proper ringtime from the - ! past and the ring interval, the alarm will always go off on the - ! next clock advance and this will cause serious problems. Even - ! if it makes sense to initialize an alarm with some reference - ! time and the alarm interval, that reference time has to be - ! advance forward to be >= the current time. In the logic below - ! we set an appropriate "NextAlarm" and then we make sure to - ! advance it properly based on the ring interval. - - ! input/output variables - type(ESMF_Clock) , intent(inout) :: clock ! clock - type(ESMF_Alarm) , intent(inout) :: alarm ! alarm - character(len=*) , intent(in) :: option ! alarm option - integer , optional , intent(in) :: opt_n ! alarm freq - integer , optional , intent(in) :: opt_ymd ! alarm ymd - integer , optional , intent(in) :: opt_tod ! alarm tod (sec) - type(ESMF_Time) , optional , intent(in) :: RefTime ! ref time - character(len=*) , optional , intent(in) :: alarmname ! alarm name - integer , intent(inout) :: rc ! Return code - - ! local variables - type(ESMF_Calendar) :: cal ! calendar - integer :: lymd ! local ymd - integer :: ltod ! local tod - integer :: cyy,cmm,cdd,csec ! time info - character(len=64) :: lalarmname ! local alarm name - logical :: update_nextalarm ! update next alarm - type(ESMF_Time) :: CurrTime ! Current Time - type(ESMF_Time) :: NextAlarm ! Next restart alarm time - type(ESMF_TimeInterval) :: AlarmInterval ! Alarm interval - character(len=*), parameter :: subname = '(med_time_alarmInit): ' - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - lalarmname = 'alarm_unknown' - if (present(alarmname)) lalarmname = trim(alarmname) - ltod = 0 - if (present(opt_tod)) ltod = opt_tod - lymd = -1 - if (present(opt_ymd)) lymd = opt_ymd - - call ESMF_ClockGet(clock, CurrTime=CurrTime, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_TimeGet(CurrTime, yy=cyy, mm=cmm, dd=cdd, s=csec, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! initial guess of next alarm, this will be updated below - if (present(RefTime)) then - NextAlarm = RefTime - else - NextAlarm = CurrTime - endif - - ! Get calendar from clock - call ESMF_ClockGet(clock, calendar=cal, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! Error checks - if (trim(option) == optdate) then - if (.not. present(opt_ymd)) then - call ESMF_LogWrite(trim(subname)//trim(option)//' requires opt_ymd', ESMF_LOGMSG_ERROR) - rc = ESMF_FAILURE - return - end if - if (lymd < 0 .or. ltod < 0) then - call ESMF_LogWrite(subname//trim(option)//'opt_ymd, opt_tod invalid', ESMF_LOGMSG_ERROR) - rc = ESMF_FAILURE - return - end if - else if (& - trim(option) == optNSteps .or. trim(option) == trim(optNSteps)//'s' .or. & - trim(option) == optNSeconds .or. trim(option) == trim(optNSeconds)//'s' .or. & - trim(option) == optNMinutes .or. trim(option) == trim(optNMinutes)//'s' .or. & - trim(option) == optNHours .or. trim(option) == trim(optNHours)//'s' .or. & - trim(option) == optNDays .or. trim(option) == trim(optNDays)//'s' .or. & - trim(option) == optNMonths .or. trim(option) == trim(optNMonths)//'s' .or. & - trim(option) == optNYears .or. trim(option) == trim(optNYears)//'s' ) then - if (.not.present(opt_n)) then - call ESMF_LogWrite(subname//trim(option)//' requires opt_n', ESMF_LOGMSG_ERROR) - rc = ESMF_FAILURE - return - end if - if (opt_n <= 0) then - call ESMF_LogWrite(subname//trim(option)//' invalid opt_n', ESMF_LOGMSG_ERROR) - rc = ESMF_FAILURE - return - end if - end if - - ! Determine inputs for call to create alarm - selectcase (trim(option)) - - case (optNONE) - call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeSet( NextAlarm, yy=9999, mm=12, dd=1, s=0, calendar=cal, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .false. - - case (optDate) - call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call esm_time_date2ymd(opt_ymd, cyy, cmm, cdd) - - call ESMF_TimeSet( NextAlarm, yy=cyy, mm=cmm, dd=cdd, s=ltod, calendar=cal, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .false. - - case (optNever) - call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeSet( NextAlarm, yy=9999, mm=12, dd=1, s=0, calendar=cal, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .false. - - case (optNSteps,trim(optNSteps)//'s') - call ESMF_ClockGet(clock, TimeStep=AlarmInterval, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNSeconds,trim(optNSeconds)//'s') - call ESMF_TimeIntervalSet(AlarmInterval, s=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNMinutes,trim(optNMinutes)//'s') - call ESMF_TimeIntervalSet(AlarmInterval, s=60, rc=rc) - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNHours,trim(optNHours)//'s') - call ESMF_TimeIntervalSet(AlarmInterval, s=3600, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNDays,trim(optNDays)//'s') - call ESMF_TimeIntervalSet(AlarmInterval, d=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNMonths,trim(optNMonths)//'s') - call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optMonthly) - call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeSet( NextAlarm, yy=cyy, mm=cmm, dd=1, s=0, calendar=cal, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .true. - - case (optNYears, trim(optNYears)//'s') - call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optYearly) - call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeSet( NextAlarm, yy=cyy, mm=1, dd=1, s=0, calendar=cal, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .true. - - case default - call ESMF_LogWrite(subname//'unknown option '//trim(option), ESMF_LOGMSG_ERROR) - rc = ESMF_FAILURE - return - - end select - - ! -------------------------------------------------------------------------------- - ! --- AlarmInterval and NextAlarm should be set --- - ! -------------------------------------------------------------------------------- - - ! --- advance Next Alarm so it won't ring on first timestep for - ! --- most options above. go back one alarminterval just to be careful - - if (update_nextalarm) then - NextAlarm = NextAlarm - AlarmInterval - do while (NextAlarm <= CurrTime) - NextAlarm = NextAlarm + AlarmInterval - enddo - endif - - alarm = ESMF_AlarmCreate( name=lalarmname, clock=clock, ringTime=NextAlarm, & - ringInterval=AlarmInterval, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - end subroutine esm_time_alarmInit - - !=============================================================================== -#ifdef UNUSEDFUNCTION - subroutine esm_time_timeInit( Time, ymd, cal, tod, desc, logunit ) - - ! Create the ESMF_Time object corresponding to the given input time, given in - ! YMD (Year Month Day) and TOD (Time-of-day) format. - ! Set the time by an integer as YYYYMMDD and integer seconds in the day - - ! input/output parameters: - type(ESMF_Time) , intent(inout) :: Time ! ESMF time - integer , intent(in) :: ymd ! year, month, day YYYYMMDD - type(ESMF_Calendar) , intent(in) :: cal ! ESMF calendar - integer , intent(in), optional :: tod ! time of day in seconds - character(len=*) , intent(in), optional :: desc ! description of time to set - integer , intent(in), optional :: logunit - - ! local variables - integer :: yr, mon, day ! Year, month, day as integers - integer :: ltod ! local tod - character(len=256) :: ldesc ! local desc - integer :: rc ! return code - character(len=*), parameter :: subname = '(esm_time_m_ETimeInit) ' - !------------------------------------------------------------------------------- - - ltod = 0 - if (present(tod)) ltod = tod - ldesc = '' - if (present(desc)) ldesc = desc - - if ( (ymd < 0) .or. (ltod < 0) .or. (ltod > SecPerDay) )then - if (present(logunit)) then - write(logunit,*) subname//': ERROR yymmdd is a negative number or '// & - 'time-of-day out of bounds', ymd, ltod - end if - call ESMF_LogWrite( subname//'ERROR: Bad input' , ESMF_LOGMSG_ERROR) - rc = ESMF_FAILURE - return - end if - - call esm_time_date2ymd (ymd,yr,mon,day) - - call ESMF_TimeSet( Time, yy=yr, mm=mon, dd=day, s=ltod, calendar=cal, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + end subroutine esm_time_clockinit - end subroutine esm_time_timeInit -#endif !=============================================================================== subroutine esm_time_date2ymd (date, year, month, day) diff --git a/cesm/nuopc_cap_share/nuopc_shr_methods.F90 b/cesm/nuopc_cap_share/nuopc_shr_methods.F90 deleted file mode 100644 index 9062b27f1..000000000 --- a/cesm/nuopc_cap_share/nuopc_shr_methods.F90 +++ /dev/null @@ -1,859 +0,0 @@ -module nuopc_shr_methods - - use ESMF , only : operator(<), operator(/=), operator(+) - use ESMF , only : operator(-), operator(*) , operator(>=) - use ESMF , only : operator(<=), operator(>), operator(==) - use ESMF , only : ESMF_LOGERR_PASSTHRU, ESMF_LogFoundError, ESMF_LOGMSG_ERROR, ESMF_MAXSTR - use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_FAILURE - use ESMF , only : ESMF_State, ESMF_StateGet - use ESMF , only : ESMF_Field, ESMF_FieldGet - use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_GridCompSet - use ESMF , only : ESMF_GeomType_Flag, ESMF_FieldStatus_Flag - use ESMF , only : ESMF_Mesh, ESMF_MeshGet - use ESMF , only : ESMF_GEOMTYPE_MESH, ESMF_GEOMTYPE_GRID, ESMF_FIELDSTATUS_COMPLETE - use ESMF , only : ESMF_Clock, ESMF_ClockCreate, ESMF_ClockGet, ESMF_ClockSet - use ESMF , only : ESMF_ClockPrint, ESMF_ClockAdvance - use ESMF , only : ESMF_Alarm, ESMF_AlarmCreate, ESMF_AlarmGet, ESMF_AlarmSet - use ESMF , only : ESMF_Calendar, ESMF_CALKIND_NOLEAP, ESMF_CALKIND_GREGORIAN - use ESMF , only : ESMF_Time, ESMF_TimeGet, ESMF_TimeSet - use ESMF , only : ESMF_TimeInterval, ESMF_TimeIntervalSet, ESMF_TimeIntervalGet - use ESMF , only : ESMF_VM, ESMF_VMGet, ESMF_VMBroadcast, ESMF_VMGetCurrent - use NUOPC , only : NUOPC_CompAttributeGet - use NUOPC_Model , only : NUOPC_ModelGet - use shr_kind_mod , only : r8 => shr_kind_r8, cl=>shr_kind_cl, cs=>shr_kind_cs - use shr_sys_mod , only : shr_sys_abort - use shr_log_mod , only : shr_log_setLogUnit - - implicit none - private - - public :: memcheck - public :: get_component_instance - public :: set_component_logging - public :: log_clock_advance - public :: state_getscalar - public :: state_setscalar - public :: state_diagnose - public :: alarmInit - public :: chkerr - - private :: timeInit - private :: field_getfldptr - - ! Clock and alarm options - character(len=*), private, parameter :: & - optNONE = "none" , & - optNever = "never" , & - optNSteps = "nsteps" , & - optNStep = "nstep" , & - optNSeconds = "nseconds" , & - optNSecond = "nsecond" , & - optNMinutes = "nminutes" , & - optNMinute = "nminute" , & - optNHours = "nhours" , & - optNHour = "nhour" , & - optNDays = "ndays" , & - optNDay = "nday" , & - optNMonths = "nmonths" , & - optNMonth = "nmonth" , & - optNYears = "nyears" , & - optNYear = "nyear" , & - optMonthly = "monthly" , & - optYearly = "yearly" , & - optEnd = "end" , & - optDate = "date" - - - ! Module data - integer, parameter :: SecPerDay = 86400 ! Seconds per day - integer, parameter :: memdebug_level=1 - character(len=1024) :: msgString - character(len=*), parameter :: u_FILE_u = & - __FILE__ - -!=============================================================================== -contains -!=============================================================================== - - subroutine memcheck(string, level, maintask) - - ! input/output variables - character(len=*) , intent(in) :: string - integer , intent(in) :: level - logical , intent(in) :: maintask - - ! local variables - integer :: ierr -#ifdef CESMCOUPLED - integer, external :: GPTLprint_memusage -#endif - !----------------------------------------------------------------------- - -#ifdef CESMCOUPLED - if ((maintask .and. memdebug_level > level) .or. memdebug_level > level+1) then - ierr = GPTLprint_memusage(string) - endif -#endif - - end subroutine memcheck - -!=============================================================================== - - subroutine get_component_instance(gcomp, inst_suffix, inst_index, rc) - - ! input/output variables - type(ESMF_GridComp) :: gcomp - character(len=*) , intent(out) :: inst_suffix - integer , intent(out) :: inst_index - integer , intent(out) :: rc - - ! local variables - logical :: isPresent - character(len=4) :: cvalue - !----------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - call NUOPC_CompAttributeGet(gcomp, name="inst_suffix", isPresent=isPresent, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - if (isPresent) then - call NUOPC_CompAttributeGet(gcomp, name="inst_suffix", value=inst_suffix, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - cvalue = inst_suffix(2:) - read(cvalue, *) inst_index - else - inst_suffix = "" - inst_index=1 - endif - - end subroutine get_component_instance - -!=============================================================================== - subroutine set_component_logging(gcomp, maintask, logunit, shrlogunit, rc) - use NUOPC, only: NUOPC_CompAttributeSet, NUOPC_CompAttributeAdd - ! input/output variables - type(ESMF_GridComp) :: gcomp - logical, intent(in) :: maintask - integer, intent(out) :: logunit - integer, intent(out) :: shrlogunit - integer, intent(out) :: rc - - ! local variables - character(len=CL) :: diro - character(len=CL) :: logfile - character(len=CL) :: inst_suffix - integer :: inst_index ! Not used here - integer :: n - character(len=CL) :: name - character(len=*), parameter :: subname = "("//__FILE__//": set_component_logging)" - !----------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - if (maintask) then - call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(gcomp, name="logfile", value=logfile, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call get_component_instance(gcomp, inst_suffix, inst_index, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - ! Multiinstance logfile name needs a correction - if(len_trim(inst_suffix) > 0) then - n = index(logfile, '.') - logfile = logfile(1:n-1)//trim(inst_suffix)//logfile(n:) - endif - - open(newunit=logunit,file=trim(diro)//"/"//trim(logfile)) - - else - logUnit = 6 - endif - - call ESMF_GridCompGet(gcomp, name=name, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_LogWrite(trim(subname)//": setting logunit for component: "//trim(name), ESMF_LOGMSG_INFO) - call NUOPC_CompAttributeAdd(gcomp, (/"logunit"/), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeSet(gcomp, "logunit", logunit, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call shr_log_setLogUnit (logunit) - ! Still need to set this return value - shrlogunit = logunit - call ESMF_LogWrite(trim(subname)//": done for component "//trim(name), ESMF_LOGMSG_INFO) - end subroutine set_component_logging - -!=============================================================================== - - subroutine log_clock_advance(clock, component, logunit, rc) - - ! input/output variables - type(ESMF_Clock) :: clock - character(len=*) , intent(in) :: component - integer , intent(in) :: logunit - integer , intent(out) :: rc - - ! local variables - character(len=CL) :: cvalue, prestring - !----------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - write(prestring, *) "------>Advancing ",trim(component)," from: " - call ESMF_ClockPrint(clock, options="currTime", unit=cvalue, preString=trim(prestring), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - write(logunit, *) trim(cvalue) - - call ESMF_ClockPrint(clock, options="stopTime", unit=cvalue, & - preString="--------------------------------> to: ", rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - write(logunit, *) trim(cvalue) - - end subroutine log_clock_advance - -!=============================================================================== - - subroutine state_getscalar(state, scalar_id, scalar_value, flds_scalar_name, flds_scalar_num, rc) - - ! ---------------------------------------------- - ! Get scalar data from State for a particular name and broadcast it to all other pets - ! ---------------------------------------------- - - ! input/output variables - type(ESMF_State), intent(in) :: state - integer, intent(in) :: scalar_id - real(r8), intent(out) :: scalar_value - character(len=*), intent(in) :: flds_scalar_name - integer, intent(in) :: flds_scalar_num - integer, intent(inout) :: rc - - ! local variables - integer :: mytask, ierr, len - type(ESMF_VM) :: vm - type(ESMF_Field) :: field - real(r8), pointer :: farrayptr(:,:) - real(r8) :: tmp(1) - character(len=*), parameter :: subname='(state_getscalar)' - ! ---------------------------------------------- - - rc = ESMF_SUCCESS - - call ESMF_VMGetCurrent(vm, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_VMGet(vm, localPet=mytask, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_StateGet(State, itemName=trim(flds_scalar_name), field=field, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - if (mytask == 0) then - call ESMF_FieldGet(field, farrayPtr = farrayptr, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (scalar_id < 0 .or. scalar_id > flds_scalar_num) then - call ESMF_LogWrite(trim(subname)//": ERROR in scalar_id", ESMF_LOGMSG_INFO, line=__LINE__, file=u_FILE_u) - rc = ESMF_FAILURE - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - endif - tmp(:) = farrayptr(scalar_id,:) - endif - call ESMF_VMBroadCast(vm, tmp, 1, 0, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - scalar_value = tmp(1) - - end subroutine state_getscalar - -!================================================================================ - - subroutine state_setscalar(scalar_value, scalar_id, State, flds_scalar_name, flds_scalar_num, rc) - - ! ---------------------------------------------- - ! Set scalar data from State for a particular name - ! ---------------------------------------------- - - ! input/output arguments - real(r8), intent(in) :: scalar_value - integer, intent(in) :: scalar_id - type(ESMF_State), intent(inout) :: State - character(len=*), intent(in) :: flds_scalar_name - integer, intent(in) :: flds_scalar_num - integer, intent(inout) :: rc - - ! local variables - integer :: mytask - type(ESMF_Field) :: lfield - type(ESMF_VM) :: vm - real(r8), pointer :: farrayptr(:,:) - character(len=*), parameter :: subname='(state_setscalar)' - ! ---------------------------------------------- - - rc = ESMF_SUCCESS - - call ESMF_VMGetCurrent(vm, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_VMGet(vm, localPet=mytask, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_StateGet(State, itemName=trim(flds_scalar_name), field=lfield, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - if (mytask == 0) then - call ESMF_FieldGet(lfield, farrayPtr = farrayptr, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (scalar_id < 0 .or. scalar_id > flds_scalar_num) then - call ESMF_LogWrite(trim(subname)//": ERROR in scalar_id", ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - endif - farrayptr(scalar_id,1) = scalar_value - endif - - end subroutine state_setscalar - -!=============================================================================== - - subroutine state_diagnose(State, string, rc) - - ! ---------------------------------------------- - ! Diagnose status of State - ! ---------------------------------------------- - - type(ESMF_State), intent(in) :: state - character(len=*), intent(in) :: string - integer , intent(out) :: rc - - ! local variables - integer :: i,j,n - type(ESMf_Field) :: lfield - integer :: fieldCount, lrank - character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) - real(r8), pointer :: dataPtr1d(:) - real(r8), pointer :: dataPtr2d(:,:) - character(len=*),parameter :: subname='(state_diagnose)' - ! ---------------------------------------------- - - call ESMF_StateGet(state, itemCount=fieldCount, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - allocate(lfieldnamelist(fieldCount)) - - call ESMF_StateGet(state, itemNameList=lfieldnamelist, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - do n = 1, fieldCount - - call ESMF_StateGet(state, itemName=lfieldnamelist(n), field=lfield, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call field_getfldptr(lfield, fldptr1=dataPtr1d, fldptr2=dataPtr2d, rank=lrank, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - if (lrank == 0) then - ! no local data - elseif (lrank == 1) then - if (size(dataPtr1d) > 0) then - write(msgString,'(A,a)') trim(string)//': for 1d field '//trim(lfieldnamelist(n)) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - write(msgString,'(A,3g14.7,i8)') trim(string)//': 1d field '//trim(lfieldnamelist(n)), & - minval(dataPtr1d), maxval(dataPtr1d), sum(dataPtr1d), size(dataPtr1d) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - else - write(msgString,'(A,a)') trim(string)//': '//trim(lfieldnamelist(n))," no data" - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - endif - elseif (lrank == 2) then - if (size(dataPtr2d) > 0) then - write(msgString,'(A,a)') trim(string)//': for 2d field '//trim(lfieldnamelist(n)) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - write(msgString,'(A,3g14.7,i8)') trim(string)//': 2d field '//trim(lfieldnamelist(n)), & - minval(dataPtr2d), maxval(dataPtr2d), sum(dataPtr2d), size(dataPtr2d) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - else - write(msgString,'(A,a)') trim(string)//': '//trim(lfieldnamelist(n))," no data" - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - endif - else - call ESMF_LogWrite(trim(subname)//": ERROR rank not supported ", ESMF_LOGMSG_ERROR) - rc = ESMF_FAILURE - return - endif - enddo - - deallocate(lfieldnamelist) - - end subroutine state_diagnose - -!=============================================================================== - - subroutine field_getfldptr(field, fldptr1, fldptr2, rank, abort, rc) - - ! ---------------------------------------------- - ! for a field, determine rank and return fldptr1 or fldptr2 - ! abort is true by default and will abort if fldptr is not yet allocated in field - ! rank returns 0, 1, or 2. 0 means fldptr not allocated and abort=false - ! ---------------------------------------------- - - ! input/output variables - type(ESMF_Field) , intent(in) :: field - real(r8), pointer , intent(inout), optional :: fldptr1(:) - real(r8), pointer , intent(inout), optional :: fldptr2(:,:) - integer , intent(out) , optional :: rank - logical , intent(in) , optional :: abort - integer , intent(out) , optional :: rc - - ! local variables - type(ESMF_GeomType_Flag) :: geomtype - type(ESMF_FieldStatus_Flag) :: status - type(ESMF_Mesh) :: lmesh - integer :: lrank, nnodes, nelements - logical :: labort - character(len=*), parameter :: subname='(field_getfldptr)' - ! ---------------------------------------------- - - if (.not.present(rc)) then - call ESMF_LogWrite(trim(subname)//": ERROR rc not present ", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) - rc = ESMF_FAILURE - return - endif - - rc = ESMF_SUCCESS - - labort = .true. - if (present(abort)) then - labort = abort - endif - lrank = -99 - - call ESMF_FieldGet(field, status=status, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - if (status /= ESMF_FIELDSTATUS_COMPLETE) then - lrank = 0 - if (labort) then - call ESMF_LogWrite(trim(subname)//": ERROR data not allocated ", ESMF_LOGMSG_INFO, rc=rc) - rc = ESMF_FAILURE - return - else - call ESMF_LogWrite(trim(subname)//": WARNING data not allocated ", ESMF_LOGMSG_INFO, rc=rc) - endif - else - - call ESMF_FieldGet(field, geomtype=geomtype, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - if (geomtype == ESMF_GEOMTYPE_GRID) then - call ESMF_FieldGet(field, rank=lrank, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - elseif (geomtype == ESMF_GEOMTYPE_MESH) then - call ESMF_FieldGet(field, rank=lrank, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, mesh=lmesh, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_MeshGet(lmesh, numOwnedNodes=nnodes, numOwnedElements=nelements, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (nnodes == 0 .and. nelements == 0) lrank = 0 - else - call ESMF_LogWrite(trim(subname)//": ERROR geomtype not supported ", & - ESMF_LOGMSG_INFO, rc=rc) - rc = ESMF_FAILURE - return - endif ! geomtype - - if (lrank == 0) then - call ESMF_LogWrite(trim(subname)//": no local nodes or elements ", & - ESMF_LOGMSG_INFO) - elseif (lrank == 1) then - if (.not.present(fldptr1)) then - call ESMF_LogWrite(trim(subname)//": ERROR missing rank=1 array ", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) - rc = ESMF_FAILURE - return - endif - call ESMF_FieldGet(field, farrayPtr=fldptr1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - elseif (lrank == 2) then - if (.not.present(fldptr2)) then - call ESMF_LogWrite(trim(subname)//": ERROR missing rank=2 array ", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) - rc = ESMF_FAILURE - return - endif - call ESMF_FieldGet(field, farrayPtr=fldptr2, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - else - call ESMF_LogWrite(trim(subname)//": ERROR in rank ", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) - rc = ESMF_FAILURE - return - endif - - endif ! status - - if (present(rank)) then - rank = lrank - endif - - end subroutine field_getfldptr - -!=============================================================================== - - subroutine alarmInit( clock, alarm, option, & - opt_n, opt_ymd, opt_tod, RefTime, alarmname, rc) - - ! Setup an alarm in a clock - ! Notes: The ringtime sent to AlarmCreate MUST be the next alarm - ! time. If you send an arbitrary but proper ringtime from the - ! past and the ring interval, the alarm will always go off on the - ! next clock advance and this will cause serious problems. Even - ! if it makes sense to initialize an alarm with some reference - ! time and the alarm interval, that reference time has to be - ! advance forward to be >= the current time. In the logic below - ! we set an appropriate "NextAlarm" and then we make sure to - ! advance it properly based on the ring interval. - - ! input/output variables - type(ESMF_Clock) , intent(inout) :: clock ! clock - type(ESMF_Alarm) , intent(inout) :: alarm ! alarm - character(len=*) , intent(in) :: option ! alarm option - integer , optional , intent(in) :: opt_n ! alarm freq - integer , optional , intent(in) :: opt_ymd ! alarm ymd - integer , optional , intent(in) :: opt_tod ! alarm tod (sec) - type(ESMF_Time) , optional , intent(in) :: RefTime ! ref time - character(len=*) , optional , intent(in) :: alarmname ! alarm name - integer , intent(inout) :: rc ! Return code - - ! local variables - type(ESMF_Calendar) :: cal ! calendar - integer :: lymd ! local ymd - integer :: ltod ! local tod - integer :: cyy,cmm,cdd,csec ! time info - character(len=64) :: lalarmname ! local alarm name - logical :: update_nextalarm ! update next alarm - type(ESMF_Time) :: CurrTime ! Current Time - type(ESMF_Time) :: NextAlarm ! Next restart alarm time - type(ESMF_TimeInterval) :: AlarmInterval ! Alarm interval - integer :: sec - character(len=*), parameter :: subname = '(set_alarmInit): ' - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - lalarmname = 'alarm_unknown' - if (present(alarmname)) lalarmname = trim(alarmname) - ltod = 0 - if (present(opt_tod)) ltod = opt_tod - lymd = -1 - if (present(opt_ymd)) lymd = opt_ymd - - call ESMF_ClockGet(clock, CurrTime=CurrTime, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_TimeGet(CurrTime, yy=cyy, mm=cmm, dd=cdd, s=csec, rc=rc ) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! initial guess of next alarm, this will be updated below - if (present(RefTime)) then - NextAlarm = RefTime - else - NextAlarm = CurrTime - endif - - ! Determine calendar - call ESMF_ClockGet(clock, calendar=cal) - - ! Determine inputs for call to create alarm - selectcase (trim(option)) - - case (optNONE) - call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeSet( NextAlarm, yy=9999, mm=12, dd=1, s=0, calendar=cal, rc=rc ) - if (chkerr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .false. - - case (optNever) - call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeSet( NextAlarm, yy=9999, mm=12, dd=1, s=0, calendar=cal, rc=rc ) - if (chkerr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .false. - - case (optEnd) - call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeSet( NextAlarm, yy=9999, mm=12, dd=1, s=0, calendar=cal, rc=rc ) - if (chkerr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .false. - - case (optDate) - if (.not. present(opt_ymd)) then - call shr_sys_abort(subname//trim(option)//' requires opt_ymd') - end if - if (lymd < 0 .or. ltod < 0) then - call shr_sys_abort(subname//trim(option)//'opt_ymd, opt_tod invalid') - end if - call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call timeInit(NextAlarm, lymd, cal, ltod, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .false. - - case (optNSteps) - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_ClockGet(clock, TimeStep=AlarmInterval, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNStep) - if (.not.present(opt_n)) call shr_sys_abort(subname//trim(option)//' requires opt_n') - if (opt_n <= 0) call shr_sys_abort(subname//trim(option)//' invalid opt_n') - call ESMF_ClockGet(clock, TimeStep=AlarmInterval, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNSeconds) - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_TimeIntervalSet(AlarmInterval, s=1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNSecond) - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_TimeIntervalSet(AlarmInterval, s=1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNMinutes) - call ESMF_TimeIntervalSet(AlarmInterval, s=60, rc=rc) - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNMinute) - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_TimeIntervalSet(AlarmInterval, s=60, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNHours) - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_TimeIntervalSet(AlarmInterval, s=3600, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNHour) - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_TimeIntervalSet(AlarmInterval, s=3600, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNDays) - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_TimeIntervalSet(AlarmInterval, d=1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNDay) - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_TimeIntervalSet(AlarmInterval, d=1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNMonths) - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNMonth) - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optMonthly) - call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeSet( NextAlarm, yy=cyy, mm=cmm, dd=1, s=0, calendar=cal, rc=rc ) - if (chkerr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .true. - - case (optNYears) - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNYear) - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optYearly) - call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeSet( NextAlarm, yy=cyy, mm=1, dd=1, s=0, calendar=cal, rc=rc ) - if (chkerr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .true. - - case default - call shr_sys_abort(subname//'unknown option '//trim(option)) - - end select - - ! -------------------------------------------------------------------------------- - ! --- AlarmInterval and NextAlarm should be set --- - ! -------------------------------------------------------------------------------- - - ! --- advance Next Alarm so it won't ring on first timestep for - ! --- most options above. go back one alarminterval just to be careful - - if (update_nextalarm) then - NextAlarm = NextAlarm - AlarmInterval - do while (NextAlarm <= CurrTime) - NextAlarm = NextAlarm + AlarmInterval - enddo - endif - alarm = ESMF_AlarmCreate( name=lalarmname, clock=clock, ringTime=NextAlarm, & - ringInterval=AlarmInterval, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - end subroutine alarmInit - -!=============================================================================== - - subroutine timeInit( Time, ymd, cal, tod, rc) - - ! Create the ESMF_Time object corresponding to the given input time, - ! given in YMD (Year Month Day) and TOD (Time-of-day) format. - ! Set the time by an integer as YYYYMMDD and integer seconds in the day - - ! input/output parameters: - type(ESMF_Time) , intent(inout) :: Time ! ESMF time - integer , intent(in) :: ymd ! year, month, day YYYYMMDD - type(ESMF_Calendar) , intent(in) :: cal ! ESMF calendar - integer , intent(in) :: tod ! time of day in seconds - integer , intent(out) :: rc - - ! local variables - integer :: year, mon, day ! year, month, day as integers - integer :: tdate ! temporary date - character(len=*), parameter :: subname='(timeInit)' - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - if ( (ymd < 0) .or. (tod < 0) .or. (tod > SecPerDay) )then - call shr_sys_abort( subname//'ERROR yymmdd is a negative number or time-of-day out of bounds' ) - end if - - tdate = abs(ymd) - year = int(tdate/10000) - if (ymd < 0) year = -year - mon = int( mod(tdate,10000)/ 100) - day = mod(tdate, 100) - - call ESMF_TimeSet( Time, yy=year, mm=mon, dd=day, s=tod, calendar=cal, rc=rc ) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - end subroutine timeInit - -!=============================================================================== - - logical function chkerr(rc, line, file) - - integer, intent(in) :: rc - integer, intent(in) :: line - character(len=*), intent(in) :: file - - integer :: lrc - - chkerr = .false. - lrc = rc - if (ESMF_LogFoundError(rcToCheck=lrc, msg=ESMF_LOGERR_PASSTHRU, line=line, file=file)) then - chkerr = .true. - endif - end function chkerr - -end module nuopc_shr_methods diff --git a/cime_config/buildnml b/cime_config/buildnml index bc8585d8c..40b726e09 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -43,6 +43,7 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): config["MACH"] = case.get_value("MACH") config["MPILIB"] = case.get_value("MPILIB") config["OS"] = case.get_value("OS") + config["TESTCASE"] = case.get_value("TESTCASE") config["glc_nec"] = ( 0 if case.get_value("GLC_NEC") == 0 else case.get_value("GLC_NEC") ) @@ -50,9 +51,13 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): config["continue_run"] = ".true." if case.get_value("CONTINUE_RUN") else ".false." config["flux_epbal"] = "ocn" if case.get_value("CPL_EPBAL") == "ocn" else "off" config["mask_grid"] = case.get_value("MASK_GRID") - config["rest_option"] = case.get_value("REST_OPTION") + for val in ("HIST", "REST", "STOP"): + config[val.lower()+"_option"] = case.get_value(val+"_OPTION") + + config["comp_ocn"] = case.get_value("COMP_OCN") + atm_grid = case.get_value("ATM_GRID") lnd_grid = case.get_value("LND_GRID") ice_grid = case.get_value("ICE_GRID") @@ -72,6 +77,8 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): atm_mesh = case.get_value("ATM_DOMAIN_MESH") lnd_mesh = case.get_value("LND_DOMAIN_MESH") rof_mesh = case.get_value("ROF_DOMAIN_MESH") + ocn_mesh = case.get_value("OCN_DOMAIN_MESH") + wav_mesh = case.get_value("WAV_DOMAIN_MESH") config["samegrid_atm_lnd"] = ( "true" if atm_mesh == case.get_value("LND_DOMAIN_MESH") else "false" ) @@ -85,6 +92,7 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): "true" if atm_mesh == case.get_value("WAV_DOMAIN_MESH") else "false" ) config["samegrid_lnd_rof"] = "true" if lnd_mesh == rof_mesh else "false" + config["samegrid_wav_ocn"] = "true" if ocn_mesh == wav_mesh else "false" # determine if need to set atm_domainfile scol_lon = float(case.get_value("PTS_LON")) @@ -98,7 +106,7 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): else: config["single_column"] = "false" - # needed for determining the run sequence as well as glc_renormalize_smb + # needed for determining the run sequence config["COMP_ATM"] = case.get_value("COMP_ATM") config["COMP_ICE"] = case.get_value("COMP_ICE") config["COMP_GLC"] = case.get_value("COMP_GLC") @@ -107,7 +115,7 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): config["COMP_ROF"] = case.get_value("COMP_ROF") config["COMP_WAV"] = case.get_value("COMP_WAV") config["CAMDEV"] = "True" if "CAM70" in case.get_value("COMPSET") else "False" - + if ( ( case.get_value("COMP_ROF") == "mosart" @@ -129,6 +137,12 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): config['wav_ice_coupling'] = 'ww3' in config['COMP_WAV'] and config['COMP_ICE'] == 'cice' + if config["COMP_OCN"] == "blom": + if "ecosys" in case.get_value("BLOM_TRACER_MODULES"): + config["dms_from_ocn"] = "on" + else: + config["dms_from_ocn"] = "off" + # ---------------------------------------------------- # Initialize namelist defaults # ---------------------------------------------------- @@ -150,7 +164,7 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): add_gusts = literal_to_python_value(nmlgen.get_value("add_gusts"), type_="logical") if add_gusts: 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 # -------------------------------- @@ -199,6 +213,19 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): coupling_times[comp.lower() + "_cpl_dt"] = cpl_dt mindt = min(mindt, cpl_dt) + # Here we convert "nsteps" to "nseconds", this simplifies the fortran + + for val in ("REST", "HIST", "STOP"): + if case.get_value(val+"_OPTION") == "nsteps": + nsteps = case.get_value(val+"_N") + if val == "REST": + nmlgen.set_value("restart_n", value=mindt*nsteps) + elif val == "HIST": + nmlgen.set_value("history_n", value=mindt*nsteps) + else: + nmlgen.set_value("stop_n", value=mindt*nsteps) + + # sanity check comp_atm = case.get_value("COMP_ATM") if comp_atm is not None and comp_atm not in ("datm", "xatm", "satm"): @@ -305,7 +332,7 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): for item in case.get_values("COMP_CLASSES"): comp = case.get_value("COMP_" + item) - if case.get_value(f"PIO_ASYNC_INTERFACE", {"compclass":item}): + if case.get_value("PIO_ASYNC_INTERFACE", {"compclass":item}): asyncio = True valid = True @@ -366,8 +393,6 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): nmlgen.set_value( "component_list", value=valid_comps_string.replace("CPL", "MED") ) - # the driver restart pointer will look like a mediator is present even if it is not - nmlgen.set_value("drv_restart_pointer", value="rpointer.cpl") logger.info("Writing nuopc_runconfig for components {}".format(valid_comps)) nuopc_config_file = os.path.join(confdir, "nuopc.runconfig") @@ -608,8 +633,6 @@ def buildnml(case, caseroot, component): if component != "drv": raise AttributeError - # Do a check here of ESMF VERSION, requires 8.1.0 or newer (8.2.0 or newer for esmf_aware_threading) - esmf_aware_threading = case.get_value("ESMF_AWARE_THREADING") esmfmkfile = os.getenv("ESMFMKFILE") expect( esmfmkfile and os.path.isfile(esmfmkfile), @@ -665,7 +688,7 @@ def buildnml(case, caseroot, component): create_namelist_infile(case, user_nl_file, namelist_infile, infile_text) infile = [namelist_infile] - + # create the files nuopc.runconfig, nuopc.runseq, drv_in and drv_flds_in _create_drv_namelists(case, infile, confdir, nmlgen, files) diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index 33add8b2b..8d5cb5dda 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -334,7 +334,7 @@ run_begin_stop_restart env_run.xml - Run start time-of-day + Run start time-of-day, units are seconds with values from 0 to 86400. @@ -402,6 +402,17 @@ + + char + rpointer.cpl + run_begin_stop_restart + env_run.xml + + Name of the restart pointer file, this can be used to restart from an + intermediate restart by appending the restart date and time in format YYYY-MM-DD-SSSSS + + + char none,never,nsteps,nseconds,nminutes,nhours,ndays,nmonths,nyears @@ -795,20 +806,38 @@ char - - + none,a100 + none build_def env_build.xml If set will compile and submit with this gpu type enabled - - char - - + + logical + TRUE,FALSE + FALSE + build_def + env_build.xml + True=>compile the GPU code with OpenACC GPU flags + + + + logical + TRUE,FALSE + FALSE + build_def + env_build.xml + True=>compile the GPU code with OpenMP GPU flags + + + + logical + TRUE,FALSE + FALSE build_def env_build.xml - If set will compile and submit with this gpu offload method enabled + True=>compile the GPU code with KOKKOS GPU target @@ -818,7 +847,7 @@ build_def env_build.xml If set will attach this script to the MPI run command, mapping - different MPI ranks to different GPUs within the same compute node + different MPI ranks to different GPUs within the same compute node @@ -1405,6 +1434,24 @@ rof2ocn runoff mapping file + + char + idmap + run_domain + env_run.xml + ocn2wav state mapping file + + + + char + + unset + + run_domain + env_run.xml + wav2ocn state mapping file + + char 1.0e-02 @@ -1753,36 +1800,55 @@ pes or cores per node for accounting purposes + + integer + 0 + mach_pes_last + env_mach_pes.xml + minimum memory request per node (currently only used on derecho) + + + + integer + 0 + mach_pes_last + env_mach_pes.xml + maximum memory request per node (currently only used on derecho) + + integer 0 - - 1 - mach_pes_last env_mach_pes.xml - Number of CPU cores per GPU node used for simulation + Number of CPU cores per GPU node used for simulation + + + + logical + TRUE,FALSE + FALSE + mach_pes + env_mach_pes.xml + False=>assign only one MPI task per GPU; True=>assign multiple MPI tasks per GPU integer 0 - - 1 - mach_pes env_mach_pes.xml - Number of GPUs per node used for simulation + Number of GPUs per node used for simulation - + integer 0 mach_pes_last env_mach_pes.xml - maximum number of GPUs allowed per node + Maximum number of GPUs allowed per node - + integer $MAX_MPITASKS_PER_NODE @@ -1986,15 +2052,15 @@ https://www.unidata.ucar.edu/software/netcdf/docs/data_type.html - 64bit_offset - 64bit_offset - 64bit_offset - 64bit_offset - 64bit_offset - 64bit_offset - 64bit_offset - 64bit_offset - 64bit_offset + 64bit_data + 64bit_data + 64bit_data + 64bit_data + 64bit_data + 64bit_data + 64bit_data + 64bit_data + 64bit_data @@ -2412,6 +2478,19 @@ + + + + + + char + + case_git + env_build.xml + Remote git repository used for this case + + + diff --git a/cime_config/config_component_cesm.xml b/cime_config/config_component_cesm.xml index 4dd12e1e4..b801f156e 100644 --- a/cime_config/config_component_cesm.xml +++ b/cime_config/config_component_cesm.xml @@ -109,8 +109,8 @@ none CO2A CO2A - CO2A - CO2A + CO2A + CO2A CO2A CO2A CO2C @@ -236,15 +236,12 @@ - 24 24 24 - 24 - 144 24 24 24 @@ -330,11 +327,6 @@ 24 24 - 1 - 24 - 24 - 48 - 48 1 24 @@ -386,7 +378,6 @@ integer 8 - 1 $ATM_NCPL $ATM_NCPL $ATM_NCPL @@ -475,11 +466,8 @@ TIGHT OPTION2 - OPTION2 OPTION1 OPTION1 - OPTION1 - OPTION1 OPTION2 OPTION2 OPTION2 @@ -537,10 +525,10 @@ FALSE TRUE - TRUE + TRUE TRUE TRUE - TRUE + TRUE TRUE TRUE @@ -555,8 +543,7 @@ 284.7 367.0 - 284.317 - 284.7 + 284.317 run_co2 env_run.xml diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 222a15b26..8835c53b8 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -162,7 +162,7 @@ - + char expdef DRIVER_attributes @@ -170,7 +170,7 @@ Driver restart pointer file to initialize time info - rpointer.cpl + $DRV_RESTART_POINTER @@ -233,20 +233,6 @@ - - - - - - logical - nuopc - ALLCOMP_attributes - - .false. - .true. - - - char nuopc @@ -256,6 +242,10 @@ + + + + char orbital @@ -843,32 +833,26 @@ char control MED_attributes - on,off,on_if_glc_coupled_fluxes + on,off Whether to renormalize the surface mass balance (smb) sent from lnd to glc so that the global integral on the glc grid agrees with the global integral on the lnd grid. - Unlike most fluxes, smb is remapped with bilinear rather than conservative mapping weights, - so this option is needed for conservation. However, conservation is not required in many - cases, since we often run glc as a diagnostic (one-way-coupled) component. + Unlike most fluxes, smb is remapped with bilinear rather than conservative mapping + weights, so this option is needed for conservation. However, this can be turned off + in non-fully-coupled configurations where conservation isn't important (e.g., + glc-only configurations - T compsets) to avoid the global correction that comes with + this renormalization. Allowable values are: - 'on': always do this renormalization - 'off': never do this renormalization (see WARNING below) - 'on_if_glc_coupled_fluxes': Determine at runtime whether to do this renormalization. - Does the renormalization if we're running a two-way-coupled glc that sends fluxes - to other components (which is the case where we need conservation). - Does NOT do the renormalization if we're running a one-way-coupled glc, or if - we're running a glc-only compset (T compsets). - (In these cases, conservation is not important.) + 'on': do this renormalization + 'off': do not do this renormalization; note that this will break conservation so + typically should not be used in fully-coupled cases - Only used if running with a prognostic GLC component. - - WARNING: Setting this to 'off' will break conservation when running with an - evolving, two-way-coupled glc. + Only used if running with a GLC component. - on_if_glc_coupled_fluxes + on off @@ -893,7 +877,7 @@ .false. - + integer @@ -929,7 +913,10 @@ default: ogrid - ogrid + xgrid + + ogrid @@ -1123,13 +1110,12 @@ char time ALLCOMP_attributes - none,never,nsteps,nseconds,nminutes,nhours,ndays,nmonths,nyears,monthly,yearly,date,end + none,never,nseconds,nminutes,nhours,ndays,nmonths,nyears,monthly,yearly,date,end mediator history snapshot option (used with history_n and history_ymd) set by HIST_OPTION in env_run.xml. history_option alarms are: [none/never], turns option off - [nsteps] , history snapshot every history_n nsteps , relative to current run start time [nseconds] , history snapshot every history_n nseconds, relative to current run start time [nminutes] , history snapshot every history_n nminutes, relative to current run start time [nhours] , history snapshot every history_n nhours , relative to current run start time @@ -1142,6 +1128,7 @@ $HIST_OPTION + nseconds @@ -2303,6 +2290,34 @@ + + char + mapping + abs + MED_attributes + + ocn to wav state mapping file for states + + + idmap + $OCN2WAV_SMAPNAME + + + + + char + mapping + abs + MED_attributes + + wav to ocn state mapping file for states + + + idmap + $WAV2OCN_SMAPNAME + + + @@ -2426,7 +2441,7 @@ - + logical flds ALLCOMP_attributes @@ -2435,10 +2450,11 @@ .false. + .true. - + logical flds ALLCOMP_attributes @@ -2726,12 +2742,11 @@ char time CLOCK_attributes - none,never,nsteps,nseconds,nminutes,nhours,ndays,monthly,nmonths,nyears,date,end + none,never,nseconds,nminutes,nhours,ndays,monthly,nmonths,nyears,date,end sets the run length with stop_n and stop_ymd stop_option alarms are: [none/never] , turns option off - [nsteps] , stops every stop_n nsteps , relative to current run start time [nseconds] , stops every stop_n nseconds, relative to current run start time [nminutes] , stops every stop_n nminutes, relative to current run start time [nhours] , stops every stop_n nhours , relative to current run start time @@ -2745,6 +2760,7 @@ $STOP_OPTION + nseconds @@ -2790,12 +2806,11 @@ char time CLOCK_attributes - none,never,nsteps,nseconds,nminutes,nhours,ndays,nmonths,nyears,monthly,yearly,date,end + none,never,nseconds,nminutes,nhours,ndays,nmonths,nyears,monthly,yearly,date,end sets the restart frequency with restart_n and restart_ymd restart_option alarms are: [none/never], turns option off - [nsteps] , restarts every restart_n nsteps , relative to current run start time [nseconds] , restarts every restart_n nseconds, relative to current run start time [nminutes] , restarts every restart_n nminutes, relative to current run start time [nhours] , restarts every restart_n nhours , relative to current run start time @@ -2809,6 +2824,7 @@ $REST_OPTION + nseconds @@ -2837,7 +2853,7 @@ - + logical time CLOCK_attributes @@ -2846,10 +2862,15 @@ forces a restart write at the end of the run in addition to any setting associated with rest_option. default=true. this setting will be set to false if restart_option is none or never. - default: false + default: true - .false. + .true. + .false. + .false. + .false. + .false. + .false. diff --git a/cime_config/runseq/driver_config.py b/cime_config/runseq/driver_config.py index 7b8756e10..dfdadc75f 100644 --- a/cime_config/runseq/driver_config.py +++ b/cime_config/runseq/driver_config.py @@ -64,7 +64,7 @@ def __compute_glc(self, case, coupling_times): # However will still need to call the exchange at the end if the stop_option # is nsteps or days - or otherwise just every ndays # Note that nsteps is the minimum component coupling time - if (comp_glc == 'cism'): + if comp_glc == 'cism': glc_coupling_time = coupling_times["glc_cpl_dt"] if not case.get_value("CISM_EVOLVE"): stop_option = case.get_value('STOP_OPTION') @@ -77,13 +77,7 @@ def __compute_glc(self, case, coupling_times): glc_coupling_time = stop_n * 86400 else: glc_coupling_time = 86400 - elif (comp_glc == 'dglc'): - glc_coupling_time = coupling_times["glc_cpl_dt"] - stop_option = case.get_value('STOP_OPTION') - stop_n = case.get_value('STOP_N') - if stop_option == 'nsteps': - glc_coupling_time = stop_n*coupling_times["atm_cpl_dt"] - elif (comp_glc == 'xglc'): + elif comp_glc == 'dglc' or comp_glc == 'xglc': glc_coupling_time = coupling_times["glc_cpl_dt"] else: glc_coupling_time = 0 diff --git a/cime_config/testdefs/testlist_drv.xml b/cime_config/testdefs/testlist_drv.xml index e17b2ffcf..948bd267b 100644 --- a/cime_config/testdefs/testlist_drv.xml +++ b/cime_config/testdefs/testlist_drv.xml @@ -65,6 +65,16 @@ + + + + + + + + + + diff --git a/cime_config/testdefs/testmods_dirs/drv/aoflux_ogrid/user_nl_cpl b/cime_config/testdefs/testmods_dirs/drv/aoflux_ogrid/user_nl_cpl new file mode 100644 index 000000000..91228d3fe --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/drv/aoflux_ogrid/user_nl_cpl @@ -0,0 +1 @@ +aoflux_grid = "ogrid" diff --git a/doc/source/addendum/req_attributes_cesm.rst b/doc/source/addendum/req_attributes_cesm.rst index c8d6ff7fa..475b845f7 100644 --- a/doc/source/addendum/req_attributes_cesm.rst +++ b/doc/source/addendum/req_attributes_cesm.rst @@ -101,24 +101,19 @@ Mediator land-ice component attribtes Whether to renormalize the surface mass balance (smb) sent from lnd to glc so that the global integral on the glc grid agrees with the global integral on the lnd grid. - Unlike most fluxes, smb is remapped with bilinear rather than conservative mapping weights, - so this option is needed for conservation. However, conservation is not required in many - cases, since we often run glc as a diagnostic (one-way-coupled) component. + Unlike most fluxes, smb is remapped with bilinear rather than conservative mapping + weights, so this option is needed for conservation. However, this can be turned off in + non-fully-coupled configurations where conservation isn't important (e.g., glc-only + configurations - T compsets) to avoid the global correction that comes with this + renormalization. Allowable values are: - ``on``: always do this renormalization - - ``off``: never do this renormalization (see WARNING below) - - ``on_if_glc_coupled_fluxes``: Determine at runtime whether to do this renormalization. - Does the renormalization if we're running a two-way-coupled glc that sends fluxes - to other components (which is the case where we need conservation). - Does NOT do the renormalization if we're running a one-way-coupled glc, or if - we're running a glc-only compset (T compsets). - (In these cases, conservation is not important.) - Only used if running with a prognostic GLC component. - WARNING: Setting this to 'off' will break conservation when running with an - evolving, two-way-coupled glc. + ``on``: do this renormalization + + ``off``: do not do this renormalization; note that this will break conservation so + typically should not be used in fully-coupled cases + + Only used if running with a GLC component. **glc_avg_period** Period at which coupler averages fields sent to GLC (the land-ice component). diff --git a/mediator/CMakeLists.txt b/mediator/CMakeLists.txt index 9630b5e23..80be3d2e8 100644 --- a/mediator/CMakeLists.txt +++ b/mediator/CMakeLists.txt @@ -4,7 +4,7 @@ set(SRCFILES esmFldsExchange_cesm_mod.F90 med_fraction_mod.F90 med_methods_mod.F90 med_phases_prep_ice_mod.F90 med_phases_restart_mod.F90 esmFldsExchange_hafs_mod.F90 med_internalstate_mod.F90 med_phases_aofluxes_mod.F90 - med_phases_prep_lnd_mod.F90 med_time_mod.F90 + med_phases_prep_lnd_mod.F90 esmFldsExchange_ufs_mod.F90 med_io_mod.F90 med_phases_history_mod.F90 med_phases_prep_ocn_mod.F90 med_utils_mod.F90 esmFlds.F90 med_kind_mod.F90 diff --git a/mediator/Makefile b/mediator/Makefile index 990fe58eb..a353ff9a5 100644 --- a/mediator/Makefile +++ b/mediator/Makefile @@ -39,7 +39,7 @@ esmFldsExchange_hafs_mod.o : med_kind_mod.o med_methods_mod.o esmFlds.o med_inte med.o : med_kind_mod.o med_phases_profile_mod.o med_utils_mod.o med_phases_prep_rof_mod.o med_phases_aofluxes_mod.o \ med_phases_prep_ice_mod.o med_fraction_mod.o med_map_mod.o med_constants_mod.o med_phases_prep_wav_mod.o \ med_phases_prep_lnd_mod.o med_phases_history_mod.o med_phases_ocnalb_mod.o med_phases_restart_mod.o \ - med_time_mod.o med_internalstate_mod.o med_phases_prep_atm_mod.o esmFldsExchange_cesm_mod.o esmFldsExchange_ufs_mod.o \ + med_internalstate_mod.o med_phases_prep_atm_mod.o esmFldsExchange_cesm_mod.o esmFldsExchange_ufs_mod.o \ esmFldsExchange_hafs_mod.o med_phases_prep_glc_mod.o esmFlds.o med_io_mod.o med_methods_mod.o med_phases_prep_ocn_mod.o \ med_phases_post_atm_mod.o med_phases_post_ice_mod.o med_phases_post_lnd_mod.o med_phases_post_glc_mod.o med_phases_post_rof_mod.o \ med_phases_post_wav_mod.o @@ -50,7 +50,7 @@ med_map_mod.o : med_kind_mod.o med_internalstate_mod.o med_constants_mod.o med_m med_merge_mod.o : med_kind_mod.o med_constants_mod.o med_internalstate_mod.o esmFlds.o med_methods_mod.o med_utils_mod.o med_methods_mod.o : med_kind_mod.o med_utils_mod.o med_constants_mod.o med_phases_aofluxes_mod.o : med_kind_mod.o med_utils_mod.o med_map_mod.o med_constants_mod.o med_internalstate_mod.o esmFlds.o med_methods_mod.o -med_phases_history_mod.o : med_kind_mod.o med_utils_mod.o med_time_mod.o med_internalstate_mod.o med_constants_mod.o med_map_mod.o med_methods_mod.o med_io_mod.o esmFlds.o +med_phases_history_mod.o : med_kind_mod.o med_utils_mod.o med_internalstate_mod.o med_constants_mod.o med_map_mod.o med_methods_mod.o med_io_mod.o esmFlds.o med_phases_ocnalb_mod.o : med_kind_mod.o med_utils_mod.o med_map_mod.o med_constants_mod.o med_internalstate_mod.o esmFlds.o med_methods_mod.o med_phases_prep_atm_mod.o : med_kind_mod.o esmFlds.o med_methods_mod.o med_merge_mod.o med_map_mod.o med_constants_mod.o med_phases_ocnalb_mod.o med_internalstate_mod.o med_utils_mod.o med_phases_prep_glc_mod.o : med_kind_mod.o med_utils_mod.o med_internalstate_mod.o med_map_mod.o med_constants_mod.o med_methods_mod.o esmFlds.o @@ -68,6 +68,5 @@ med_phases_post_rof_mod.o : med_kind_mod.o esmFlds.o med_methods_mod.o med_map_m med_phases_post_wav_mod.o : med_kind_mod.o esmFlds.o med_methods_mod.o med_map_mod.o med_constants_mod.o med_internalstate_mod.o med_utils_mod.o med_phases_profile_mod.o : med_kind_mod.o med_utils_mod.o med_constants_mod.o med_internalstate_mod.o med_time_mod.o med_phases_restart_mod.o : med_kind_mod.o med_utils_mod.o med_constants_mod.o med_internalstate_mod.o esmFlds.o med_io_mod.o -med_time_mod.o : med_kind_mod.o med_utils_mod.o med_constants_mod.o med_utils_mod.o : med_kind_mod.o -med_diag_mod.o : med_kind_mod.o med_time_mod.o med_utils_mod.o med_methods_mod.o med_internalstate_mod.o +med_diag_mod.o : med_kind_mod.o med_utils_mod.o med_methods_mod.o med_internalstate_mod.o diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index a521deaa1..b3b305668 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -75,6 +75,10 @@ module esmFldsExchange_cesm_mod character(len=CX) :: rof2lnd_map = 'unset' character(len=CX) :: lnd2rof_map = 'unset' + ! optional mapping files + character(len=CX) :: wav2ocn_map ='unset' + character(len=CX) :: ocn2wav_map = 'unset' + ! no mapping files (value is 'idmap' or 'unset') character(len=CX) :: atm2ice_map = 'unset' character(len=CX) :: atm2ocn_map = 'unset' @@ -84,9 +88,7 @@ module esmFldsExchange_cesm_mod 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 @@ -95,6 +97,7 @@ module esmFldsExchange_cesm_mod logical :: flds_co2c ! Pass CO2 from ATM to surface (OCN/LND) and back from them to ATM logical :: flds_wiso ! Pass water isotop fields logical :: flds_r2l_stream_channel_depths ! Pass channel depths from ROF to LND + logical :: add_gusts ! Whether to include fields related to the gustiness parameterization character(*), parameter :: u_FILE_u = & __FILE__ @@ -202,6 +205,14 @@ 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) + call NUOPC_CompAttributeGet(gcomp, name='wav2ocn_smapname', value=wav2ocn_map, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (maintask) write(logunit, '(a)') trim(subname)//'wav2ocn_smapname = '// trim(wav2ocn_map) + call NUOPC_CompAttributeGet(gcomp, name='ocn2wav_smapname', value=ocn2wav_map, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (maintask) write(logunit, '(a)') trim(subname)//'ocn2wav_smapname = '// trim(ocn2wav_map) + + ! uv cart3d mapping call NUOPC_CompAttributeGet(gcomp, name='mapuv_with_cart3d', value=cvalue, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -232,6 +243,11 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) flds_r2l_stream_channel_depths + ! are fields related to the gustiness parameterization enabled? + call NUOPC_CompAttributeGet(gcomp, name='add_gusts', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) add_gusts + ! 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' @@ -246,6 +262,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) write(logunit,'(a,l7)') trim(subname)//' flds_wiso = ',flds_wiso write(logunit,'(a,l7)') trim(subname)//' flds_i2o_per_cat = ',flds_i2o_per_cat write(logunit,'(a,l7)') trim(subname)//' flds_r2l_stream_channel_depths = ',flds_r2l_stream_channel_depths + write(logunit,'(a,l7)') trim(subname)//' add_gusts = ', add_gusts write(logunit,'(a,l7)') trim(subname)//' mapuv_with_cart3d = ',mapuv_with_cart3d end if @@ -1414,17 +1431,19 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! --------------------------------------------------------------------- ! to atm: unmerged ugust_out from ocn ! --------------------------------------------------------------------- - if (phase == 'advertise') then - call addfld_aoflux('So_ugustOut') - call addfld_to(compatm, 'So_ugustOut') - else - if ( fldchk(is_local%wrap%FBexp(compatm), 'So_ugustOut', rc=rc)) then - if (fldchk(is_local%wrap%FBMed_aoflux_o, 'So_ugustOut', rc=rc)) then - if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - call addmap_aoflux('So_ugustOut', compatm, mapconsf, 'ofrac', ocn2atm_map) + if (add_gusts) then + if (phase == 'advertise') then + call addfld_aoflux('So_ugustOut') + call addfld_to(compatm, 'So_ugustOut') + else + if ( fldchk(is_local%wrap%FBexp(compatm), 'So_ugustOut', rc=rc)) then + if (fldchk(is_local%wrap%FBMed_aoflux_o, 'So_ugustOut', rc=rc)) then + if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then + call addmap_aoflux('So_ugustOut', compatm, mapconsf, 'ofrac', ocn2atm_map) + end if + call addmrg_to(compatm , 'So_ugustOut', & + mrg_from=compmed, mrg_fld='So_ugustOut', mrg_type='merge', mrg_fracname='ofrac') end if - call addmrg_to(compatm , 'So_ugustOut', & - mrg_from=compmed, mrg_fld='So_ugustOut', mrg_type='merge', mrg_fracname='ofrac') end if end if end if @@ -1432,17 +1451,19 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! --------------------------------------------------------------------- ! to atm: 10 m winds including/excluding gust component ! --------------------------------------------------------------------- - if (phase == 'advertise') then - call addfld_aoflux('So_u10withGust') - call addfld_to(compatm, 'So_u10withGust') - else - if ( fldchk(is_local%wrap%FBexp(compatm), 'So_u10withGust', rc=rc)) then - if (fldchk(is_local%wrap%FBMed_aoflux_o, 'So_u10withGust', rc=rc)) then - if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - call addmap_aoflux('So_u10withGust', compatm, mapconsf, 'ofrac', ocn2atm_map) + if (add_gusts) then + if (phase == 'advertise') then + call addfld_aoflux('So_u10withGust') + call addfld_to(compatm, 'So_u10withGust') + else + if ( fldchk(is_local%wrap%FBexp(compatm), 'So_u10withGust', rc=rc)) then + if (fldchk(is_local%wrap%FBMed_aoflux_o, 'So_u10withGust', rc=rc)) then + if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then + call addmap_aoflux('So_u10withGust', compatm, mapconsf, 'ofrac', ocn2atm_map) + end if + call addmrg_to(compatm , 'So_u10withGust', & + mrg_from=compmed, mrg_fld='So_u10withGust', mrg_type='merge', mrg_fracname='ofrac') end if - call addmrg_to(compatm , 'So_u10withGust', & - mrg_from=compmed, mrg_fld='So_u10withGust', mrg_type='merge', mrg_fracname='ofrac') end if end if end if @@ -1700,7 +1721,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) 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) + call addmap_from(compocn, 'Faoo_fdms_ocn', compatm, mapconsd, 'one', ocn2atm_map) ! custom merge in med_phases_prep_atm end if end if @@ -1714,7 +1735,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) 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) + call addmap_from(compocn, 'Faoo_fbrf_ocn', compatm, mapconsd, 'one', ocn2atm_map) ! custom merge in med_phases_prep_atm end if end if @@ -1728,7 +1749,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) 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) + call addmap_from(compocn, 'Faoo_fn2o_ocn', compatm, mapconsd, 'one', ocn2atm_map) ! custom merge in med_phases_prep_atm end if end if @@ -1742,7 +1763,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) 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) + call addmap_from(compocn, 'Faoo_fnh3_ocn', compatm, mapconsd, 'one', ocn2atm_map) ! custom merge in med_phases_prep_atm end if end if @@ -3012,23 +3033,21 @@ 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_map) + call addmap_from(compice, 'Si_ifrac', compwav, mapbilnr_nstod, 'one', ice2wav_map) call addmrg_to(compwav, 'Si_ifrac', mrg_from=compice, mrg_fld='Si_ifrac', mrg_type='copy') end if end if !---------------------------------------------------------- ! to wav: ice thickness from ice !---------------------------------------------------------- - if (wav_coupling_to_cice) then - if (phase == 'advertise') then - call addfld_from(compice, 'Si_thick') - call addfld_to(compwav, 'Si_thick') - else - if (fldchk(is_local%wrap%FBexp(compwav) , 'Si_thick', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_thick', rc=rc)) then - call addmap_from(compice, 'Si_thick', compwav, mapbilnr, 'one', ice2wav_map) - call addmrg_to(compwav, 'Si_thick', mrg_from=compice, mrg_fld='Si_thick', mrg_type='copy') - end if + if (phase == 'advertise') then + call addfld_from(compice, 'Si_thick') + call addfld_to(compwav, 'Si_thick') + else + if ( fldchk(is_local%wrap%FBexp(compwav) , 'Si_thick', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_thick', rc=rc)) then + call addmap_from(compice, 'Si_thick', compwav, mapbilnr_nstod, 'one', ice2wav_map) + call addmrg_to(compwav, 'Si_thick', mrg_from=compice, mrg_fld='Si_thick', mrg_type='copy') end if end if !---------------------------------------------------------- @@ -3041,7 +3060,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_map) + call addmap_from(compice, 'Si_floediam', compwav, mapbilnr_nstod, 'one', ice2wav_map) call addmrg_to(compwav, 'Si_floediam', mrg_from=compice, mrg_fld='Si_floediam', mrg_type='copy') end if end if diff --git a/mediator/med.F90 b/mediator/med.F90 index 3133c7f88..89cc2f917 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -38,12 +38,11 @@ module MED use med_methods_mod , only : FB_getFieldN => med_methods_FB_getFieldN use med_methods_mod , only : clock_timeprint => med_methods_clock_timeprint use med_utils_mod , only : memcheck => med_memcheck - use med_time_mod , only : med_time_alarmInit use med_internalstate_mod , only : InternalState, med_internalstate_init, med_internalstate_coupling use med_internalstate_mod , only : med_internalstate_defaultmasks, logunit, maintask use med_internalstate_mod , only : ncomps, compname use med_internalstate_mod , only : compmed, compatm, compocn, compice, complnd, comprof, compwav, compglc - use med_internalstate_mod , only : coupling_mode, aoflux_code, aoflux_ccpp_suite + use med_internalstate_mod , only : coupling_mode, aoflux_code, aoflux_ccpp_suite, write_dststatus use esmFlds , only : med_fldList_GetocnalbfldList, med_fldList_type use esmFlds , only : med_fldList_GetNumFlds, med_fldList_GetFldNames, med_fldList_GetFldInfo use esmFlds , only : med_fldList_Document_Mapping, med_fldList_Document_Merging @@ -59,14 +58,15 @@ module MED public SetServices public SetVM private InitializeP0 - private AdvertiseFields ! advertise fields + private AdvertiseFields ! advertise fields private RealizeFieldsWithTransferProvided ! realize connected Fields with transfer action "provide" - private ModifyDecompofMesh ! optionally modify the decomp/distr of transferred Grid/Mesh - private RealizeFieldsWithTransferAccept ! realize all Fields with transfer action "accept" - private DataInitialize ! finish initialization and resolve data dependencies + private ModifyDecompofMesh ! optionally modify the decomp/distr of transferred Grid/Mesh + private RealizeFieldsWithTransferAccept ! realize all Fields with transfer action "accept" + private DataInitialize ! finish initialization and resolve data dependencies private SetRunClock private med_meshinfo_create private med_grid_write + private med_dststatus_write private med_finalize character(len=*), parameter :: u_FILE_u = & @@ -2178,6 +2178,14 @@ subroutine DataInitialize(gcomp, rc) call med_diag_zero(mode='all', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + !--------------------------------------- + ! write dstStatus fields if requested + !--------------------------------------- + if (write_dststatus) then + call med_dststatus_write(gcomp, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + !--------------------------------------- ! read mediator restarts !--------------------------------------- @@ -2261,7 +2269,9 @@ subroutine SetRunClock(gcomp, rc) use ESMF , only : ESMF_ClockGetAlarmList use NUOPC , only : NUOPC_CompCheckSetClock, NUOPC_CompAttributeGet use NUOPC_Mediator , only : NUOPC_MediatorGet - + ! NUOPC_shr_methods is now in cesm_share and cdeps + use nuopc_shr_methods, only : AlarmInit + ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc @@ -2318,7 +2328,7 @@ subroutine SetRunClock(gcomp, rc) call NUOPC_CompAttributeGet(gcomp, name="stop_ymd", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) stop_ymd - call med_time_alarmInit(mclock, stop_alarm, stop_option, opt_n=stop_n, opt_ymd=stop_ymd, & + call AlarmInit(mclock, stop_alarm, stop_option, opt_n=stop_n, opt_ymd=stop_ymd, & alarmname='alarm_stop', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return stopalarmcreated = .true. @@ -2562,6 +2572,132 @@ subroutine med_grid_write(grid, fileName, rc) end subroutine med_grid_write + !----------------------------------------------------------------------------- + subroutine med_dststatus_write (gcomp, rc) + + use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_SUCCESS, ESMF_VM + use ESMF , only : ESMF_FieldBundleIsCreated, ESMF_FieldBundleDestroy + use ESMF , only : ESMF_FieldBundleAdd, ESMF_Array, ESMF_Field, ESMF_MeshGet + use ESMF , only : ESMF_FieldGet, ESMF_FieldCreate, ESMF_FieldDestroy + use ESMF , only : ESMF_Mesh, ESMF_MESHLOC_ELEMENT, ESMF_TYPEKIND_R8, ESMF_TYPEKIND_I4 + use ESMF , only : ESMF_LOGMSG_INFO, ESMF_LogWrite + use NUOPC , only : NUOPC_CompAttributeGet + use med_kind_mod , only : I4=>SHR_KIND_I4, R8=>SHR_KIND_R8 + use med_internalstate_mod , only : ncomps, compname + use med_io_mod , only : med_io_write, med_io_wopen, med_io_enddef, med_io_close + use pio , only : file_desc_t + use med_methods_mod , only : med_methods_FB_getFieldN + + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(file_desc_t) :: io_file + type(InternalState) :: is_local + type(ESMF_VM) :: vm + type(ESMF_Mesh) :: mesh_dst + type(ESMF_Field) :: flddst, lfield + type(ESMF_Field) :: maskfield + type(ESMF_Array) :: maskarray + integer(I4), pointer :: meshmask(:) + real(R8), pointer :: r8ptr(:) + integer :: m,n1,n2 + character(CL) :: case_name, dststatusfile + logical :: elementMaskIsPresent + logical :: whead(2) = (/.true. , .false./) + logical :: wdata(2) = (/.false., .true. /) + character(len=*), parameter :: subname = '('//__FILE__//':med_dststatus_write)' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + ! Get the internal state + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Create dststatus file + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(gcomp, name='case_name', value=case_name, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + dststatusfile = trim(case_name)//'.dststatus.nc' + + ! add mesh masks for any destination component in the dststatusFB + do n2 = 2,ncomps + if (is_local%wrap%comp_present(n2)) then + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBdststatus(n2),rc=rc)) then + call med_methods_FB_getFieldN(is_local%wrap%FBdststatus(n2), 1, flddst, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(flddst, mesh=mesh_dst, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_MeshGet(mesh_dst, elementMaskIsPresent=elementMaskIsPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (elementMaskIsPresent) then + maskfield = ESMF_FieldCreate(mesh_dst, ESMF_TYPEKIND_I4, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! get mask Array + call ESMF_FieldGet(maskfield, array=maskarray, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_MeshGet(mesh_dst, elemMaskArray=maskarray, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(maskfield, localDe=0, farrayPtr=meshmask, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! now create an R8 mask for writing + lfield = ESMF_FieldCreate(mesh_dst, ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, & + name=trim(compname(n2))//'mask', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayPtr=r8ptr, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + r8ptr = real(meshmask,R8) + call ESMF_FieldBundleAdd(is_local%wrap%FBdststatus(n2), (/lfield/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldDestroy(maskfield, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end if + end if + end do + + ! write the FB + call med_io_wopen(trim(dststatusfile), io_file, vm, rc, clobber=.true.) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Loop over whead/wdata phases + do m = 1,2 + if (m == 2) then + call med_io_enddef(io_file) + end if + + ! write dststatusfields for each dst component + do n2 = 2,ncomps + if (is_local%wrap%comp_present(n2)) then + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBdststatus(n2),rc=rc)) then + call med_io_write(io_file, is_local%wrap%FBdststatus(n2), whead(m), wdata(m), & + is_local%wrap%nx(n2), is_local%wrap%ny(n2), pre='dst'//trim(compname(n2)), & + use_float=.true., ntile=is_local%wrap%ntile(n2), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + end if + end do + end do ! do m = 1,2 + ! Close file + call med_io_close(io_file, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Destroy the dststatus FBs + do n2 = 2,ncomps + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBdststatus(n2),rc=rc)) then + call ESMF_FieldBundleDestroy(is_local%wrap%FBdststatus(n2), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + end do + + end subroutine med_dststatus_write + !----------------------------------------------------------------------------- subroutine med_finalize(gcomp, rc) diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index 8bad9d5c8..bb0139ccb 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -31,7 +31,6 @@ module med_diag_mod use med_methods_mod , only : fldbun_getdata2d => med_methods_FB_getdata2d use med_methods_mod , only : fldbun_getdata1d => med_methods_FB_getdata1d use med_methods_mod , only : fldbun_fldChk => med_methods_FB_FldChk - use med_time_mod , only : alarmInit => med_time_alarmInit use med_utils_mod , only : chkerr => med_utils_ChkErr use perf_mod , only : t_startf, t_stopf @@ -150,8 +149,6 @@ module med_diag_mod integer :: f_heat_cond = unset_index ! heat : heat content of evaporation integer :: f_heat_rofl = unset_index ! heat : heat content of liquid runoff integer :: f_heat_rofi = unset_index ! heat : heat content of ice runoff - integer :: f_heat_rofl_glc = unset_index ! heat : heat content of liquid glc runoff - integer :: f_heat_rofi_glc = unset_index ! heat : heat content of ice glc runoff integer :: f_watr_frz = unset_index ! water: freezing integer :: f_watr_melt = unset_index ! water: melting @@ -332,16 +329,14 @@ subroutine med_diag_init(gcomp, rc) f_heat_beg = f_heat_frz ! field first index for heat f_heat_end = f_heat_sen ! field last index for heat else if (trim(budget_table_version) == 'v1') then - call add_to_budget_diag(budget_diags%fields, f_heat_rain ,'hrain' ) ! field heat : enthalpy of rain - call add_to_budget_diag(budget_diags%fields, f_heat_snow ,'hsnow' ) ! field heat : enthalpy of snow - call add_to_budget_diag(budget_diags%fields, f_heat_evap ,'hevap' ) ! field heat : enthalpy of evaporation - call add_to_budget_diag(budget_diags%fields, f_heat_cond ,'hcond' ) ! field heat : enthalpy of evaporation - call add_to_budget_diag(budget_diags%fields, f_heat_rofl ,'hrofl' ) ! field heat : enthalpy of liquid runoff - call add_to_budget_diag(budget_diags%fields, f_heat_rofi ,'hrofi' ) ! field heat : enthalpy of ice runoff - call add_to_budget_diag(budget_diags%fields, f_heat_rofl_glc,'hrofl_glc' ) ! field heat : enthalpy of liquid glc runoff - call add_to_budget_diag(budget_diags%fields, f_heat_rofi_glc,'hrofi_glc' ) ! field heat : enthalpy of ice glc runoff + call add_to_budget_diag(budget_diags%fields, f_heat_rain ,'hrain' ) ! field heat : enthalpy of rain + call add_to_budget_diag(budget_diags%fields, f_heat_snow ,'hsnow' ) ! field heat : enthalpy of snow + call add_to_budget_diag(budget_diags%fields, f_heat_evap ,'hevap' ) ! field heat : enthalpy of evaporation + call add_to_budget_diag(budget_diags%fields, f_heat_cond ,'hcond' ) ! field heat : enthalpy of evaporation + call add_to_budget_diag(budget_diags%fields, f_heat_rofl ,'hrofl' ) ! field heat : enthalpy of liquid runoff + call add_to_budget_diag(budget_diags%fields, f_heat_rofi ,'hrofi' ) ! field heat : enthalpy of ice runoff f_heat_beg = f_heat_frz ! field first index for heat - f_heat_end = f_heat_rofi_glc ! field last index for heat + f_heat_end = f_heat_rofi ! field last index for heat end if ! ----------------------------------------- @@ -1208,7 +1203,7 @@ subroutine med_phases_diag_rof( gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if ( fldbun_fldchk(is_local%wrap%FBImp(comprof,comprof), 'Forr_rofl_glc', rc=rc)) then - call diag_rof(is_local%wrap%FBImp(comprof,comprof), 'Forr_rofi_glc' , f_watr_roff, ic, areas, budget_local, minus=.true., rc=rc) + call diag_rof(is_local%wrap%FBImp(comprof,comprof), 'Forr_rofl_glc' , f_watr_roff, ic, areas, budget_local, minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if if ( fldbun_fldchk(is_local%wrap%FBImp(comprof,comprof), 'Forr_rofi_glc', rc=rc)) then @@ -1365,12 +1360,10 @@ subroutine med_phases_diag_glc( gcomp, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - !------------------------------- ! from glc to mediator !------------------------------- - ! TODO: this will not be correct if there is more than 1 ice sheet ic = c_glc_recv ip = period_inst @@ -1605,10 +1598,6 @@ subroutine med_phases_diag_ocn( gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hrofi', f_heat_rofi , ic, areas, sfrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hrofl_glc', f_heat_rofl_glc, ic, areas, sfrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hrofi_glc', f_heat_rofi_glc , ic, areas, sfrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return 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 @@ -2127,8 +2116,6 @@ subroutine med_phases_diag_print(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (ESMF_AlarmIsRinging(stop_alarm, rc=rc)) then output_level = max(output_level, budget_print_ltend) - call ESMF_AlarmRingerOff( stop_alarm, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return endif endif diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index d09903be5..6f7c49f73 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -106,7 +106,7 @@ module med_internalstate_mod type(ESMF_Field) :: field_fracdst end type packed_data_type - logical, public :: dststatus_print = .false. + logical, public :: write_dststatus = .false. ! Mesh info type, public :: mesh_info_type @@ -189,6 +189,8 @@ module med_internalstate_mod ! Data type(ESMF_FieldBundle) , pointer :: FBData(:) ! Background data for various components, on their grid, provided by CDEPS inline + ! DstStatus + type(ESMF_FieldBundle) , pointer :: FBDstStatus(:) ! DstStatus fields for components for each source component and maptype ! Accumulators for export field bundles type(ESMF_FieldBundle) :: FBExpAccumOcn ! Accumulator for Ocn export on Ocn grid @@ -429,12 +431,15 @@ subroutine med_internalstate_init(gcomp, rc) write(logunit,*) end if - ! Obtain dststatus_print setting if present - call NUOPC_CompAttributeGet(gcomp, name='dststatus_print', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + ! Allocate dststatus FB if needed + call NUOPC_CompAttributeGet(gcomp, name='write_dststatus', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) dststatus_print=(trim(cvalue) == "true") - write(msgString,*) trim(subname)//': Mediator dststatus_print is ',dststatus_print + if (isPresent .and. isSet) write_dststatus=(trim(cvalue) == "true") + write(msgString,*) trim(subname)//': Mediator write_dststatus is ',write_dststatus call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + if (write_dststatus) then + allocate(is_local%wrap%FBDstStatus(ncomps)) + end if ! Initialize flag for background fill using data is_local%wrap%med_data_active(:,:) = .false. diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 3d888bcfa..6282ddc3e 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -78,14 +78,15 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_LogFlush use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_Field use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet, ESMF_FieldBundleCreate - use ESMF , only : ESMF_FieldBundleIsCreated + use ESMF , only : ESMF_FieldBundleIsCreated, ESMF_FieldBundleAdd use ESMF , only : ESMF_Field, ESMF_FieldGet, ESMF_FieldCreate, ESMF_FieldDestroy use ESMF , only : ESMF_Mesh, ESMF_TYPEKIND_R8, ESMF_MESHLOC_ELEMENT + use ESMF , only : ESMF_TYPEKIND_I4, ESMF_FieldIsCreated use med_methods_mod , only : med_methods_FB_getFieldN, med_methods_FB_getNameN use med_constants_mod , only : czero => med_constants_czero use esmFlds , only : med_fldList_GetfldListFr, med_fldlist_type use esmFlds , only : med_fld_GetFldInfo, med_fldList_entry_type - use med_internalstate_mod , only : mapunset, compname + use med_internalstate_mod , only : mapunset, compname, write_dststatus use med_internalstate_mod , only : ncomps, nmappers, compname, mapnames, mapfcopy ! input/output variables @@ -98,6 +99,7 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun type(InternalState) :: is_local type(ESMF_Field) :: fldsrc type(ESMF_Field) :: flddst + type(ESMF_Field) :: dstatfield integer :: n1,n2 integer :: nf integer :: fieldCount @@ -155,9 +157,10 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun else call med_methods_FB_getFieldN(is_local%wrap%FBImp(n1,n2), 1, flddst, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - end if + end if + - ! Loop over fields + ! Loop over fields fldListFr => med_fldList_getFldListFr(n1) fldptr => fldListFr%fields nf = 0 @@ -169,21 +172,31 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun ! determine if route handle has already been created mapexists = med_map_RH_is_created(is_local%wrap%RH,n1,n2,mapindex,rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ! Create route handle for target mapindex if route handle is required ! (i.e. mapindex /= mapunset) and route handle has not already been created if (.not. mapexists) then call med_fld_GetFldInfo(fldptr, compsrc=n2, mapfile=mapfile) call med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, & - mapindex, is_local%wrap%rh(n1,n2,:), mapfile=trim(mapfile), rc=rc) + mapindex, is_local%wrap%rh(n1,n2,:), mapfile=trim(mapfile), & + dstatfield=dstatfield, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - end if + ! Save the FBdststatus fields + if (write_dststatus) then + if (mapindex /= mapfcopy) then + if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBDststatus(n2), rc=rc)) then + is_local%wrap%FBDstStatus(n2) = ESMF_FieldBundleCreate(name='dstStatus'//trim(compname(n2)), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + call ESMF_FieldBundleAdd(is_local%wrap%FBDststatus(n2), (/dstatfield/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end if + end if end if ! end if mapindex is mapunset fldptr => fldptr%next end do ! loop over fields - end if ! if coupling active end if ! if n1 not equal to n2 end do ! loop over n2 @@ -263,7 +276,7 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun //trim(mapnames(mapindex)) end if end if - end do ! end of loop over map_indiex mappers + end do ! end of loop over map_index mappers end if ! end of if block for creating destination field end do ! end of loop over n2 @@ -331,7 +344,8 @@ subroutine med_map_routehandles_initfrom_fieldbundle(n1, n2, FBsrc, FBdst, mapin end subroutine med_map_routehandles_initfrom_fieldbundle !================================================================================ - subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, routehandles, mapfile, rc) + subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, routehandles, & + mapfile, dstatfield, rc) use ESMF , only : ESMF_RouteHandle, ESMF_RouteHandlePrint, ESMF_Field, ESMF_MAXSTR use ESMF , only : ESMF_PoleMethod_Flag, ESMF_POLEMETHOD_ALLAVG, ESMF_POLEMETHOD_NONE @@ -343,13 +357,13 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, use ESMF , only : ESMF_EXTRAPMETHOD_NEAREST_STOD use ESMF , only : ESMF_Mesh, ESMF_MeshLoc, ESMF_MESHLOC_ELEMENT, ESMF_TYPEKIND_I4 use ESMF , only : ESMF_MeshGet, ESMF_DistGridGet, ESMF_DistGrid, ESMF_TYPEKIND_R8 - use ESMF , only : ESMF_FieldGet, ESMF_FieldCreate, ESMF_FieldWrite, ESMF_FieldDestroy + use ESMF , only : ESMF_FieldGet, ESMF_FieldCreate, ESMF_FieldDestroy use med_internalstate_mod , only : mapbilnr, mapconsf, mapconsd, mappatch, mappatch_uv3d, mapbilnr_uv3d, mapfcopy use med_internalstate_mod , only : mapunset, mapnames, nmappers use med_internalstate_mod , only : mapnstod, mapnstod_consd, mapnstod_consf, mapnstod_consd use med_internalstate_mod , only : mapfillv_bilnr, mapbilnr_nstod, mapconsf_aofrac use med_internalstate_mod , only : compocn, compwav, complnd, compname, compatm - use med_internalstate_mod , only : coupling_mode, dststatus_print + use med_internalstate_mod , only : coupling_mode use med_internalstate_mod , only : defaultMasks use med_constants_mod , only : ispval_mask => med_constants_ispval_mask @@ -361,21 +375,21 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, integer , intent(in) :: mapindex type(ESMF_RouteHandle) , intent(inout) :: routehandles(:) character(len=*), optional , intent(in) :: mapfile + type(ESMF_Field), optional , intent(out) :: dstatfield integer , intent(out) :: rc ! local variables - type(ESMF_Mesh) :: dstmesh - type(ESMF_Field) :: dststatusfield, doffield - type(ESMF_DistGrid) :: distgrid + type(ESMF_Mesh) :: mesh_dst + type(ESMF_Field) :: lfield character(len=CS) :: string character(len=CS) :: mapname - character(len=CL) :: fname + character(len=CS) :: dstatname integer :: srcMaskValue integer :: dstMaskValue + real(R8), pointer :: r8ptr(:) + integer(I4), pointer :: i4ptr(:) character(len=ESMF_MAXSTR) :: lmapfile - logical :: rhprint = .false., ldstprint = .false. - integer :: ns - integer(I4), pointer :: dof(:) + logical :: rhprint = .false. integer :: srcTermProcessing_Value = 0 type(ESMF_PoleMethod_Flag) :: polemethod character(len=*), parameter :: subname=' (module_med_map: med_map_routehandles_initfrom_field) ' @@ -390,12 +404,11 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, call ESMF_LogWrite(trim(subname)//": mapname "//trim(mapname), ESMF_LOGMSG_INFO) ! create a field to retrieve the dststatus field - call ESMF_FieldGet(flddst, mesh=dstmesh, rc=rc) + dstatname = trim(compname(n1))//'_'//trim(compname(n2))//'_'//mapname + call ESMF_FieldGet(flddst, mesh=mesh_dst, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - dststatusfield = ESMF_FieldCreate(dstmesh, ESMF_TYPEKIND_I4, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + lfield = ESMF_FieldCreate(mesh_dst, ESMF_TYPEKIND_I4, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(dstatname), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ! set local flag to false - ldstprint = .false. ! set src and dst masking using defaults srcMaskValue = defaultMasks(n1,1) @@ -466,10 +479,9 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, polemethod=polemethod, & srcTermProcessing=srcTermProcessing_Value, & ignoreDegenerate=.true., & - dstStatusField=dststatusfield, & + dstStatusField=lfield, & unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ldstprint = .true. end if else if (mapindex == mapfillv_bilnr) then if (maintask) then @@ -482,10 +494,9 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, polemethod=polemethod, & srcTermProcessing=srcTermProcessing_Value, & ignoreDegenerate=.true., & - dstStatusField=dststatusfield, & + dstStatusField=lfield, & unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ldstprint = .true. else if (mapindex == mapbilnr_nstod) then if (maintask) then write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//' for '//trim(string) @@ -498,10 +509,9 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, polemethod=polemethod, & srcTermProcessing=srcTermProcessing_Value, & ignoreDegenerate=.true., & - dstStatusField=dststatusfield, & + dstStatusField=lfield, & unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ldstprint = .true. else if (mapindex == mapconsf .or. mapindex == mapnstod_consf) then if (maintask) then write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//' for '//trim(string) @@ -513,11 +523,10 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, normType=ESMF_NORMTYPE_FRACAREA, & srcTermProcessing=srcTermProcessing_Value, & ignoreDegenerate=.true., & - dstStatusField=dststatusfield, & + dstStatusField=lfield, & unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ldstprint = .true. else if (mapindex == mapconsf_aofrac) then if (.not. ESMF_RouteHandleIsCreated(routehandles(mapconsf))) then if (maintask) then @@ -530,11 +539,10 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, normType=ESMF_NORMTYPE_FRACAREA, & srcTermProcessing=srcTermProcessing_Value, & ignoreDegenerate=.true., & - dstStatusField=dststatusfield, & + dstStatusField=lfield, & unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ldstprint = .true. else ! Copy existing consf RH if (maintask) then @@ -554,11 +562,10 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, normType=ESMF_NORMTYPE_DSTAREA, & srcTermProcessing=srcTermProcessing_Value, & ignoreDegenerate=.true., & - dstStatusField=dststatusfield, & + dstStatusField=lfield, & unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ldstprint = .true. else if (mapindex == mappatch .or. mapindex == mappatch_uv3d) then if (.not. ESMF_RouteHandleIsCreated(routehandles(mappatch))) then if (maintask) then @@ -571,10 +578,9 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, polemethod=polemethod, & srcTermProcessing=srcTermProcessing_Value, & ignoreDegenerate=.true., & - dstStatusField=dststatusfield, & + dstStatusField=lfield, & unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ldstprint = .true. end if else if (maintask) then @@ -586,31 +592,6 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, return end if - ! Output destination status field to file if requested - if (dststatus_print .and. ldstprint) then - fname = 'dststatus.'//trim(compname(n1))//'.'//trim(compname(n2))//'.'//trim(mapname)//'.nc' - call ESMF_LogWrite(trim(subname)//": writing dstStatusField to "//trim(fname), ESMF_LOGMSG_INFO) - - call ESMF_FieldWrite(dststatusfield, filename=trim(fname), variableName='dststatus', & - overwrite=.true., rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! the sequence index in order to sort the dststatus field - call ESMF_MeshGet(dstmesh, elementDistgrid=distgrid, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_DistGridGet(distgrid, localDE=0, elementCount=ns, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - allocate(dof(ns)) - call ESMF_DistGridGet(distgrid, localDE=0, seqIndexList=dof, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - doffield = ESMF_FieldCreate(dstmesh, dof, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldWrite(doffield, fileName='dof.'//trim(compname(n2))//'.nc', variableName='dof', & - overwrite=.true., rc=rc) - deallocate(dof) - call ESMF_FieldDestroy(doffield, rc=rc, noGarbage=.true.) - end if - ! consd_nstod method requires a second routehandle if (mapindex == mapnstod .or. mapindex == mapnstod_consd .or. mapindex == mapnstod_consf) then call ESMF_FieldRegridStore(fldsrc, flddst, routehandle=routehandles(mapnstod), & @@ -619,20 +600,10 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, regridmethod=ESMF_REGRIDMETHOD_NEAREST_STOD, & srcTermProcessing=srcTermProcessing_Value, & ignoreDegenerate=.true., & - dstStatusField=dststatusfield, & + dstStatusField=lfield, & unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ldstprint = .true. - - ! Output destination status field to file if requested - if (dststatus_print .and. ldstprint) then - fname = 'dststatus.'//trim(compname(n1))//'.'//trim(compname(n2))//'.'//trim(mapname)//'_2.nc' - call ESMF_LogWrite(trim(subname)//": writing dstStatusField to "//trim(fname), ESMF_LOGMSG_INFO) - - call ESMF_FieldWrite(dststatusfield, filename=trim(fname), variableName='dststatus', overwrite=.true., rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end if end if ! Output route handle to file if requested @@ -644,7 +615,19 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, if (chkerr(rc,__LINE__,u_FILE_u)) return endif - call ESMF_FieldDestroy(dststatusfield, rc=rc, noGarbage=.true.) + ! Copy R8 values into a returned field + if (present(dstatfield)) then + dstatfield = ESMF_FieldCreate(mesh_dst, ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, & + name=trim(dstatname), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayPtr=i4ptr, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(dstatfield, farrayPtr=r8ptr, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + r8ptr = real(i4ptr,R8) + call ESMF_FieldDestroy(lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if end subroutine med_map_routehandles_initfrom_field diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index a85d76bcb..6cf7280e7 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -780,7 +780,7 @@ subroutine med_aofluxes_init_xgrid(gcomp, aoflux_in, aoflux_out, rc) type(ESMF_Mesh) :: xch_mesh real(r8), pointer :: dataptr(:) integer :: fieldcount - integer :: stp ! srcTermProcessing is declared inout and must have variable not constant + integer :: srcTermProcessing_Value ! srcTermProcessing is declared inout and must have variable not constant type(ESMF_CoordSys_Flag) :: coordSys real(ESMF_KIND_R8) ,allocatable :: garea(:) character(len=*),parameter :: subname=' (med_aofluxes_init_xgrid) ' @@ -788,6 +788,8 @@ subroutine med_aofluxes_init_xgrid(gcomp, aoflux_in, aoflux_out, rc) rc = ESMF_SUCCESS + srcTermProcessing_Value = 0 + ! Get the internal state from the mediator Component. nullify(is_local%wrap) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) @@ -877,23 +879,26 @@ subroutine med_aofluxes_init_xgrid(gcomp, aoflux_in, aoflux_out, rc) dataptr(:) = 1.0_r8 ! create agrid->xgrid route handles - call ESMF_FieldRegridStore(xgrid, field_a, field_x, routehandle=rh_agrid2xgrid, rc=rc) + call ESMF_FieldRegridStore(xgrid, field_a, field_x, routehandle=rh_agrid2xgrid, & + srcTermProcessing=srcTermProcessing_Value, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldRegridStore(xgrid, field_a, field_x, routehandle=rh_agrid2xgrid_2ndord, & - regridmethod=ESMF_REGRIDMETHOD_CONSERVE_2ND, rc=rc) + regridmethod=ESMF_REGRIDMETHOD_CONSERVE_2ND, srcTermProcessing=srcTermProcessing_Value, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (trim(coupling_mode) == 'cesm') then - stp = 1 call ESMF_FieldRegridStore(field_a, field_x, routehandle=rh_agrid2xgrid_bilinr, & - regridmethod=ESMF_REGRIDMETHOD_BILINEAR, dstMaskValues=(/0/), srcTermProcessing=stp, rc=rc) + regridmethod=ESMF_REGRIDMETHOD_BILINEAR, dstMaskValues=(/0/), & + srcTermProcessing=srcTermProcessing_Value, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldRegridStore(field_a, field_x, routehandle=rh_agrid2xgrid_patch, & - regridmethod=ESMF_REGRIDMETHOD_PATCH, dstMaskValues=(/0/), srcTermProcessing=stp, rc=rc) + regridmethod=ESMF_REGRIDMETHOD_PATCH, dstMaskValues=(/0/), & + srcTermProcessing=srcTermProcessing_Value, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if ! create xgrid->zgrid route handle - call ESMF_FieldRegridStore(xgrid, field_x, field_a, routehandle=rh_xgrid2agrid, rc=rc) + call ESMF_FieldRegridStore(xgrid, field_x, field_a, routehandle=rh_xgrid2agrid, & + srcTermProcessing=srcTermProcessing_Value, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! destroy temporary field @@ -911,12 +916,14 @@ subroutine med_aofluxes_init_xgrid(gcomp, aoflux_in, aoflux_out, rc) call ESMF_FieldGet(field_o, farrayptr=dataptr, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return dataptr(:) = 1.0_r8 - call ESMF_FieldRegridStore(xgrid, field_o, field_x, routehandle=rh_ogrid2xgrid, rc=rc) + call ESMF_FieldRegridStore(xgrid, field_o, field_x, routehandle=rh_ogrid2xgrid, & + srcTermProcessing=srcTermProcessing_Value, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldRegridStore(xgrid, field_x, field_o, routehandle=rh_xgrid2ogrid, rc=rc) + call ESMF_FieldRegridStore(xgrid, field_x, field_o, routehandle=rh_xgrid2ogrid, & + srcTermProcessing=srcTermProcessing_Value, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! call ESMF_FieldRegridStore(xgrid, field_o, field_x, routehandle=rh_ogrid2xgrid_2ndord, & - ! regridmethod=ESMF_REGRIDMETHOD_CONSERVE_2ND, rc=rc) + ! regridmethod=ESMF_REGRIDMETHOD_CONSERVE_2ND, srcTermProcessing=srcTermProcessing_Value, rc=rc) ! if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldDestroy(field_o, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -1637,7 +1644,13 @@ subroutine set_aoflux_in_pointers(fldbun_a, fldbun_o, aoflux_in, lsize, xgrid, r if (chkerr(rc,__LINE__,u_FILE_u)) return end if - if (FB_fldchk(fldbun_a, 'Sa_pslv', rc=rc)) then + ! The following conditional captures the cases where aoflux_in%psfc is needed in calls + ! to flux_atmocn / flux_atmocn_ccpp. Note that coupling_mode=='cesm' is equivalent to + ! the CESMCOUPLED CPP token, and coupling_mode(1:3)=='ufs' is roughly equivalent to + ! the UFS_AOFLUX CPP token (noting that we should only be in this subroutine if using + ! one of the aoflux variants of the ufs coupling_mode). + if ((trim(coupling_mode) == 'cesm') .or. & + (coupling_mode(1:3) == 'ufs' .and. trim(aoflux_code) == 'ccpp')) then call fldbun_getfldptr(fldbun_a, 'Sa_pslv', aoflux_in%psfc, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if @@ -1646,10 +1659,6 @@ subroutine set_aoflux_in_pointers(fldbun_a, fldbun_o, aoflux_in, lsize, xgrid, r if (compute_atm_dens .or. compute_atm_thbot) then call fldbun_getfldptr(fldbun_a, 'Sa_pbot', aoflux_in%pbot, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (trim(coupling_mode) == 'ufs.frac.aoflux') then - call fldbun_getfldptr(fldbun_a, 'Sa_pslv', aoflux_in%psfc, xgrid=xgrid, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end if end if if (flds_wiso) then @@ -1720,9 +1729,6 @@ subroutine set_aoflux_out_pointers(fldbun, lsize, aoflux_out, xgrid, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call fldbun_getfldptr(fldbun, 'So_duu10n', aoflux_out%duu10n, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - - call fldbun_getfldptr(fldbun, 'So_u10withGust', aoflux_out%u10_withGust, xgrid=xgrid, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return call fldbun_getfldptr(fldbun, 'So_u10res', aoflux_out%u10res, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call fldbun_getfldptr(fldbun, 'Faox_taux', aoflux_out%taux, xgrid=xgrid, rc=rc) @@ -1753,8 +1759,11 @@ subroutine set_aoflux_out_pointers(fldbun, lsize, aoflux_out, xgrid, rc) if (add_gusts) then call fldbun_getfldptr(fldbun, 'So_ugustOut', aoflux_out%ugust_out, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + call fldbun_getfldptr(fldbun, 'So_u10withGust', aoflux_out%u10_withGust, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return else allocate(aoflux_out%ugust_out(lsize)); aoflux_out%ugust_out(:) = 0._R8 + allocate(aoflux_out%u10_withGust(lsize)); aoflux_out%u10_withGust(:) = 0._R8 end if end subroutine set_aoflux_out_pointers diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index c895d6c42..6859a6c9a 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -21,7 +21,6 @@ module med_phases_history_mod use med_utils_mod , only : chkerr => med_utils_ChkErr use med_internalstate_mod , only : ncomps, compname use med_internalstate_mod , only : InternalState, maintask, logunit - use med_time_mod , only : med_time_alarmInit use med_io_mod , only : med_io_write, med_io_wopen, med_io_enddef, med_io_close use perf_mod , only : t_startf, t_stopf use pio , only : file_desc_t @@ -153,6 +152,7 @@ subroutine med_phases_history_write(gcomp, rc) use ESMF , only : ESMF_Alarm, ESMF_AlarmSet use ESMF , only : ESMF_FieldBundleIsCreated use med_internalstate_mod, only : compocn, compatm + use nuopc_shr_methods , only : alarmInit ! input/output variables type(ESMF_GridComp) :: gcomp @@ -184,6 +184,7 @@ subroutine med_phases_history_write(gcomp, rc) type(ESMF_TimeInterval) :: ringInterval integer :: ringInterval_length logical :: first_time = .true. + character(len=*), parameter :: subname='(med_phases_history_write)' !--------------------------------------- @@ -221,7 +222,7 @@ subroutine med_phases_history_write(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_ClockGet(mclock, startTime=starttime, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_time_alarmInit(mclock, alarm, option=hist_option_all_inst, opt_n=hist_n_all_inst, & + call alarmInit(mclock, alarm, option=hist_option_all_inst, opt_n=hist_n_all_inst, & reftime=starttime, alarmname=alarmname, rc=rc) call ESMF_AlarmSet(alarm, clock=mclock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1550,7 +1551,7 @@ subroutine med_phases_history_init_histclock(gcomp, hclock, alarm, alarmname, hi use NUOPC_Mediator, only : NUOPC_MediatorGet use ESMF , only : ESMF_ClockCreate, ESMF_ClockGet, ESMF_ClockSet - use med_time_mod , only : med_time_alarmInit + use nuopc_shr_methods, only: AlarmInit ! input/output variables type(ESMF_GridComp) , intent(in) :: gcomp @@ -1593,9 +1594,7 @@ subroutine med_phases_history_init_histclock(gcomp, hclock, alarm, alarmname, hi hclock = ESMF_ClockCreate(mclock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Initialize history alarm and advance history clock to trigger - ! alarms then reset history clock back to mcurrtime - call med_time_alarmInit(hclock, alarm, option=hist_option, opt_n=hist_n, & + call alarmInit(hclock, alarm, option=hist_option, opt_n=hist_n, & reftime=StartTime, alarmname=trim(alarmname), advance_clock=.true., rc=rc) ! Write diagnostic info diff --git a/mediator/med_phases_ocnalb_mod.F90 b/mediator/med_phases_ocnalb_mod.F90 index 304d0c7fd..18d709cdd 100644 --- a/mediator/med_phases_ocnalb_mod.F90 +++ b/mediator/med_phases_ocnalb_mod.F90 @@ -634,9 +634,9 @@ subroutine med_phases_ocnalb_orbital_update(clock, logunit, maintask, eccen, ob type(ESMF_Time) :: CurrTime ! current time integer :: year ! model year at current time integer :: orb_year ! orbital year for current orbital computation + integer, save :: prev_orb_year=0 character(len=CL) :: msgstr ! temporary logical :: lprint - logical :: first_time = .true. character(len=*) , parameter :: subname = "(med_phases_ocnalb_orbital_update)" !------------------------------------------- @@ -648,19 +648,18 @@ subroutine med_phases_ocnalb_orbital_update(clock, logunit, maintask, eccen, ob call ESMF_TimeGet(CurrTime, yy=year, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return orb_year = orb_iyear + (year - orb_iyear_align) - lprint = maintask else orb_year = orb_iyear - if (first_time) then - lprint = maintask - first_time = .false. - else - lprint = .false. - end if end if eccen = orb_eccen shr_log_unit = logunit + + if(orb_year .ne. prev_orb_year) then + prev_orb_year = orb_year + lprint = maintask + end if + call shr_orb_params(orb_year, eccen, orb_obliq, orb_mvelp, obliqr, lambm0, mvelpp, lprint) if ( eccen == SHR_ORB_UNDEF_REAL .or. obliqr == SHR_ORB_UNDEF_REAL .or. & diff --git a/mediator/med_phases_prep_glc_mod.F90 b/mediator/med_phases_prep_glc_mod.F90 index 1681aa9b1..4eff5966f 100644 --- a/mediator/med_phases_prep_glc_mod.F90 +++ b/mediator/med_phases_prep_glc_mod.F90 @@ -39,7 +39,7 @@ module med_phases_prep_glc_mod 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 nuopc_shr_methods , only : alarmInit use glc_elevclass_mod , only : glc_get_num_elevation_classes use glc_elevclass_mod , only : glc_get_elevation_classes use glc_elevclass_mod , only : glc_get_fractional_icecov @@ -135,7 +135,6 @@ subroutine med_phases_prep_glc_init(gcomp, rc) type(ESMF_Mesh) :: mesh_o type(ESMF_Field) :: lfield character(len=CS) :: glc_renormalize_smb - logical :: glc_coupled_fluxes integer :: ungriddedUBound_output(1) ! currently the size must equal 1 for rank 2 fieldds character(len=*),parameter :: subname=' (med_phases_prep_glc_init) ' !--------------------------------------- @@ -234,25 +233,11 @@ subroutine med_phases_prep_glc_init(gcomp, rc) call NUOPC_CompAttributeGet(gcomp, name='glc_renormalize_smb', value=glc_renormalize_smb, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ! TODO: talk to Bill Sacks to determine if this is the correct logic - glc_coupled_fluxes = is_local%wrap%med_coupling_active(compglc(1),complnd) - ! Note glc_coupled_fluxes should be false in the no_evolve cases - ! Goes back to the zero-gcm fluxes variable - if zero-gcm fluxes is true than do not renormalize - ! The user can set this to true in an evolve cases - select case (glc_renormalize_smb) case ('on') smb_renormalize = .true. case ('off') smb_renormalize = .false. - case ('on_if_glc_coupled_fluxes') - if (.not. glc_coupled_fluxes) then - ! Do not renormalize if med_coupling_active is not true for compglc->complnd - ! In this case, conservation is not important - smb_renormalize = .false. - else - smb_renormalize = .true. - end if case default write(logunit,*) subname,' ERROR: unknown value for glc_renormalize_smb: ', trim(glc_renormalize_smb) call ESMF_LogWrite(trim(subname)//' ERROR: unknown value for glc_renormalize_smb: '// trim(glc_renormalize_smb), & @@ -547,7 +532,7 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) call NUOPC_CompAttributeGet(gcomp, name="glc_avg_period", value=glc_avg_period, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (trim(glc_avg_period) == 'yearly') then - call med_time_alarmInit(prepglc_clock, glc_avg_alarm, 'yearly', alarmname='alarm_glc_avg', rc=rc) + call alarmInit(prepglc_clock, glc_avg_alarm, 'yearly', alarmname='alarm_glc_avg', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (maintask) then write(logunit,'(a,i10)') trim(subname)//& @@ -557,7 +542,7 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) call NUOPC_CompAttributeGet(gcomp, name="glc_cpl_dt", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) glc_cpl_dt - call med_time_alarmInit(prepglc_clock, glc_avg_alarm, 'nseconds', opt_n=glc_cpl_dt, alarmname='alarm_glc_avg', rc=rc) + call alarmInit(prepglc_clock, glc_avg_alarm, 'nseconds', opt_n=glc_cpl_dt, alarmname='alarm_glc_avg', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (maintask) then write(logunit,'(a,i10)') trim(subname)//& diff --git a/mediator/med_phases_profile_mod.F90 b/mediator/med_phases_profile_mod.F90 index dee849ae8..75d7f4d91 100644 --- a/mediator/med_phases_profile_mod.F90 +++ b/mediator/med_phases_profile_mod.F90 @@ -9,7 +9,7 @@ module med_phases_profile_mod use med_utils_mod , only : med_utils_chkerr, med_memcheck use med_internalstate_mod , only : maintask, logunit use med_utils_mod , only : chkerr => med_utils_ChkErr - use med_time_mod , only : alarmInit => med_time_alarmInit + use nuopc_shr_methods , only : alarmInit use perf_mod , only : t_startf, t_stopf #ifdef CESMCOUPLED use shr_mem_mod , only : shr_mem_getusage @@ -53,7 +53,8 @@ subroutine med_phases_profile(gcomp, rc) ! local variables character(len=CS) :: cpl_inst_tag type(ESMF_Clock) :: clock - type(ESMF_Time) :: wallclockTime, nextTime + type(ESMF_Time), save :: wallclockTime + type(ESMF_Time) :: nextTime type(ESMF_Time) :: currTime type(ESMF_Time), save :: prevTime type(ESMF_TimeInterval) :: ringInterval, timestep @@ -119,6 +120,12 @@ subroutine med_phases_profile(gcomp, rc) call ESMF_TimeIntervalGet(timestep, d_r8=timestep_length, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! use gregorian calendar for wallclocktime + ! The s=0 is just to avoid an internal /0 error in esmf + call ESMF_TimeSet(wallclockTime, calkindflag=ESMF_CALKIND_GREGORIAN, s=0, rc=rc) + if (med_utils_chkerr(rc,__LINE__,u_FILE_u)) return + iterations = 1 else @@ -170,9 +177,6 @@ subroutine med_phases_profile(gcomp, rc) call ESMF_TimeGet(nexttime, timestring=nexttimestr, rc=rc) if (med_utils_ChkErr(rc,__LINE__,u_FILE_u)) return ! get current wall clock time - ! s=0 is to prevent an internal divide by 0 error in esmf - call ESMF_TimeSet(wallclockTime, calkindflag=ESMF_CALKIND_GREGORIAN, s=0, rc=rc) - if (med_utils_chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeSyncToRealTime(wallclockTime, rc=rc) if (med_utils_chkerr(rc,__LINE__,u_FILE_u)) return diff --git a/mediator/med_phases_restart_mod.F90 b/mediator/med_phases_restart_mod.F90 index b161f6b79..3248f5ee4 100644 --- a/mediator/med_phases_restart_mod.F90 +++ b/mediator/med_phases_restart_mod.F90 @@ -31,7 +31,6 @@ module med_phases_restart_mod #endif logical :: whead(2) = (/.true. , .false./) logical :: wdata(2) = (/.false., .true. /) - character(*), parameter :: u_FILE_u = & __FILE__ @@ -53,7 +52,7 @@ subroutine med_phases_restart_alarm_init(gcomp, rc) use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE use NUOPC , only : NUOPC_CompAttributeGet use NUOPC_Model , only : NUOPC_ModelGet - use med_time_mod , only : med_time_AlarmInit + use nuopc_shr_methods, only : AlarmInit ! input/output variables type(ESMF_GridComp) :: gcomp @@ -89,8 +88,10 @@ subroutine med_phases_restart_alarm_init(gcomp, rc) ! Set alarm for instantaneous mediator restart output call ESMF_ClockGet(mclock, currTime=mCurrTime, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_time_alarmInit(mclock, alarm, option=restart_option, opt_n=restart_n, & + + call alarmInit(mclock, alarm, option=restart_option, opt_n=restart_n, & reftime=mcurrTime, alarmname='alarm_restart', rc=rc) + call ESMF_AlarmSet(alarm, clock=mclock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -147,7 +148,7 @@ subroutine med_phases_restart_write(gcomp, rc) use med_io_mod , only : med_io_close, med_io_date2yyyymmdd, med_io_sec2hms use med_phases_history_mod, only : auxcomp use med_constants_mod , only : SecPerDay => med_constants_SecPerDay - + use nuopc_shr_methods , only : shr_get_rpointer_name ! Input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc @@ -181,9 +182,9 @@ subroutine med_phases_restart_write(gcomp, rc) character(ESMF_MAXSTR) :: case_name ! case name character(ESMF_MAXSTR) :: restart_file ! Local path to restart filename character(ESMF_MAXSTR) :: restart_pfile ! Local path to restart pointer filename - character(ESMF_MAXSTR) :: cpl_inst_tag ! instance tag character(ESMF_MAXSTR) :: restart_dir ! Optional restart directory name character(ESMF_MAXSTR) :: cvalue ! attribute string + character(ESMF_MAXSTR) :: cpl_inst_tag ! instance tag logical :: alarmIsOn ! generic alarm flag real(R8) :: tbnds(2) ! CF1.0 time bounds logical :: isPresent @@ -207,14 +208,6 @@ subroutine med_phases_restart_write(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeGet(gcomp, name='case_name', value=case_name, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(gcomp, name='inst_suffix', isPresent=isPresent, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if(isPresent) then - call NUOPC_CompAttributeGet(gcomp, name='inst_suffix', value=cpl_inst_tag, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - cpl_inst_tag = "" - endif call NUOPC_CompAttributeGet(gcomp, name='restart_dir', isPresent=isPresent, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if(isPresent) then @@ -311,12 +304,20 @@ subroutine med_phases_restart_write(gcomp, rc) ! Use nexttimestr rather than currtimestr here since that is the time at the end of ! the timestep and is preferred for restart file names !--------------------------------------- + call NUOPC_CompAttributeGet(gcomp, name='inst_suffix', isPresent=isPresent, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent) then + call NUOPC_CompAttributeGet(gcomp, name='inst_suffix', value=cpl_inst_tag, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + cpl_inst_tag = "" + endif write(restart_file,"(6a)") trim(restart_dir)//trim(case_name),'.cpl', trim(cpl_inst_tag),'.r.',& trim(nexttimestr),'.nc' if (maintask) then - restart_pfile = "rpointer.cpl"//trim(cpl_inst_tag) + call shr_get_rpointer_name(gcomp, 'cpl', next_ymd, next_tod, restart_pfile, 'write', rc) call ESMF_LogWrite(trim(subname)//" write rpointer file = "//trim(restart_pfile), ESMF_LOGMSG_INFO) open(newunit=unitn, file=restart_pfile, form='FORMATTED') write(unitn,'(a)') trim(restart_file) @@ -495,13 +496,14 @@ subroutine med_phases_restart_read(gcomp, rc) ! Read mediator restart - use ESMF , only : ESMF_GridComp, ESMF_VM, ESMF_Clock, ESMF_Time, ESMF_MAXSTR - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_FAILURE - use ESMF , only : ESMF_LOGMSG_ERROR, ESMF_VMBroadCast - use ESMF , only : ESMF_GridCompGet, ESMF_ClockGet, ESMF_ClockPrint - use ESMF , only : ESMF_FieldBundleIsCreated, ESMF_TimeGet - use NUOPC , only : NUOPC_CompAttributeGet - use med_io_mod , only : med_io_read + use ESMF , only : ESMF_GridComp, ESMF_VM, ESMF_Clock, ESMF_Time, ESMF_MAXSTR + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_FAILURE + use ESMF , only : ESMF_LOGMSG_ERROR, ESMF_VMBroadCast + use ESMF , only : ESMF_GridCompGet, ESMF_ClockGet, ESMF_ClockPrint + use ESMF , only : ESMF_FieldBundleIsCreated, ESMF_TimeGet + use NUOPC , only : NUOPC_CompAttributeGet + use med_io_mod , only : med_io_read + use nuopc_shr_methods, only : shr_get_rpointer_name ! Input/output variables type(ESMF_GridComp) :: gcomp @@ -516,10 +518,10 @@ subroutine med_phases_restart_read(gcomp, rc) integer :: n integer :: ierr, unitn integer :: yr,mon,day,sec ! time units + integer :: curr_ymd character(ESMF_MAXSTR) :: case_name ! case name character(ESMF_MAXSTR) :: restart_file ! Local path to restart filename character(ESMF_MAXSTR) :: restart_pfile ! Local path to restart pointer filename - character(ESMF_MAXSTR) :: cpl_inst_tag ! instance tag logical :: isPresent character(len=*), parameter :: subname='(med_phases_restart_read)' !--------------------------------------- @@ -535,14 +537,6 @@ subroutine med_phases_restart_read(gcomp, rc) ! Get case name and inst suffix call NUOPC_CompAttributeGet(gcomp, name='case_name', value=case_name, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(gcomp, name='inst_suffix', isPresent=isPresent, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent) then - call NUOPC_CompAttributeGet(gcomp, name='inst_suffix', value=cpl_inst_tag, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - cpl_inst_tag = "" - endif ! Get the clock info call ESMF_GridCompGet(gcomp, clock=clock) @@ -551,6 +545,8 @@ subroutine med_phases_restart_read(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeGet(currtime,yy=yr, mm=mon, dd=day, s=sec, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ymd2date(yr,mon,day,curr_ymd) + write(currtimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec if (dbug_flag > 1) then call ESMF_LogWrite(trim(subname)//": currtime = "//trim(currtimestr), ESMF_LOGMSG_INFO) @@ -561,15 +557,10 @@ subroutine med_phases_restart_read(gcomp, rc) endif ! Get the restart file name from the pointer file - restart_pfile = "rpointer.cpl"//trim(cpl_inst_tag) if (maintask) then + call shr_get_rpointer_name(gcomp, 'cpl', curr_ymd, sec, restart_pfile, 'read', rc) call ESMF_LogWrite(trim(subname)//" read rpointer file = "//trim(restart_pfile), ESMF_LOGMSG_INFO) open(newunit=unitn, file=restart_pfile, form='FORMATTED', status='old', iostat=ierr) - if (ierr < 0) then - call ESMF_LogWrite(trim(subname)//' rpointer file open returns error', ESMF_LOGMSG_INFO) - rc=ESMF_Failure - return - end if read (unitn,'(a)', iostat=ierr) restart_file if (ierr < 0) then call ESMF_LogWrite(trim(subname)//' rpointer file read returns error', ESMF_LOGMSG_INFO) diff --git a/mediator/med_time_mod.F90 b/mediator/med_time_mod.F90 deleted file mode 100644 index 8a05c3671..000000000 --- a/mediator/med_time_mod.F90 +++ /dev/null @@ -1,302 +0,0 @@ -module med_time_mod - - use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 - use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_GridCompSet - use ESMF , only : ESMF_Clock, ESMF_ClockCreate, ESMF_ClockGet, ESMF_ClockSet - use ESMF , only : ESMF_ClockAdvance - use ESMF , only : ESMF_Alarm, ESMF_AlarmCreate, ESMF_AlarmGet, ESMF_AlarmSet - use ESMF , only : ESMF_Calendar, ESMF_CalKind_Flag, ESMF_CalendarCreate - use ESMF , only : ESMF_CALKIND_NOLEAP, ESMF_CALKIND_GREGORIAN - use ESMF , only : ESMF_Time, ESMF_TimeGet, ESMF_TimeSet - use ESMF , only : ESMF_TimeInterval, ESMF_TimeIntervalSet, ESMF_TimeIntervalGet - use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_FAILURE - use ESMF , only : ESMF_VM, ESMF_VMGet, ESMF_VMBroadcast - use ESMF , only : ESMF_LOGMSG_INFO, ESMF_FAILURE, ESMF_LOGMSG_ERROR - use ESMF , only : operator(<), operator(/=), operator(+) - use ESMF , only : operator(-), operator(*) , operator(>=) - use ESMF , only : operator(<=), operator(>), operator(==) - use med_constants_mod , only : dbug_flag => med_constants_dbug_flag - use med_utils_mod , only : chkerr => med_utils_ChkErr - use med_internalstate_mod, only : maintask, logunit - - implicit none - private ! default private - - public :: med_time_alarmInit ! initialize an alarm - - ! Clock and alarm options - character(len=*), private, parameter :: & - optNONE = "none" , & - optNever = "never" , & - optNSteps = "nstep" , & - optNSeconds = "nsecond" , & - optNMinutes = "nminute" , & - optNHours = "nhour" , & - optNDays = "nday" , & - optNMonths = "nmonth" , & - optNYears = "nyear" , & - optMonthly = "monthly" , & - optYearly = "yearly" , & - optDate = "date" , & - optEnd = "end" , & - optGLCCouplingPeriod = "glc_coupling_period" - - ! Module data - integer, parameter :: SecPerDay = 86400 ! Seconds per day - character(len=*), parameter :: u_FILE_u = & - __FILE__ - -!=============================================================================== -contains -!=============================================================================== - - subroutine med_time_alarmInit( clock, alarm, option, & - opt_n, opt_ymd, opt_tod, reftime, alarmname, advance_clock, rc) - - ! Setup an alarm in a clock - ! Notes: The ringtime sent to AlarmCreate MUST be the next alarm - ! time. If you send an arbitrary but proper ringtime from the - ! past and the ring interval, the alarm will always go off on the - ! next clock advance and this will cause serious problems. Even - ! if it makes sense to initialize an alarm with some reference - ! time and the alarm interval, that reference time has to be - ! advance forward to be >= the current time. In the logic below - ! we set an appropriate "NextAlarm" and then we make sure to - ! advance it properly based on the ring interval. - - ! input/output variables - type(ESMF_Clock) , intent(inout) :: clock ! clock - type(ESMF_Alarm) , intent(inout) :: alarm ! alarm - character(len=*) , intent(in) :: option ! alarm option - integer , optional , intent(in) :: opt_n ! alarm freq - integer , optional , intent(in) :: opt_ymd ! alarm ymd - integer , optional , intent(in) :: opt_tod ! alarm tod (sec) - type(ESMF_Time) , optional , intent(in) :: reftime ! reference time - character(len=*) , optional , intent(in) :: alarmname ! alarm name - logical , optional , intent(in) :: advance_clock ! advance clock to trigger alarm - integer , intent(out) :: rc ! Return code - - ! local variables - type(ESMF_Calendar) :: cal ! calendar - integer :: lymd ! local ymd - integer :: ltod ! local tod - integer :: cyy,cmm,cdd,csec ! time info - character(len=64) :: lalarmname ! local alarm name - logical :: update_nextalarm ! update next alarm - type(ESMF_Time) :: CurrTime ! Current Time - type(ESMF_Time) :: NextAlarm ! Next alarm time - type(ESMF_TimeInterval) :: AlarmInterval ! Alarm interval - character(len=*), parameter :: subname = '(med_time_alarmInit): ' - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - lalarmname = 'alarm_unknown' - if (present(alarmname)) lalarmname = trim(alarmname) - ltod = 0 - if (present(opt_tod)) ltod = opt_tod - lymd = -1 - if (present(opt_ymd)) lymd = opt_ymd - - call ESMF_ClockGet(clock, CurrTime=CurrTime, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_TimeGet(CurrTime, yy=cyy, mm=cmm, dd=cdd, s=csec, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! initial guess of next alarm, this will be updated below - if (present(RefTime)) then - NextAlarm = RefTime - else - NextAlarm = CurrTime - endif - - ! Get calendar from clock - call ESMF_ClockGet(clock, calendar=cal) - - ! Error checks - if (trim(option) == optdate) then - if (.not. present(opt_ymd)) then - call ESMF_LogWrite(trim(subname)//trim(option)//' requires opt_ymd', ESMF_LOGMSG_ERROR) - rc = ESMF_FAILURE - return - end if - if (lymd < 0 .or. ltod < 0) then - call ESMF_LogWrite(subname//trim(option)//'opt_ymd, opt_tod invalid', ESMF_LOGMSG_ERROR) - rc = ESMF_FAILURE - return - end if - else if (& - trim(option) == optNSteps .or. trim(option) == trim(optNSteps)//'s' .or. & - trim(option) == optNSeconds .or. trim(option) == trim(optNSeconds)//'s' .or. & - trim(option) == optNMinutes .or. trim(option) == trim(optNMinutes)//'s' .or. & - trim(option) == optNHours .or. trim(option) == trim(optNHours)//'s' .or. & - trim(option) == optNDays .or. trim(option) == trim(optNDays)//'s' .or. & - trim(option) == optNMonths .or. trim(option) == trim(optNMonths)//'s' .or. & - trim(option) == optNYears .or. trim(option) == trim(optNYears)//'s' ) then - if (.not.present(opt_n)) then - call ESMF_LogWrite(subname//trim(option)//' requires opt_n', ESMF_LOGMSG_ERROR) - rc = ESMF_FAILURE - return - end if - if (opt_n <= 0) then - call ESMF_LogWrite(subname//trim(option)//' invalid opt_n', ESMF_LOGMSG_ERROR) - rc = ESMF_FAILURE - return - end if - end if - - ! Determine inputs for call to create alarm - selectcase (trim(option)) - - case (optNONE) - call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeSet( NextAlarm, yy=9999, mm=12, dd=1, s=0, calendar=cal, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .false. - - case (optNever) - call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeSet( NextAlarm, yy=9999, mm=12, dd=1, s=0, calendar=cal, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .false. - - case (optEnd) - call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeSet( NextAlarm, yy=9999, mm=12, dd=1, s=0, calendar=cal, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .false. - - case (optDate) - call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_time_date2ymd(opt_ymd, cyy, cmm, cdd) - - call ESMF_TimeSet( NextAlarm, yy=cyy, mm=cmm, dd=cdd, s=ltod, calendar=cal, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .false. - - case (optNSteps,trim(optNSteps)//'s') - call ESMF_ClockGet(clock, TimeStep=AlarmInterval, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNSeconds,trim(optNSeconds)//'s') - call ESMF_TimeIntervalSet(AlarmInterval, s=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNMinutes,trim(optNMinutes)//'s') - call ESMF_TimeIntervalSet(AlarmInterval, s=60, rc=rc) - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNHours,trim(optNHours)//'s') - call ESMF_TimeIntervalSet(AlarmInterval, s=3600, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNDays,trim(optNDays)//'s') - call ESMF_TimeIntervalSet(AlarmInterval, d=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNMonths,trim(optNMonths)//'s') - call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optMonthly) - call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeSet( NextAlarm, yy=cyy, mm=cmm, dd=1, s=0, calendar=cal, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .true. - - case (optNYears, trim(optNYears)//'s') - call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optYearly) - call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeSet( NextAlarm, yy=cyy, mm=1, dd=1, s=0, calendar=cal, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .true. - case default - call ESMF_LogWrite(subname//'unknown option '//trim(option), ESMF_LOGMSG_ERROR) - rc = ESMF_FAILURE - return - - end select - - ! -------------------------------------------------------------------------------- - ! --- AlarmInterval and NextAlarm should be set --- - ! -------------------------------------------------------------------------------- - - ! --- advance Next Alarm so it won't ring on first timestep for - ! --- most options above. go back one alarminterval just to be careful - - if (update_nextalarm) then - NextAlarm = NextAlarm - AlarmInterval - do while (NextAlarm <= CurrTime) - NextAlarm = NextAlarm + AlarmInterval - enddo - endif - - if (maintask) then - write(logunit,*) - write(logunit,'(a)') trim(subname) //' creating alarm '// trim(lalarmname) - end if - - alarm = ESMF_AlarmCreate( name=lalarmname, clock=clock, ringTime=NextAlarm, & - ringInterval=AlarmInterval, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! Advance model clock to trigger alarm then reset model clock back to currtime - if (present(advance_clock)) then - if (advance_clock) then - call ESMF_AlarmSet(alarm, clock=clock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockGet(clock, currTime=CurrTime, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockAdvance(clock,rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockSet(clock, currTime=currtime, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - end if - - end subroutine med_time_alarmInit - - !=============================================================================== - subroutine med_time_date2ymd (date, year, month, day) - - ! input/output variables - integer, intent(in) :: date ! coded-date (yyyymmdd) - integer, intent(out) :: year,month,day ! calendar year,month,day - - ! local variables - integer :: tdate ! temporary date - character(*),parameter :: subName = "(med_time_date2ymd)" - !------------------------------------------------------------------------------- - tdate = abs(date) - year = int(tdate/10000) - if (date < 0) then - year = -year - end if - month = int( mod(tdate,10000)/ 100) - day = mod(tdate, 100) - end subroutine med_time_date2ymd - -end module med_time_mod From e3a4803bee77b33e24a90400478ad405f3eeabbc Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Wed, 18 Dec 2024 11:30:14 -0500 Subject: [PATCH 008/123] protect write_restartfh w/ CESM ifdef --- mediator/med_phases_restart_mod.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/mediator/med_phases_restart_mod.F90 b/mediator/med_phases_restart_mod.F90 index 0cb81bd76..6f2cab863 100644 --- a/mediator/med_phases_restart_mod.F90 +++ b/mediator/med_phases_restart_mod.F90 @@ -189,7 +189,9 @@ subroutine med_phases_restart_write(gcomp, rc) real(R8) :: tbnds(2) ! CF1.0 time bounds logical :: isPresent logical :: first_time = .true. +#ifndef CESMCOUPLED logical :: write_restartfh +#endif character(len=*), parameter :: subname='(med_phases_restart_write)' !--------------------------------------- From cdbed6c48c2626e67ee5c071947d991e6f0fbc2e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ufuk=20Turun=C3=A7o=C4=9Flu?= Date: Tue, 28 Jan 2025 07:19:53 -0700 Subject: [PATCH 009/123] use redist if atm and lnd has same grid (#126) --- mediator/esmFldsExchange_ufs_mod.F90 | 21 +++++++++++++++++---- mediator/med_internalstate_mod.F90 | 17 +++++++++++++++++ 2 files changed, 34 insertions(+), 4 deletions(-) diff --git a/mediator/esmFldsExchange_ufs_mod.F90 b/mediator/esmFldsExchange_ufs_mod.F90 index 9b23a6d5e..cef1a5f69 100644 --- a/mediator/esmFldsExchange_ufs_mod.F90 +++ b/mediator/esmFldsExchange_ufs_mod.F90 @@ -11,6 +11,9 @@ module esmFldsExchange_ufs_mod public :: esmFldsExchange_ufs + integer :: atm2lnd_maptype + integer :: lnd2atm_maptype + character(*), parameter :: u_FILE_u = & __FILE__ @@ -30,7 +33,7 @@ subroutine esmFldsExchange_ufs(gcomp, phase, rc) use med_internalstate_mod , only : mapbilnr, mapconsf, mapconsd, mappatch use med_internalstate_mod , only : mapfcopy, mapnstod, mapnstod_consd, mapnstod_consf use med_internalstate_mod , only : mapconsf_aofrac, mapbilnr_nstod - use med_internalstate_mod , only : coupling_mode, mapnames + use med_internalstate_mod , only : coupling_mode, mapnames, samegrid_atmlnd use esmFlds , only : med_fldList_type use esmFlds , only : addfld_to => med_fldList_addfld_to use esmFlds , only : addmrg_to => med_fldList_addmrg_to @@ -92,6 +95,16 @@ subroutine esmFldsExchange_ufs(gcomp, phase, rc) med_aoflux_to_ocn = .false. end if + ! determine if atm and lnd have the same mesh + if (phase == 'advertise') then + atm2lnd_maptype = maptype + lnd2atm_maptype = maptype + if (samegrid_atmlnd) then + atm2lnd_maptype = mapfcopy + lnd2atm_maptype = mapfcopy + end if + end if + !===================================================================== ! scalar information !===================================================================== @@ -258,7 +271,7 @@ subroutine esmFldsExchange_ufs(gcomp, phase, rc) do n = 1,size(flds) if ( fldchk(is_local%wrap%FBexp(compatm) , 'Fall_'//trim(flds(n)), rc=rc) .and. & fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_'//trim(flds(n)), rc=rc)) then - call addmap_from(complnd, 'Fall_'//trim(flds(n)), compatm, maptype, 'lfrac', 'unset') + call addmap_from(complnd, 'Fall_'//trim(flds(n)), compatm, lnd2atm_maptype, 'lfrac', 'unset') call addmrg_to(compatm, 'Fall_'//trim(flds(n)), mrg_from=complnd, mrg_fld='Fall_'//trim(flds(n)), mrg_type='copy') end if end do @@ -279,7 +292,7 @@ subroutine esmFldsExchange_ufs(gcomp, phase, rc) do n = 1,size(flds) if ( fldchk(is_local%wrap%FBexp(compatm) , 'Sl_'//trim(flds(n)), rc=rc) .and. & fldchk(is_local%wrap%FBImp(complnd,complnd), 'Sl_'//trim(flds(n)), rc=rc)) then - call addmap_from(complnd, 'Sl_'//trim(flds(n)), compatm, maptype, 'lfrac', 'unset') + call addmap_from(complnd, 'Sl_'//trim(flds(n)), compatm, lnd2atm_maptype, 'lfrac', 'unset') call addmrg_to(compatm, 'Sl_'//trim(flds(n)), mrg_from=complnd, mrg_fld='Sl_'//trim(flds(n)), mrg_type='copy') end if end do @@ -776,7 +789,7 @@ subroutine esmFldsExchange_ufs(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBexp(complnd) , fldname, rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), fldname, rc=rc)) then - call addmap_from(compatm, fldname, complnd, maptype, 'one', 'unset') + call addmap_from(compatm, fldname, complnd, atm2lnd_maptype, 'one', 'unset') call addmrg_to(complnd, fldname, mrg_from=compatm, mrg_fld=fldname, mrg_type='copy') end if end if diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index 6f7c49f73..e8d30eb5d 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -263,6 +263,23 @@ subroutine med_internalstate_init(gcomp, rc) samegrid_atmlnd = .true. end if + ! flexibility to overwrite samegrid_atmlnd option + call NUOPC_CompAttributeGet(gcomp, name='samegrid_atmlnd', value=cvalue, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (isPresent .and. isSet) then + if (trim(cvalue) == '.true.' .or. trim(cvalue) == 'true') then + samegrid_atmlnd = .true. + else + samegrid_atmlnd = .false. + end if + end if + + if (maintask) then + write(logunit,'(a,l)') trim(subname)//' atm and lnd is on same grid = ', samegrid_atmlnd + end if + ! See med_fraction_mod for the following definitions if (samegrid_atmlnd) then map_fracname_lnd2atm = 'lfrin' ! in fraclist_a From 11d0522d63510acb13816c6a8d5e9a44cf8e5097 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Thu, 13 Mar 2025 10:16:16 -0600 Subject: [PATCH 010/123] update externals for extbuild --- .github/workflows/extbuild.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/extbuild.yml b/.github/workflows/extbuild.yml index 86ed1a533..ffd5caed5 100644 --- a/.github/workflows/extbuild.yml +++ b/.github/workflows/extbuild.yml @@ -23,8 +23,8 @@ jobs: ESMF_VERSION: v8.8.0 PNETCDF_VERSION: checkpoint.1.14.0 NETCDF_FORTRAN_VERSION: v4.6.1 - PIO_VERSION: pio2_6_4 - CDEPS_VERSION: cdeps1.0.64 + PIO_VERSION: pio2_6_5 + CDEPS_VERSION: cdeps1.0.70 steps: - uses: actions/checkout@v4 # Build the ESMF library, if the cache contains a previous build From ab2329d5b3ae216eff096c1d04adc77461aa6ad0 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 18 Mar 2025 17:23:10 -0600 Subject: [PATCH 011/123] Keep glc-derived runoff as separate fields to ocn if possible --- mediator/esmFldsExchange_cesm_mod.F90 | 24 ++++++++++++++++++++++-- 1 file changed, 22 insertions(+), 2 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index b3b305668..5506295dc 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -144,6 +144,8 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) character(len=CS) :: mrgfld_source logical :: wav_coupling_to_cice logical :: ocn2glc_coupling + logical :: forr_rofl_glc_merged_to_ocn + logical :: forr_rofi_glc_merged_to_ocn character(len=*) , parameter :: subname=' (esmFldsExchange_cesm) ' !-------------------------------------- @@ -2419,12 +2421,21 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if ! Liquid runoff from land and glc - merging + forr_rofl_glc_merged_to_ocn = .false. + if ( fldchk(is_local%wrap%FBExp(compocn), 'Forr_rofl_glc', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofl_glc', rc=rc)) then + ! If the ocean is prepared to handle Forr_rofl_glc as a separate field, then keep + ! it as a separate field rather than merging it to Foxx_rofl + call addmrg_to(compocn, 'Forr_rofl_glc', mrg_from=comprof, mrg_fld='Forr_rofl_glc', mrg_type='copy') + forr_rofl_glc_merged_to_ocn = .true. + end if 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 + if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofl_glc', rc=rc) .and. & + .not. forr_rofl_glc_merged_to_ocn) 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') @@ -2452,9 +2463,18 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if ! Frozen runoff from land and glc - merging + forr_rofi_glc_merged_to_ocn = .false. + if ( fldchk(is_local%wrap%FBExp(compocn), 'Forr_rofi_glc', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofi_glc', rc=rc)) then + ! If the ocean is prepared to handle Forr_rofi_glc as a separate field, then keep + ! it as a separate field rather than merging it to Foxx_rofi + call addmrg_to(compocn, 'Forr_rofi_glc', mrg_from=comprof, mrg_fld='Forr_rofi_glc', mrg_type='copy') + forr_rofi_glc_merged_to_ocn = .true. + end if 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 + if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofi_glc', rc=rc) .and. & + .not. forr_rofi_glc_merged_to_ocn) 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') From de95504bfb43348b3abd0d25d33a18aa3b6ff486 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 19 Mar 2025 07:46:36 -0600 Subject: [PATCH 012/123] add connection between xml and fortran --- cime_config/namelist_definition_drv.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index ec437189e..c2577d50c 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -431,7 +431,7 @@ if true, mediator is present in run - + char expdef ALLCOMP_attributes From dcd0f47429d4024938d07b889d1d1aaa52673bc8 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 19 Mar 2025 08:02:41 -0600 Subject: [PATCH 013/123] an additional change required --- cime_config/namelist_definition_drv.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index c2577d50c..bf4c17ccb 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -439,7 +439,7 @@ Model version - unknown + $MODEL_VERSION From bfd40ad89acf2c8539ece4aef3cb9649196f6433 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 21 Mar 2025 07:24:38 -0600 Subject: [PATCH 014/123] update cdeps tag in github workflow --- .github/workflows/extbuild.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/extbuild.yml b/.github/workflows/extbuild.yml index ffd5caed5..5617a6849 100644 --- a/.github/workflows/extbuild.yml +++ b/.github/workflows/extbuild.yml @@ -24,7 +24,7 @@ jobs: PNETCDF_VERSION: checkpoint.1.14.0 NETCDF_FORTRAN_VERSION: v4.6.1 PIO_VERSION: pio2_6_5 - CDEPS_VERSION: cdeps1.0.70 + CDEPS_VERSION: cdeps1.0.71 steps: - uses: actions/checkout@v4 # Build the ESMF library, if the cache contains a previous build From 57ed117f05aebf8ce82b76418b76d1c3052637cf Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 21 Mar 2025 08:41:44 -0600 Subject: [PATCH 015/123] update cdeps external in github workflow --- .github/workflows/extbuild.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/extbuild.yml b/.github/workflows/extbuild.yml index 5617a6849..f31f46bd4 100644 --- a/.github/workflows/extbuild.yml +++ b/.github/workflows/extbuild.yml @@ -24,7 +24,7 @@ jobs: PNETCDF_VERSION: checkpoint.1.14.0 NETCDF_FORTRAN_VERSION: v4.6.1 PIO_VERSION: pio2_6_5 - CDEPS_VERSION: cdeps1.0.71 + CDEPS_VERSION: cdeps1.0.72 steps: - uses: actions/checkout@v4 # Build the ESMF library, if the cache contains a previous build From a283c1fdb4fcb98d80765e29cdfcfeaf297900e5 Mon Sep 17 00:00:00 2001 From: adamrher Date: Sat, 22 Mar 2025 15:38:39 -0600 Subject: [PATCH 016/123] add ATM_NCPL entry for POLARCAP --- cime_config/config_component_cesm.xml | 1 + 1 file changed, 1 insertion(+) diff --git a/cime_config/config_component_cesm.xml b/cime_config/config_component_cesm.xml index b801f156e..0502a47c5 100644 --- a/cime_config/config_component_cesm.xml +++ b/cime_config/config_component_cesm.xml @@ -269,6 +269,7 @@ 384 192 384 + 192 48 48 48 From 99de402d12845f7d6af65e34796da96c1a9594de Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Wed, 26 Mar 2025 09:29:04 -0400 Subject: [PATCH 017/123] explicitly create RHs for uv3d mapping * add consf_uv3d option, needed by UFS --- mediator/med_internalstate_mod.F90 | 6 +- mediator/med_map_mod.F90 | 219 ++++++++++++++++++----------- 2 files changed, 137 insertions(+), 88 deletions(-) diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index 6f7c49f73..0c576beb4 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -77,7 +77,8 @@ module med_internalstate_mod integer , public, parameter :: mapfillv_bilnr = 15 ! fill value followed by bilinear integer , public, parameter :: mapbilnr_nstod = 16 ! bilinear with nstod extrapolation integer , public, parameter :: mapconsf_aofrac = 17 ! conservative with aofrac normalization (ufs only) - integer , public, parameter :: nmappers = 17 + integer , public, parameter :: mapconsf_uv3d = 18 ! conservative with uv3d mapping + integer , public, parameter :: nmappers = 18 character(len=*) , public, parameter :: mapnames(nmappers) = & (/'bilnr ',& 'consf ',& @@ -95,7 +96,8 @@ module med_internalstate_mod 'glc2ocn_liq ',& 'fillv_bilnr ',& 'bilnr_nstod ',& - 'consf_aofrac'/) + 'consf_aofrac',& + 'consf_uv3d '/) type, public :: packed_data_type integer, allocatable :: fldindex(:) ! size of number of packed fields diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 5caeb8ca6..0112bd57b 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -10,7 +10,7 @@ module med_map_mod use med_utils_mod , only : chkerr => med_utils_ChkErr use perf_mod , only : t_startf, t_stopf use shr_log_mod , only : shr_log_error - + implicit none private @@ -299,7 +299,7 @@ end subroutine med_map_RouteHandles_initfrom_esmflds subroutine med_map_routehandles_initfrom_fieldbundle(n1, n2, FBsrc, FBdst, mapindex, RouteHandle, rc) use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_LogFlush - use ESMF , only : ESMf_Field, ESMF_FieldBundle, ESMF_RouteHandle + use ESMF , only : ESMF_Field, ESMF_FieldBundle, ESMF_RouteHandle use med_methods_mod , only : med_methods_FB_getFieldN !--------------------------------------------- @@ -361,7 +361,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, use med_internalstate_mod , only : mapbilnr, mapconsf, mapconsd, mappatch, mappatch_uv3d, mapbilnr_uv3d, mapfcopy use med_internalstate_mod , only : mapunset, mapnames, nmappers use med_internalstate_mod , only : mapnstod, mapnstod_consd, mapnstod_consf, mapnstod_consd - use med_internalstate_mod , only : mapfillv_bilnr, mapbilnr_nstod, mapconsf_aofrac + use med_internalstate_mod , only : mapfillv_bilnr, mapbilnr_nstod, mapconsf_aofrac, mapconsf_uv3d use med_internalstate_mod , only : compocn, compwav, complnd, compname, compatm use med_internalstate_mod , only : coupling_mode use med_internalstate_mod , only : defaultMasks @@ -467,34 +467,46 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, ignoreUnmatchedIndices=.true., & srcTermProcessing=srcTermProcessing_Value, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - else if (mapindex == mapbilnr .or. mapindex == mapbilnr_uv3d) then - if (.not. ESMF_RouteHandleIsCreated(routehandles(mapbilnr))) then + else if (mapindex == mapbilnr ) then if (maintask) then write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//' for '//trim(string) end if call ESMF_FieldRegridStore(fldsrc, flddst, routehandle=routehandles(mapbilnr), & - srcMaskValues=(/srcMaskValue/), & - dstMaskValues=(/dstMaskValue/), & - regridmethod=ESMF_REGRIDMETHOD_BILINEAR, & - polemethod=polemethod, & + srcMaskValues=(/srcMaskValue/), & + dstMaskValues=(/dstMaskValue/), & + regridmethod=ESMF_REGRIDMETHOD_BILINEAR, & + polemethod=polemethod, & srcTermProcessing=srcTermProcessing_Value, & - ignoreDegenerate=.true., & - dstStatusField=lfield, & + ignoreDegenerate=.true., & + dstStatusField=lfield, & unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + else if (mapindex == mapbilnr_uv3d ) then + if (maintask) then + write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//' for '//trim(string) end if + call ESMF_FieldRegridStore(fldsrc, flddst, routehandle=routehandles(mapbilnr_uv3d), & + srcMaskValues=(/srcMaskValue/), & + dstMaskValues=(/dstMaskValue/), & + regridmethod=ESMF_REGRIDMETHOD_BILINEAR, & + polemethod=polemethod, & + srcTermProcessing=srcTermProcessing_Value, & + ignoreDegenerate=.true., & + dstStatusField=lfield, & + unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return else if (mapindex == mapfillv_bilnr) then if (maintask) then write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//' for '//trim(string) end if call ESMF_FieldRegridStore(fldsrc, flddst, routehandle=routehandles(mapfillv_bilnr), & - srcMaskValues=(/srcMaskValue/), & - dstMaskValues=(/dstMaskValue/), & - regridmethod=ESMF_REGRIDMETHOD_BILINEAR, & - polemethod=polemethod, & + srcMaskValues=(/srcMaskValue/), & + dstMaskValues=(/dstMaskValue/), & + regridmethod=ESMF_REGRIDMETHOD_BILINEAR, & + polemethod=polemethod, & srcTermProcessing=srcTermProcessing_Value, & - ignoreDegenerate=.true., & - dstStatusField=lfield, & + ignoreDegenerate=.true., & + dstStatusField=lfield, & unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return else if (mapindex == mapbilnr_nstod) then @@ -502,14 +514,14 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//' for '//trim(string) end if call ESMF_FieldRegridStore(fldsrc, flddst, routehandle=routehandles(mapbilnr_nstod), & - srcMaskValues=(/srcMaskValue/), & - dstMaskValues=(/dstMaskValue/), & - regridmethod=ESMF_REGRIDMETHOD_BILINEAR, & + srcMaskValues=(/srcMaskValue/), & + dstMaskValues=(/dstMaskValue/), & + regridmethod=ESMF_REGRIDMETHOD_BILINEAR, & extrapMethod=ESMF_EXTRAPMETHOD_NEAREST_STOD, & - polemethod=polemethod, & - srcTermProcessing=srcTermProcessing_Value, & - ignoreDegenerate=.true., & - dstStatusField=lfield, & + polemethod=polemethod, & + srcTermProcessing=srcTermProcessing_Value, & + ignoreDegenerate=.true., & + dstStatusField=lfield, & unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return else if (mapindex == mapconsf .or. mapindex == mapnstod_consf) then @@ -517,71 +529,85 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//' for '//trim(string) end if call ESMF_FieldRegridStore(fldsrc, flddst, routehandle=routehandles(mapconsf), & - srcMaskValues=(/srcMaskValue/), & - dstMaskValues=(/dstMaskValue/), & - regridmethod=ESMF_REGRIDMETHOD_CONSERVE, & - normType=ESMF_NORMTYPE_FRACAREA, & + srcMaskValues=(/srcMaskValue/), & + dstMaskValues=(/dstMaskValue/), & + regridmethod=ESMF_REGRIDMETHOD_CONSERVE, & + normType=ESMF_NORMTYPE_FRACAREA, & srcTermProcessing=srcTermProcessing_Value, & - ignoreDegenerate=.true., & - dstStatusField=lfield, & - unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & - rc=rc) + ignoreDegenerate=.true., & + dstStatusField=lfield, & + unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return else if (mapindex == mapconsf_aofrac) then - if (.not. ESMF_RouteHandleIsCreated(routehandles(mapconsf))) then - if (maintask) then - write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//' for '//trim(string) - end if - call ESMF_FieldRegridStore(fldsrc, flddst, routehandle=routehandles(mapconsf_aofrac), & - srcMaskValues=(/srcMaskValue/), & - dstMaskValues=(/dstMaskValue/), & - regridmethod=ESMF_REGRIDMETHOD_CONSERVE, & - normType=ESMF_NORMTYPE_FRACAREA, & - srcTermProcessing=srcTermProcessing_Value, & - ignoreDegenerate=.true., & - dstStatusField=lfield, & - unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & - rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - else - ! Copy existing consf RH - if (maintask) then - write(logunit,'(A)') trim(subname)//' copying RH(mapconsf) to '//trim(mapname)//' for '//trim(string) - end if - routehandles(mapconsf_aofrac) = ESMF_RouteHandleCreate(routehandles(mapconsf), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + if (maintask) then + write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//' for '//trim(string) end if + call ESMF_FieldRegridStore(fldsrc, flddst, routehandle=routehandles(mapconsf_aofrac), & + srcMaskValues=(/srcMaskValue/), & + dstMaskValues=(/dstMaskValue/), & + regridmethod=ESMF_REGRIDMETHOD_CONSERVE, & + normType=ESMF_NORMTYPE_FRACAREA, & + srcTermProcessing=srcTermProcessing_Value, & + ignoreDegenerate=.true., & + dstStatusField=lfield, & + unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else if (mapindex == mapconsf_uv3d) then + if (maintask) then + write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//' for '//trim(string) + end if + call ESMF_FieldRegridStore(fldsrc, flddst, routehandle=routehandles(mapconsf_uv3d), & + srcMaskValues=(/srcMaskValue/), & + dstMaskValues=(/dstMaskValue/), & + regridmethod=ESMF_REGRIDMETHOD_CONSERVE, & + normType=ESMF_NORMTYPE_FRACAREA, & + srcTermProcessing=srcTermProcessing_Value, & + ignoreDegenerate=.true., & + dstStatusField=lfield, & + unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return else if (mapindex == mapconsd .or. mapindex == mapnstod_consd) then if (maintask) then write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//' for '//trim(string) end if call ESMF_FieldRegridStore(fldsrc, flddst, routehandle=routehandles(mapconsd), & - srcMaskValues=(/srcMaskValue/), & - dstMaskValues=(/dstMaskValue/), & - regridmethod=ESMF_REGRIDMETHOD_CONSERVE, & - normType=ESMF_NORMTYPE_DSTAREA, & + srcMaskValues=(/srcMaskValue/), & + dstMaskValues=(/dstMaskValue/), & + regridmethod=ESMF_REGRIDMETHOD_CONSERVE, & + normType=ESMF_NORMTYPE_DSTAREA, & srcTermProcessing=srcTermProcessing_Value, & - ignoreDegenerate=.true., & - dstStatusField=lfield, & - unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & - rc=rc) + ignoreDegenerate=.true., & + dstStatusField=lfield, & + unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - else if (mapindex == mappatch .or. mapindex == mappatch_uv3d) then - if (.not. ESMF_RouteHandleIsCreated(routehandles(mappatch))) then - if (maintask) then - write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//' for '//trim(string) - end if - call ESMF_FieldRegridStore(fldsrc, flddst, routehandle=routehandles(mappatch), & - srcMaskValues=(/srcMaskValue/), & - dstMaskValues=(/dstMaskValue/), & - regridmethod=ESMF_REGRIDMETHOD_PATCH, & - polemethod=polemethod, & - srcTermProcessing=srcTermProcessing_Value, & - ignoreDegenerate=.true., & - dstStatusField=lfield, & - unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + else if (mapindex == mappatch ) then + if (maintask) then + write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//' for '//trim(string) end if + call ESMF_FieldRegridStore(fldsrc, flddst, routehandle=routehandles(mappatch), & + srcMaskValues=(/srcMaskValue/), & + dstMaskValues=(/dstMaskValue/), & + regridmethod=ESMF_REGRIDMETHOD_PATCH, & + polemethod=polemethod, & + srcTermProcessing=srcTermProcessing_Value, & + ignoreDegenerate=.true., & + dstStatusField=lfield, & + unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else if (mapindex == mappatch_uv3d ) then + if (maintask) then + write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//' for '//trim(string) + end if + call ESMF_FieldRegridStore(fldsrc, flddst, routehandle=routehandles(mappatch_uv3d), & + srcMaskValues=(/srcMaskValue/), & + dstMaskValues=(/dstMaskValue/), & + regridmethod=ESMF_REGRIDMETHOD_PATCH, & + polemethod=polemethod, & + srcTermProcessing=srcTermProcessing_Value, & + ignoreDegenerate=.true., & + dstStatusField=lfield, & + unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return else call shr_log_error(trim(subname)//' mapindex '//trim(mapname)//' not supported for '//trim(string), & line=__LINE__, file=u_FILE_u, rc=rc) @@ -922,7 +948,7 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, use_data, field_ use ESMF , only : ESMF_KIND_R8 use ESMF , only : ESMF_Region_Flag, ESMF_REGION_SELECT, ESMF_REGION_TOTAL use med_internalstate_mod , only : nmappers, mapfcopy - use med_internalstate_mod , only : mappatch_uv3d, mappatch, mapbilnr_uv3d, mapbilnr + use med_internalstate_mod , only : mappatch_uv3d, mappatch, mapbilnr_uv3d, mapconsf_uv3d, mapbilnr use med_internalstate_mod , only : packed_data_type use med_methods_mod , only : Field_diagnose => med_methods_Field_diagnose @@ -1005,15 +1031,18 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, use_data, field_ if (mapindex == mappatch_uv3d) then ! For mappatch_uv3d do not use packed field bundles - call med_map_uv_cart3d(FBsrc, FBdst, routehandles, mappatch, rc=rc) + call med_map_uv_cart3d(FBsrc, FBdst, routehandles, mappatch_uv3d, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return else if (mapindex == mapbilnr_uv3d) then ! For mapbilnr_uv3d do not use packed field bundles - call med_map_uv_cart3d(FBsrc, FBdst, routehandles, mapbilnr, rc=rc) + call med_map_uv_cart3d(FBsrc, FBdst, routehandles, mapbilnr_uv3d, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + ! For mapconsf_uv3d do not use packed field bundles + call med_map_uv_cart3d(FBsrc, FBdst, routehandles, mapconsf_uv3d, map_stress=.true., rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return else ! ----------------------------------- @@ -1454,7 +1483,7 @@ subroutine med_map_field(field_src, field_dst, routehandles, maptype, fldname, z end subroutine med_map_field !================================================================================ - subroutine med_map_uv_cart3d(FBsrc, FBdst, routehandles, mapindex, rc) + subroutine med_map_uv_cart3d(FBsrc, FBdst, routehandles, mapindex, map_stress, rc) use ESMF , only : ESMF_Mesh, ESMF_MeshGet, ESMF_MESHLOC_ELEMENT, ESMF_TYPEKIND_R8 use ESMF , only : ESMF_Field, ESMF_FieldCreate, ESMF_FieldGet @@ -1467,6 +1496,7 @@ subroutine med_map_uv_cart3d(FBsrc, FBdst, routehandles, mapindex, rc) type(ESMF_FieldBundle) , intent(inout) :: FBdst type(ESMF_RouteHandle) , intent(inout) :: routehandles(:) integer , intent(in) :: mapindex + logical, optional , intent(in) :: map_stress integer , intent(out) :: rc ! local variables @@ -1493,22 +1523,39 @@ subroutine med_map_uv_cart3d(FBsrc, FBdst, routehandles, mapindex, rc) integer :: spatialDim real(r8), parameter :: deg2rad = shr_const_pi/180.0_R8 ! deg to rads logical :: first_time = .true. + logical :: lmap_stress + character(len=CS) :: uname, vname character(len=*), parameter :: subname=' (med_map_mod:med_map_uv_cart3d) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS + lmap_stress = .false. + if (present(map_stress)) then + lmap_stress = map_stress + end if + + if (lmap_stress) then + ! Get fields for atm zonal and merid stresses + uname = 'Faxa_taux' + vname = 'Faxa_tauy' + else + ! Get fields for atm u,v velocities + uname = 'Sa_u' + vname = 'Sa_v' + end if + ! Get fields for atm u,v velocities - call ESMF_FieldBundleGet(FBSrc, fieldName='Sa_u', field=usrc, rc=rc) + call ESMF_FieldBundleGet(FBSrc, fieldName=trim(uname), field=usrc, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldBundleGet(FBDst, fieldName='Sa_u', field=udst, rc=rc) + call ESMF_FieldBundleGet(FBDst, fieldName=trim(uname), field=udst, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldBundleGet(FBSrc, fieldName='Sa_v', field=vsrc, rc=rc) + call ESMF_FieldBundleGet(FBSrc, fieldName=trim(vname), field=vsrc, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldBundleGet(FBDst, fieldName='Sa_v', field=vdst, rc=rc) + call ESMF_FieldBundleGet(FBDst, fieldName=trim(vname), field=vdst, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ! GET pointer to input u and v data source field data + ! Get pointer to input u and v data source field data call ESMF_FieldGet(usrc, farrayPtr=data_u_src, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldGet(vsrc, farrayPtr=data_v_src, rc=rc) From 80cdb4ab867c16dd7cfd69f1d1394f86634dae6e Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Wed, 26 Mar 2025 09:04:22 -0600 Subject: [PATCH 018/123] remove tab, fix typo --- mediator/med_map_mod.F90 | 2 +- mediator/med_phases_ocnalb_mod.F90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 0112bd57b..e3ae3ae99 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -474,7 +474,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, call ESMF_FieldRegridStore(fldsrc, flddst, routehandle=routehandles(mapbilnr), & srcMaskValues=(/srcMaskValue/), & dstMaskValues=(/dstMaskValue/), & - regridmethod=ESMF_REGRIDMETHOD_BILINEAR, & + regridmethod=ESMF_REGRIDMETHOD_BILINEAR, & polemethod=polemethod, & srcTermProcessing=srcTermProcessing_Value, & ignoreDegenerate=.true., & diff --git a/mediator/med_phases_ocnalb_mod.F90 b/mediator/med_phases_ocnalb_mod.F90 index 0a09c76aa..b7c95389a 100644 --- a/mediator/med_phases_ocnalb_mod.F90 +++ b/mediator/med_phases_ocnalb_mod.F90 @@ -519,7 +519,7 @@ subroutine med_phases_ocnalb_orbital_init(gcomp, logunit, maintask, rc) use ESMF , only : ESMF_GridComp, ESMF_GridCompGet use ESMF , only : ESMF_LogWrite, ESMF_LogFoundError, ESMF_LogSetError - use ESMF , only : ESMf_SUCCESS, ESMF_FAILURE, ESMF_LOGMSG_INFO, ESMF_RC_NOT_VALID + use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE, ESMF_LOGMSG_INFO, ESMF_RC_NOT_VALID use NUOPC , only : NUOPC_CompAttributeGet ! input/output variables From 72f8b4ca8b344176a65a3e5258455dbe45fecac0 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Thu, 27 Mar 2025 08:31:49 -0600 Subject: [PATCH 019/123] try updating some externals --- .github/workflows/srt.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 2983dea6f..8b11bfe12 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -27,8 +27,8 @@ 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.1 - PARALLELIO_VERSION: pio2_6_3 + ESMF_VERSION: v8.7.0 + PARALLELIO_VERSION: pio2_6_5 CIME_MODEL: cesm CIME_DRIVER: nuopc GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} From 46ca4c8953d1eb2740ba0dca1aa2689e6ae05de2 Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Thu, 27 Mar 2025 13:17:32 -0400 Subject: [PATCH 020/123] Sync ESCOMP/CMEPS (#135) --- .github/workflows/extbuild.yml | 8 +- .github/workflows/srt.yml | 3 +- cesm/driver/esm.F90 | 77 ++++---- cesm/driver/esm_time_mod.F90 | 47 +++-- cesm/flux_atmocn/shr_flux_mod.F90 | 7 +- cesm/nuopc_cap_share/driver_pio_mod.F90 | 10 +- cesm/nuopc_cap_share/seq_drydep_mod.F90 | 24 --- cesm/nuopc_cap_share/shr_drydep_mod.F90 | 30 +-- cime_config/buildnml | 2 + cime_config/config_component.xml | 10 + cime_config/namelist_definition_drv.xml | 7 +- cime_config/testdefs/testlist_drv.xml | 86 ++++----- mediator/esmFlds.F90 | 54 ++---- mediator/med.F90 | 43 ++--- mediator/med_diag_mod.F90 | 12 +- mediator/med_fraction_mod.F90 | 5 +- mediator/med_io_mod.F90 | 92 ++++------ mediator/med_map_mod.F90 | 27 ++- mediator/med_merge_mod.F90 | 74 ++++---- mediator/med_methods_mod.F90 | 231 +++++++++--------------- mediator/med_phases_aofluxes_mod.F90 | 19 +- mediator/med_phases_history_mod.F90 | 25 +-- mediator/med_phases_ocnalb_mod.F90 | 24 ++- mediator/med_phases_post_glc_mod.F90 | 10 +- mediator/med_phases_post_rof_mod.F90 | 7 +- mediator/med_phases_prep_glc_mod.F90 | 21 +-- mediator/med_phases_prep_ice_mod.F90 | 1 - mediator/med_phases_prep_lnd_mod.F90 | 2 +- mediator/med_phases_prep_ocn_mod.F90 | 2 - mediator/med_phases_prep_rof_mod.F90 | 17 +- mediator/med_phases_prep_wav_mod.F90 | 1 - mediator/med_phases_restart_mod.F90 | 20 +- 32 files changed, 442 insertions(+), 556 deletions(-) delete mode 100644 cesm/nuopc_cap_share/seq_drydep_mod.F90 diff --git a/.github/workflows/extbuild.yml b/.github/workflows/extbuild.yml index 24b18683d..f31f46bd4 100644 --- a/.github/workflows/extbuild.yml +++ b/.github/workflows/extbuild.yml @@ -20,11 +20,11 @@ jobs: CPPFLAGS: "-I/usr/include -I/usr/local/include" # Versions of all dependencies can be updated here - ESMF_VERSION: v8.6.1 - PNETCDF_VERSION: checkpoint.1.12.3 + ESMF_VERSION: v8.8.0 + PNETCDF_VERSION: checkpoint.1.14.0 NETCDF_FORTRAN_VERSION: v4.6.1 - PIO_VERSION: pio2_6_3 - CDEPS_VERSION: cdeps1.0.59 + PIO_VERSION: pio2_6_5 + CDEPS_VERSION: cdeps1.0.72 steps: - uses: actions/checkout@v4 # Build the ESMF library, if the cache contains a previous build diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index fc75ec263..2983dea6f 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -17,8 +17,9 @@ jobs: # The type of runner that the job will run on runs-on: ubuntu-latest strategy: + fail-fast: false matrix: - python-version: [ 3.x ] + python-version: [ 3.8, 3.11, 3.x ] env: CC: mpicc FC: mpifort diff --git a/cesm/driver/esm.F90 b/cesm/driver/esm.F90 index d357e9753..b2400a3ef 100644 --- a/cesm/driver/esm.F90 +++ b/cesm/driver/esm.F90 @@ -5,12 +5,11 @@ module ESM !----------------------------------------------------------------------------- use shr_kind_mod , only : r8=>shr_kind_r8, cl=>shr_kind_cl, cs=>shr_kind_cs - use shr_sys_mod , only : shr_sys_abort use shr_mpi_mod , only : shr_mpi_bcast use shr_mem_mod , only : shr_mem_init - use shr_log_mod , only : shr_log_setLogunit + use shr_log_mod , only : shr_log_setLogunit, shr_log_error use esm_utils_mod, only : logunit, maintask, dbug_flag, chkerr - + use esmf , only : ESMF_FAILURE implicit none private @@ -490,10 +489,14 @@ subroutine InitAttributes(driver, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (.not. shr_wv_sat_valid_idx(shr_wv_sat_get_scheme_idx(trim(wv_sat_scheme)))) then - call shr_sys_abort(subname//': "'//trim(wv_sat_scheme)//'" is not a recognized saturation vapor pressure scheme name') + call shr_log_error(subname//': "'//trim(wv_sat_scheme)//'" is not a recognized saturation vapor pressure scheme name') + rc = ESMF_FAILURE + return end if if (.not. shr_wv_sat_set_default(wv_sat_scheme)) then - call shr_sys_abort('Invalid wv_sat_scheme.') + call shr_log_error('Invalid wv_sat_scheme.') + rc = ESMF_FAILURE + return end if call NUOPC_CompAttributeGet(driver, name="wv_sat_transition_start", value=cvalue, rc=rc) @@ -522,7 +525,9 @@ subroutine InitAttributes(driver, rc) call shr_wv_sat_init(shr_const_tkfrz, shr_const_tktrip, wv_sat_transition_start, epsilo, errstring) if (errstring /= "") then - call shr_sys_abort('shr_wv_sat_init: '//trim(errstring)) + call shr_log_error('shr_wv_sat_init: '//trim(errstring)) + rc = ESMF_FAILURE + return end if ! The below produces internal lookup tables in the range 175-374K for @@ -567,7 +572,9 @@ subroutine CheckAttributes( driver, rc ) call NUOPC_CompAttributeGet(driver, name="cime_model", value=cime_model, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if ( trim(cime_model) /= 'cesm' .and. trim(cime_model) /= 'ufs') then - call shr_sys_abort( subname//': cime_model must be set to cesm or ufs, aborting') + call shr_log_error( subname//': cime_model must be set to cesm or ufs, aborting') + rc = ESMF_FAILURE + return end if ! --- LogFile ending name ----- @@ -575,7 +582,9 @@ subroutine CheckAttributes( driver, rc ) if (chkerr(rc,__LINE__,u_FILE_u)) return if ( len_trim(logFilePostFix) == 0 ) then - call shr_sys_abort( subname//': logFilePostFix must be set to something not blank' ) + call shr_log_error( subname//': logFilePostFix must be set to something not blank' ) + rc = ESMF_FAILURE + return end if ! --- Output path root directory ----- @@ -583,10 +592,14 @@ subroutine CheckAttributes( driver, rc ) if (chkerr(rc,__LINE__,u_FILE_u)) return if ( len_trim(outPathRoot) == 0 ) then - call shr_sys_abort( subname//': outPathRoot must be set' ) + call shr_log_error( subname//': outPathRoot must be set' ) + rc = ESMF_FAILURE + return end if if ( index(outPathRoot, "/", back=.true.) /= len_trim(outPathRoot) ) then - call shr_sys_abort( subname//': outPathRoot must end with a slash' ) + call shr_log_error( subname//': outPathRoot must end with a slash' ) + rc = ESMF_FAILURE + return end if end subroutine CheckAttributes @@ -1256,7 +1269,7 @@ subroutine esm_set_single_column_attributes(compname, gcomp, rc) if ( (scol_lon < scol_spval .and. scol_lat > scol_spval) .or. & (scol_lon > scol_spval .and. scol_lat < scol_spval)) then - call shr_sys_abort(subname//' ERROR: '//trim(compname)//' both scol_lon and scol_lat must be greater than -999 ') + call shr_log_error(subname//' ERROR: '//trim(compname)//' both scol_lon and scol_lat must be greater than -999 ') end if ! Set the special value for single column - if pts_lat or pts_lon are equal to the special value @@ -1271,7 +1284,7 @@ subroutine esm_set_single_column_attributes(compname, gcomp, rc) ! ATM, LND, OCN and ICE components only ! verify that WAV and LND are not trying to use single column mode if (trim(compname) == 'WAV' .or. trim(compname) == 'ROF' .or. trim(compname) == 'GLC') then - call shr_sys_abort(subname//' ERROR: '//trim(compname)//' does not support single column mode ') + call shr_log_error(subname//' ERROR: '//trim(compname)//' does not support single column mode ') end if ! ensure that single column mode is only run on 1 pet @@ -1280,7 +1293,7 @@ subroutine esm_set_single_column_attributes(compname, gcomp, rc) call ESMF_VMGet(vm, petcount=petcount, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (petcount > 1) then - call shr_sys_abort(subname//' ERROR: single column mode must be run on 1 pe') + call shr_log_error(subname//' ERROR: single column mode must be run on 1 pe') endif write(logunit,'(a,2(f10.5,2x))')trim(subname)//' single column point for '//trim(compname)//& @@ -1304,27 +1317,27 @@ subroutine esm_set_single_column_attributes(compname, gcomp, rc) ! the closest point in the domin file to scol_lon and scol_lat status = nf90_open(single_column_lnd_domainfile, NF90_NOWRITE, ncid) - if (status /= nf90_noerr) call shr_sys_abort (trim(subname) //': opening '//& + if (status /= nf90_noerr) call shr_log_error (trim(subname) //': opening '//& trim(single_column_lnd_domainfile)) status = nf90_inq_dimid (ncid, 'ni', dimid) - if (status /= nf90_noerr) call shr_sys_abort (trim(subname) //': inq_dimid ni') + if (status /= nf90_noerr) call shr_log_error (trim(subname) //': inq_dimid ni') status = nf90_inquire_dimension(ncid, dimid, len=ni) - if (status /= nf90_noerr) call shr_sys_abort (trim(subname) //': inquire_dimension ni') + if (status /= nf90_noerr) call shr_log_error (trim(subname) //': inquire_dimension ni') status = nf90_inq_dimid (ncid, 'nj', dimid) - if (status /= nf90_noerr) call shr_sys_abort (trim(subname) //': inq_dimid nj') + if (status /= nf90_noerr) call shr_log_error (trim(subname) //': inq_dimid nj') status = nf90_inquire_dimension(ncid, dimid, len=nj) - if (status /= nf90_noerr) call shr_sys_abort (trim(subname) //': inquire_dimension nj') + if (status /= nf90_noerr) call shr_log_error (trim(subname) //': inquire_dimension nj') status = nf90_inq_varid(ncid, 'xc' , varid_xc) - if (status /= nf90_noerr) call shr_sys_abort (subname//' inq_varid xc') + if (status /= nf90_noerr) call shr_log_error (subname//' inq_varid xc') status = nf90_inq_varid(ncid, 'yc' , varid_yc) - if (status /= nf90_noerr) call shr_sys_abort (subname//' inq_varid yc') + if (status /= nf90_noerr) call shr_log_error (subname//' inq_varid yc') status = nf90_inq_varid(ncid, 'area' , varid_area) - if (status /= nf90_noerr) call shr_sys_abort (subname//' inq_varid area') + if (status /= nf90_noerr) call shr_log_error (subname//' inq_varid area') status = nf90_inq_varid(ncid, 'mask' , varid_mask) - if (status /= nf90_noerr) call shr_sys_abort (subname//' inq_varid mask') + if (status /= nf90_noerr) call shr_log_error (subname//' inq_varid mask') status = nf90_inq_varid(ncid, 'frac' , varid_frac) - if (status /= nf90_noerr) call shr_sys_abort (subname//' inq_varid frac') + if (status /= nf90_noerr) call shr_log_error (subname//' inq_varid frac') ! Read in domain file for single column ! Check for unstructured data ni>1 and nj==1 @@ -1344,10 +1357,10 @@ subroutine esm_set_single_column_attributes(compname, gcomp, rc) start3=(/1,1,1/) count3=(/ni,nj,1/) status = nf90_get_var(ncid, varid_xc, glob_grid, start3, count3) - if (status /= nf90_noerr) call shr_sys_abort (subname//' get_var xc') + if (status /= nf90_noerr) call shr_log_error (subname//' get_var xc') lons(1:ni) = glob_grid(1:ni,1) status = nf90_get_var(ncid, varid_yc, glob_grid, start3, count3) - if (status /= nf90_noerr) call shr_sys_abort (subname//' get_var yc') + if (status /= nf90_noerr) call shr_log_error (subname//' get_var yc') if (unstructured) then lats(1:ni) = glob_grid(1:ni,1) else @@ -1379,31 +1392,31 @@ subroutine esm_set_single_column_attributes(compname, gcomp, rc) ! read in value of nearest neighbor lon and RESET scol_lon and scol_lat ! also get area of gridcell, mask and frac status = nf90_get_var(ncid, varid_xc, scol_lon, start) - if (status /= nf90_noerr) call shr_sys_abort (subname//' get_var xc') + if (status /= nf90_noerr) call shr_log_error (subname//' get_var xc') status = nf90_get_var(ncid, varid_yc, scol_lat, start) - if (status /= nf90_noerr) call shr_sys_abort (subname//' get_var yc') + if (status /= nf90_noerr) call shr_log_error (subname//' get_var yc') status = nf90_get_var(ncid, varid_area, scol_area, start) - if (status /= nf90_noerr) call shr_sys_abort (subname//' get_var area') + if (status /= nf90_noerr) call shr_log_error (subname//' get_var area') status = nf90_get_var(ncid, varid_mask, iscol_data, start) - if (status /= nf90_noerr) call shr_sys_abort (subname//' get_var mask') + if (status /= nf90_noerr) call shr_log_error (subname//' get_var mask') scol_lndmask = iscol_data(1) scol_ocnmask = 1 - scol_lndmask status = nf90_get_var(ncid, varid_frac, scol_data, start) - if (status /= nf90_noerr) call shr_sys_abort (subname//' get_var frac') + if (status /= nf90_noerr) call shr_log_error (subname//' get_var frac') scol_lndfrac = scol_data(1) scol_ocnfrac = 1._r8 - scol_lndfrac if (scol_ocnmask == 0 .and. scol_lndmask == 0) then - call shr_sys_abort(trim(subname)//' in single column mode '& + call shr_log_error(trim(subname)//' in single column mode '& //' ocean and land mask cannot both be zero') end if status = nf90_close(ncid) - if (status /= nf90_noerr) call shr_sys_abort (trim(subname) //': closing '//& + if (status /= nf90_noerr) call shr_log_error (trim(subname) //': closing '//& trim(single_column_lnd_domainfile)) ! Now read in mesh file to get exact values of scol_lon and scol_lat that will be used diff --git a/cesm/driver/esm_time_mod.F90 b/cesm/driver/esm_time_mod.F90 index c423b96fc..f5a2107b0 100644 --- a/cesm/driver/esm_time_mod.F90 +++ b/cesm/driver/esm_time_mod.F90 @@ -1,15 +1,16 @@ module esm_time_mod use shr_kind_mod , only : cx=>shr_kind_cx, cs=>shr_kind_cs, cl=>shr_kind_cl, r8=>shr_kind_r8 + use shr_log_mod , only : shr_log_error use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_GridCompSet use ESMF , only : ESMF_Clock, ESMF_ClockCreate, ESMF_ClockGet, ESMF_ClockSet - use ESMF , only : ESMF_ClockAdvance + use ESMF , only : ESMF_ClockAdvance, ESMF_FAILURE use ESMF , only : ESMF_Alarm, ESMF_AlarmCreate, ESMF_AlarmGet use ESMF , only : ESMF_Calendar, ESMF_CalKind_Flag, ESMF_CalendarCreate use ESMF , only : ESMF_CALKIND_NOLEAP, ESMF_CALKIND_GREGORIAN use ESMF , only : ESMF_Time, ESMF_TimeGet, ESMF_TimeSet use ESMF , only : ESMF_TimeInterval, ESMF_TimeIntervalSet, ESMF_TimeIntervalGet - use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_FAILURE, ESMF_LOGMSG_ERROR + use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_FAILURE use ESMF , only : ESMF_VM, ESMF_VMGet, ESMF_VMBroadcast use ESMF , only : ESMF_VMAllReduce, ESMF_REDUCE_MAX, ESMF_ClockGetAlarm use ESMF , only : ESMF_LOGMSG_INFO, ESMF_FAILURE, ESMF_GridCompIsPetLocal @@ -140,25 +141,25 @@ subroutine esm_time_clockinit(ensemble_driver, instance_driver, logunit, maintas write(logunit,*) " read rpointer file = "//trim(restart_pfile) inquire( file=trim(restart_pfile), exist=exists) if (.not. exists) then + call shr_log_error( trim(subname)//' ERROR rpointer file '//trim(restart_pfile)//' not found',& + line=__LINE__, file=__FILE__) rc = ESMF_FAILURE - call ESMF_LogWrite(trim(subname)//' ERROR rpointer file '//trim(restart_pfile)//' not found', & - ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__) return endif call ESMF_LogWrite(trim(subname)//" read rpointer file = "//trim(restart_pfile), & ESMF_LOGMSG_INFO) open(newunit=unitn, file=restart_pfile, form='FORMATTED', status='old',iostat=ierr) if (ierr < 0) then + call shr_log_error( trim(subname)//' ERROR rpointer file open returns error', & + line=__LINE__, file=__FILE__) rc = ESMF_FAILURE - call ESMF_LogWrite(trim(subname)//' ERROR rpointer file open returns error', & - ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__) return end if read(unitn,'(a)', iostat=ierr) restart_file if (ierr < 0) then + call shr_log_error( trim(subname)//' ERROR rpointer file read returns error', & + line=__LINE__, file=__FILE__) rc = ESMF_FAILURE - call ESMF_LogWrite(trim(subname)//' ERROR rpointer file read returns error', & - ESMF_LOGMSG_INFO, line=__LINE__, file=__FILE__) return end if close(unitn) @@ -372,66 +373,76 @@ subroutine esm_time_read_restart(restart_file, start_ymd, start_tod, curr_ymd, c rc = ESMF_SUCCESS status = nf90_open(restart_file, NF90_NOWRITE, ncid) if (status /= nf90_NoErr) then - call ESMF_LogWrite(trim(subname)//' ERROR: nf90_open: '//trim(restart_file), ESMF_LOGMSG_ERROR) + call shr_log_error( trim(subname)//' ERROR: nf90_open: '//trim(restart_file),& + file=__FILE__, line=__LINE__) rc = ESMF_FAILURE return endif status = nf90_inq_varid(ncid, 'start_ymd', varid) if (status /= nf90_NoErr) then - call ESMF_LogWrite(trim(subname)//' ERROR: nf90_inq_varid start_ymd', ESMF_LOGMSG_ERROR) + call shr_log_error( trim(subname)//' ERROR: nf90_inq_varid start_ymd', & + file=__FILE__, line=__LINE__) rc = ESMF_FAILURE return end if status = nf90_get_var(ncid, varid, start_ymd) if (status /= nf90_NoErr) then - call ESMF_LogWrite(trim(subname)//' ERROR: nf90_get_var start_ymd', ESMF_LOGMSG_ERROR) + call shr_log_error( trim(subname)//' ERROR: nf90_get_var start_ymd', & + file=__FILE__, line=__LINE__) rc = ESMF_FAILURE return end if status = nf90_inq_varid(ncid, 'start_tod', varid) if (status /= nf90_NoErr) then - call ESMF_LogWrite(trim(subname)//' ERROR: nf90_inq_varid start_tod', ESMF_LOGMSG_ERROR) + call shr_log_error( trim(subname)//' ERROR: nf90_inq_varid start_tod', & + file=__FILE__, line=__LINE__) rc = ESMF_FAILURE return end if status = nf90_get_var(ncid, varid, start_tod) if (status /= nf90_NoErr) then - call ESMF_LogWrite(trim(subname)//' ERROR: nf90_get_var start_tod', ESMF_LOGMSG_ERROR) + call shr_log_error( trim(subname)//' ERROR: nf90_get_var start_tod', & + file=__FILE__, line=__LINE__) rc = ESMF_FAILURE return end if status = nf90_inq_varid(ncid, 'curr_ymd', varid) if (status /= nf90_NoErr) then - call ESMF_LogWrite(trim(subname)//' ERROR: nf90_inq_varid curr_ymd', ESMF_LOGMSG_ERROR) + call shr_log_error( trim(subname)//' ERROR: nf90_inq_varid curr_ymd', & + file=__FILE__, line=__LINE__) rc = ESMF_FAILURE return end if status = nf90_get_var(ncid, varid, curr_ymd) if (status /= nf90_NoErr) then - call ESMF_LogWrite(trim(subname)//' ERROR: nf90_get_var curr_ymd', ESMF_LOGMSG_ERROR) + call shr_log_error( trim(subname)//' ERROR: nf90_get_var curr_ymd', & + file=__FILE__, line=__LINE__) rc = ESMF_FAILURE return end if status = nf90_inq_varid(ncid, 'curr_tod', varid) if (status /= nf90_NoErr) then - call ESMF_LogWrite(trim(subname)//' ERROR: nf90_inq_varid curr_tod', ESMF_LOGMSG_ERROR) + call shr_log_error( trim(subname)//' ERROR: nf90_inq_varid curr_tod', & + file=__FILE__, line=__LINE__) rc = ESMF_FAILURE return end if status = nf90_get_var(ncid, varid, curr_tod) if (status /= nf90_NoErr) then - call ESMF_LogWrite(trim(subname)//' ERROR: nf90_get_var curr_tod', ESMF_LOGMSG_ERROR) + call shr_log_error( trim(subname)//' ERROR: nf90_get_var curr_tod', & + file=__FILE__, line=__LINE__) rc = ESMF_FAILURE return end if status = nf90_close(ncid) if (status /= nf90_NoErr) then - call ESMF_LogWrite(trim(subname)//' ERROR: nf90_close', ESMF_LOGMSG_ERROR) + call shr_log_error( trim(subname)//' ERROR: nf90_close', & + file=__FILE__, line=__LINE__) rc = ESMF_FAILURE return end if diff --git a/cesm/flux_atmocn/shr_flux_mod.F90 b/cesm/flux_atmocn/shr_flux_mod.F90 index d86805a5b..c40c4d732 100644 --- a/cesm/flux_atmocn/shr_flux_mod.F90 +++ b/cesm/flux_atmocn/shr_flux_mod.F90 @@ -5,9 +5,10 @@ module shr_flux_mod ! !USES: use shr_kind_mod, only : R8=>SHR_KIND_R8, IN=>SHR_KIND_IN ! shared kinds - use shr_const_mod ! shared constants - use shr_sys_mod ! shared system routines - + use shr_const_mod, only : shr_const_zvir, shr_const_cpdair, shr_const_cpvir, shr_const_karman, shr_const_g ! shared constants + use shr_const_mod, only : shr_const_latvap, shr_const_latice, shr_const_stebol, shr_const_tkfrz, shr_const_pi, shr_const_spval + use shr_const_mod, only : shr_const_ocn_ref_sal, shr_const_zsrflyr, shr_const_rgas + use shr_sys_mod, only : shr_sys_abort ! shared system routines implicit none private ! default private diff --git a/cesm/nuopc_cap_share/driver_pio_mod.F90 b/cesm/nuopc_cap_share/driver_pio_mod.F90 index 710373ed9..311387d08 100644 --- a/cesm/nuopc_cap_share/driver_pio_mod.F90 +++ b/cesm/nuopc_cap_share/driver_pio_mod.F90 @@ -6,8 +6,8 @@ module driver_pio_mod use pio , only : pio_set_blocksize, pio_set_buffer_size_limit, pio_finalize use shr_pio_mod, only : io_compname, pio_comp_settings, iosystems, io_compid, shr_pio_getindex use shr_kind_mod, only : CS=>shr_kind_CS, shr_kind_cl, shr_kind_in - use shr_log_mod, only : shr_log_getLogUnit - use shr_sys_mod, only : shr_sys_abort + use shr_log_mod, only : shr_log_getLogUnit, shr_log_error + #ifndef NO_MPI2 use mpi, only : mpi_comm_null, mpi_comm_world, mpi_finalize #endif @@ -424,7 +424,8 @@ subroutine driver_pio_component_init(driver, inst_comm, asyncio_petlist, rc) call MPI_AllReduce(MPI_IN_PLACE, comp_proc_list(:,i), maxprocspercomp, MPI_INTEGER, MPI_MAX, Inst_comm, ierr) enddo if(asyncio_ntasks == 0) then - call shr_sys_abort(subname//' ERROR: ASYNC IO Requested but no IO PES assigned') + call shr_log_error(subname//' ERROR: ASYNC IO Requested but no IO PES assigned', rc=rc) + return endif allocate(async_iosystems(do_async_init)) @@ -440,7 +441,8 @@ subroutine driver_pio_component_init(driver, inst_comm, asyncio_petlist, rc) async_rearr = pio_comp_settings(i)%pio_rearranger elseif(async_rearr .ne. pio_comp_settings(i)%pio_rearranger .and. pio_comp_settings(i)%pio_rearranger > 0) then write(msgstr,*) i,async_rearr,pio_comp_settings(i)%pio_rearranger - call shr_sys_abort(subname//' ERROR: all async component rearrangers must match '//msgstr) + call shr_log_error( subname//' ERROR: all async component rearrangers must match '//msgstr, rc=rc) + return endif endif endif diff --git a/cesm/nuopc_cap_share/seq_drydep_mod.F90 b/cesm/nuopc_cap_share/seq_drydep_mod.F90 deleted file mode 100644 index 3d6c292ee..000000000 --- a/cesm/nuopc_cap_share/seq_drydep_mod.F90 +++ /dev/null @@ -1,24 +0,0 @@ -module seq_drydep_mod - - use shr_drydep_mod, only: seq_drydep_setHCoeff=>shr_drydep_setHCoeff - implicit none - - ! method specification - character(len=*), parameter :: DD_XLND = 'xactive_lnd' ! dry-dep land - character(len=*), parameter :: drydep_method = DD_XLND ! XLND is the only option now - logical, protected :: lnd_drydep - -contains - - subroutine seq_drydep_readnl(NLFilename, drydep_nflds) - - character(len=*), intent(in) :: NLFilename ! Namelist filename - integer, intent(out) :: drydep_nflds - - call shr_drydep_readnl(NLFilename, drydep_nflds) - - lnd_drydep = drydep_nflds>0 - - end subroutine seq_drydep_readnl - -end module seq_drydep_mod diff --git a/cesm/nuopc_cap_share/shr_drydep_mod.F90 b/cesm/nuopc_cap_share/shr_drydep_mod.F90 index 7f3af4131..aca37e168 100644 --- a/cesm/nuopc_cap_share/shr_drydep_mod.F90 +++ b/cesm/nuopc_cap_share/shr_drydep_mod.F90 @@ -292,7 +292,7 @@ subroutine shr_drydep_readnl(NLFilename, drydep_nflds) ! Note that ierr /= 0, no namelist is present. read(unitn, drydep_inparm, iostat=ierr) if (ierr > 0) then - call shr_sys_abort( 'problem on read of drydep_inparm namelist in shr_drydep_readnl') + call shr_sys_abort( 'problem on read of drydep_inparm namelist in shr_drydep_readnl', rc=ierr) end if endif close( unitn ) @@ -374,19 +374,19 @@ subroutine shr_drydep_init( ) if (localPet==0) then rc = nf90_open(path=trim(dep_data_file), mode=nf90_nowrite, ncid=fileid) - if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: not able to open file: '//trim(dep_data_file)) + if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: not able to open file: '//trim(dep_data_file), rc=rc) rc = nf90_inq_dimid(fileid,'n_species_table',dimid) - if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_inq_dimid n_species_table') + if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_inq_dimid n_species_table', rc=rc) rc = nf90_inquire_dimension(fileid,dimid,len=bint(1)) - if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_inquire_dimension n_species_table') + if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_inquire_dimension n_species_table', rc=rc) rc = nf90_inq_dimid(fileid,'NHen',dimid) - if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_inq_dimid NHen') + if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_inq_dimid NHen', rc=rc) rc = nf90_inquire_dimension(fileid,dimid,len=bint(2)) - if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_inquire_dimension nHen') + if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_inquire_dimension nHen', rc=rc) endif write(msg,*) subname//' bcast n_species_table', localPet, bint call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO) @@ -404,27 +404,27 @@ subroutine shr_drydep_init( ) dptr => dheff(:,1) if (localPet==0) then rc = nf90_inq_varid(fileid,'mol_wghts',varid) - if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_inq_varid mol_wghts') + if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_inq_varid mol_wghts', rc=rc) rc = nf90_get_var(fileid,varid,mol_wgts) - if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_get_var mol_wgts') + if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_get_var mol_wgts', rc=rc) rc = nf90_inq_varid(fileid,'dfoxd',varid) - if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_inq_varid dfoxd') + if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_inq_varid dfoxd', rc=rc) rc = nf90_get_var(fileid,varid,dfoxd) - if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_get_var dfoxd') + if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_get_var dfoxd', rc=rc) rc = nf90_inq_varid(fileid,'species_name_table',varid) - if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_inq_varid species_name_table') + if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_inq_varid species_name_table', rc=rc) rc = nf90_get_var(fileid,varid,species_name_table) - if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_get_var species_name_table') + if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_get_var species_name_table', rc=rc) rc = nf90_inq_varid(fileid,'dheff',varid) - if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_inq_varid dheff') + if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_inq_varid dheff', rc=rc) rc = nf90_get_var(fileid,varid,dheff) - if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_get_var dheff') + if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_get_var dheff', rc=rc) rc = nf90_close(fileid) - if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_close') + if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_close', rc=rc) end if call ESMF_LogWrite(subname//' bcast mol_wgts', ESMF_LOGMSG_INFO) call ESMF_VMBroadcast(vm, mol_wgts, n_species_table, 0, rc=rc ) diff --git a/cime_config/buildnml b/cime_config/buildnml index 40b726e09..7ffc28f82 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -44,6 +44,8 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): config["MPILIB"] = case.get_value("MPILIB") config["OS"] = case.get_value("OS") config["TESTCASE"] = case.get_value("TESTCASE") + if not config["TESTCASE"]: + config["TESTCASE"] = "UNSET" config["glc_nec"] = ( 0 if case.get_value("GLC_NEC") == 0 else case.get_value("GLC_NEC") ) diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index 8d5cb5dda..ae6981fc4 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -568,6 +568,16 @@ If TRUE, short term archiving will be turned on. + + logical + TRUE,FALSE + FALSE + run_data_archive + env_run.xml + Logical to run post-processing analysis tools. + If TRUE, post-processing scripts will be run + + integer 900 diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 8835c53b8..bf4c17ccb 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -431,7 +431,7 @@ if true, mediator is present in run - + char expdef ALLCOMP_attributes @@ -439,7 +439,7 @@ Model version - unknown + $MODEL_VERSION @@ -910,13 +910,14 @@ ogrid,agrid,xgrid Grid for atm ocn flux calc - default: ogrid + default: xgrid for fully coupled cases, ogrid for datm xgrid ogrid + ogrid diff --git a/cime_config/testdefs/testlist_drv.xml b/cime_config/testdefs/testlist_drv.xml index 948bd267b..fd1ad7ac6 100644 --- a/cime_config/testdefs/testlist_drv.xml +++ b/cime_config/testdefs/testlist_drv.xml @@ -42,44 +42,11 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + @@ -88,7 +55,7 @@ - + @@ -102,7 +69,7 @@ - + @@ -111,7 +78,7 @@ - + @@ -120,7 +87,7 @@ - + @@ -134,7 +101,7 @@ - + @@ -143,7 +110,7 @@ - + @@ -152,7 +119,7 @@ - + @@ -210,7 +177,7 @@ - + @@ -247,6 +214,39 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -292,7 +292,7 @@ - + diff --git a/mediator/esmFlds.F90 b/mediator/esmFlds.F90 index bcb3d5471..7a2959f4c 100644 --- a/mediator/esmFlds.F90 +++ b/mediator/esmFlds.F90 @@ -1,9 +1,10 @@ module esmflds - use ESMF, only : ESMF_SUCCESS, ESMF_FAILURE, ESMF_LOGMSG_ERROR, ESMF_LOGWRITE + use ESMF, only : ESMF_SUCCESS, ESMF_FAILURE, ESMF_LOGWRITE use med_kind_mod, only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use med_internalstate_mod, only : compname, compocn, compatm, compice, comprof use med_internalstate_mod, only : mapfcopy, mapnames, mapunset use med_utils_mod , only : chkerr => med_utils_ChkErr + use shr_log_mod , only : shr_log_error implicit none private @@ -313,9 +314,7 @@ end subroutine med_fldList_AddMrg !================================================================================ function med_fldList_GetFld(fields, fldname, rc) result(newfld) - use ESMF, only : ESMF_LogWrite, ESMF_LOGMSG_ERROR, ESMF_LOGMSG_INFO - use ESMF, only : ESMF_FINALIZE, ESMF_END_ABORT - + use ESMF, only : ESMF_LogWrite, ESMF_LOGMSG_INFO type(med_fldList_entry_type) , intent(in), target :: fields character(len=*) , intent(in) :: fldname @@ -336,8 +335,8 @@ function med_fldList_GetFld(fields, fldname, rc) result(newfld) write(6,*) trim(subname)//' input flds entry is ',trim(newfld%stdname) newfld => newfld%next end do - call ESMF_LogWrite(subname // 'ERROR: fldname '// trim(fldname) // ' not found in input flds', ESMF_LOGMSG_ERROR) - call ESMF_Finalize(endflag=ESMF_END_ABORT) + call shr_log_error(subname // 'ERROR: fldname '// trim(fldname) // ' not found in input flds', rc=rc) + return endif end function med_fldList_GetFld @@ -385,9 +384,6 @@ end subroutine med_fldList_addmap_ocnalb !================================================================================ subroutine med_fldList_AddMap(fields, fldname, destcomp, maptype, mapnorm, mapfile) - - use ESMF, only : ESMF_LOGMSG_ERROR, ESMF_FAILURE, ESMF_LogWrite, ESMF_LOGMSG_INFO - ! intput/output variables type(med_fldList_entry_type) , intent(in), target :: fields character(len=*) , intent(in) :: fldname @@ -439,7 +435,7 @@ subroutine med_fldList_Realize(state, fldList, flds_scalar_name, flds_scalar_num use ESMF , only : ESMF_MeshLoc_Element, ESMF_FieldCreate, ESMF_TYPEKIND_R8 use ESMF , only : ESMF_MAXSTR, ESMF_Field, ESMF_State, ESMF_Grid, ESMF_Mesh use ESMF , only : ESMF_StateGet, ESMF_LogFoundError - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_ERROR, ESMF_FAILURE, ESMF_LOGERR_PASSTHRU + use ESMF , only : ESMF_LogWrite, ESMF_FAILURE, ESMF_LOGERR_PASSTHRU use ESMF , only : ESMF_LOGMSG_INFO, ESMF_StateRemove, ESMF_SUCCESS use ESMF , only : ESMF_STATEINTENT_IMPORT, ESMF_STATEINTENT_EXPORT, ESMF_StateIntent_Flag use ESMF , only : ESMF_RC_ARG_BAD, ESMF_LogSetError, operator(==) @@ -472,9 +468,8 @@ subroutine med_fldList_Realize(state, fldList, flds_scalar_name, flds_scalar_num rc = ESMF_SUCCESS if (present(grid) .and. present(mesh)) then - call ESMF_LogWrite(trim(subname)//trim(tag)//": ERROR both grid and mesh not allowed", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=rc) - rc = ESMF_FAILURE + call shr_log_error(trim(subname)//trim(tag)//": ERROR both grid and mesh not allowed", & + line=__LINE__, file=u_FILE_u, rc=rc) return endif @@ -575,9 +570,8 @@ subroutine med_fldList_Realize(state, fldList, flds_scalar_name, flds_scalar_num field = ESMF_FieldCreate(mesh, ESMF_TYPEKIND_R8, name=shortname, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return else - call ESMF_LogWrite(trim(subname)//trim(tag)//": ERROR grid or mesh expected", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) - rc = ESMF_FAILURE + call shr_log_error(trim(subname)//trim(tag)//": ERROR grid or mesh expected", & + line=__LINE__, file=u_FILE_u, rc=rc) return endif @@ -676,8 +670,7 @@ subroutine med_fldList_GetFldInfo(fldList, fldindex, compsrc, stdname, shortname newfld => newfld%next enddo if( .not. associated(newfld)) then - call ESMF_LogWrite(subname//' No field found', ESMF_LOGMSG_ERROR) - if(present(rc)) rc = ESMF_FAILURE + call shr_log_error(subname//' No field found', rc=rc) return endif call med_fld_GetFldInfo(newfld, compsrc, stdname, shortname, mapindex, mapFile, mapnorm, merge_fields, merge_type, merge_fracname, rc) @@ -719,39 +712,31 @@ subroutine med_fld_GetFldInfo(newfld, compsrc, stdname, shortname, mapindex, map endif if(present(mapindex)) then - if(lcompsrc < 0) call med_fldList_compsrcerror(lrc) + if(lcompsrc < 0) call shr_log_error("In med_fld_GetFldInfo mapindex requiring compsrc was requested but compsrc was not provided. ", rc=lrc) mapindex = newfld%mapindex(lcompsrc) endif if(present(mapfile)) then - if(lcompsrc < 0) call med_fldList_compsrcerror(lrc) + if(lcompsrc < 0) call shr_log_error("In med_fld_GetFldInfo mapfile requiring compsrc was requested but compsrc was not provided. ", rc=lrc) mapfile = newfld%mapfile(lcompsrc) endif if(present(mapnorm)) then - if(lcompsrc < 0) call med_fldList_compsrcerror(lrc) + if(lcompsrc < 0) call shr_log_error("In med_fld_GetFldInfo mapnorm requiring compsrc was requested but compsrc was not provided. ", rc=lrc) mapnorm = newfld%mapnorm(lcompsrc) endif if(present(merge_fields)) then - if(lcompsrc < 0) call med_fldList_compsrcerror(lrc) + if(lcompsrc < 0) call shr_log_error("In med_fld_GetFldInfo merge_fields requiring compsrc was requested but compsrc was not provided. ", rc=lrc) merge_fields = newfld%merge_fields(lcompsrc) endif if(present(merge_type)) then - if(lcompsrc < 0) call med_fldList_compsrcerror(lrc) + if(lcompsrc < 0) call shr_log_error("In med_fld_GetFldInfo merge_type requiring compsrc was requested but compsrc was not provided. ", rc=lrc) merge_type = newfld%merge_types(lcompsrc) endif if(present(merge_fracname)) then - if(lcompsrc < 0) call med_fldList_compsrcerror(lrc) + if(lcompsrc < 0) call shr_log_error("In med_fld_GetFldInfo merge_fracname requiring compsrc was requested but compsrc was not provided. ", rc=lrc) merge_fracname = newfld%merge_fracnames(lcompsrc) endif if(present(rc)) rc=lrc - contains - subroutine med_fldList_compsrcerror(rc) - integer, intent(out) :: rc - call ESMF_LogWrite("In med_fld_GetFldInfo a field requiring compsrc was requested but compsrc was not provided. ", & - ESMF_LOGMSG_ERROR) - rc = ESMF_FAILURE - return - end subroutine med_fldList_compsrcerror end subroutine med_fld_GetFldInfo !================================================================================ @@ -778,7 +763,7 @@ end function med_fldList_GetNumFlds subroutine med_fldList_GetFldNames(fields, fldnames, rc) - use ESMF, only : ESMF_LOGMSG_ERROR, ESMF_FAILURE, ESMF_SUCCESS, ESMF_LogWrite + use ESMF, only : ESMF_SUCCESS ! input/output variables type(med_fldList_entry_type) , intent(in), target :: fields @@ -794,8 +779,7 @@ subroutine med_fldList_GetFldNames(fields, fldnames, rc) if(present(rc)) rc = ESMF_SUCCESS if (.not. associated(fldnames) .or. .not. allocated(fields%mapindex)) then write(msg, *) "med_fldList_GetFldNames: ERROR either fields or fldnames have not been allocated. ",associated(fldnames), allocated(fields%mapindex) - call ESMF_LogWrite(msg, ESMF_LOGMSG_ERROR) - if(present(rc)) rc = ESMF_FAILURE + call shr_log_error(msg, rc=rc) return endif n = 0 diff --git a/mediator/med.F90 b/mediator/med.F90 index 89cc2f917..7f5151c96 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -51,7 +51,8 @@ module MED use esmFldsExchange_cesm_mod , only : esmFldsExchange_cesm use esmFldsExchange_hafs_mod , only : esmFldsExchange_hafs use med_phases_profile_mod , only : med_phases_profile_finalize - + use shr_log_mod , only : shr_log_error + implicit none private @@ -672,7 +673,7 @@ subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc) use ESMF , only : ESMF_GridComp, ESMF_State, ESMF_Clock, ESMF_SUCCESS, ESMF_LogFoundAllocError use ESMF , only : ESMF_StateIsCreated use ESMF , only : ESMF_LogMsg_Info, ESMF_LogWrite - use ESMF , only : ESMF_END_ABORT, ESMF_Finalize, ESMF_MAXSTR + use ESMF , only : ESMF_MAXSTR use NUOPC , only : NUOPC_AddNamespace, NUOPC_Advertise, NUOPC_AddNestedState use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_CompAttributeSet, NUOPC_CompAttributeAdd use esmFlds, only : med_fldlist_init1, med_fld_GetFldInfo, med_fldList_entry_type @@ -800,8 +801,8 @@ subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc) call NUOPC_CompAttributeGet(gcomp, name='aoflux_ccpp_suite', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (.not. isPresent .and. .not. isSet) then - call ESMF_LogWrite("aoflux_ccpp_suite need to be provided when aoflux_code is set to 'ccpp'", ESMF_LOGMSG_INFO) - call ESMF_Finalize(endflag=ESMF_END_ABORT) + call shr_log_error("aoflux_ccpp_suite need to be provided when aoflux_code is set to 'ccpp'", rc=rc) + return end if aoflux_ccpp_suite = trim(cvalue) if (maintask) then @@ -839,8 +840,8 @@ subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc) call esmFldsExchange_hafs(gcomp, phase='advertise', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call ESMF_LogWrite(trim(coupling_mode)//' is not a valid coupling_mode', ESMF_LOGMSG_INFO) - call ESMF_Finalize(endflag=ESMF_END_ABORT) + call shr_log_error(trim(coupling_mode)//' is not a valid coupling_mode', rc=rc) + return end if ! Set default masking for mapping @@ -1103,7 +1104,7 @@ subroutine realizeConnectedGrid(State,string,rc) use ESMF , only : ESMF_MAXSTR, ESMF_FieldStatus_Flag, ESMF_GeomType_Flag, ESMF_StateGet use ESMF , only : ESMF_FieldGet, ESMF_DistGridGet, ESMF_GridCompGet use ESMF , only : ESMF_GeomType_Grid, ESMF_AttributeGet, ESMF_DistGridCreate, ESMF_FieldEmptySet - use ESMF , only : ESMF_GridCreate, ESMF_LogWrite, ESMF_LogMsg_Info, ESMF_GridGet, ESMF_Failure + use ESMF , only : ESMF_GridCreate, ESMF_LogWrite, ESMF_LogMsg_Info, ESMF_GridGet use ESMF , only : ESMF_LogMsg_Warning use ESMF , only : ESMF_FieldStatus_Empty, ESMF_FieldStatus_Complete, ESMF_FieldStatus_GridSet use ESMF , only : ESMF_GeomType_Mesh, ESMF_MeshGet, ESMF_Mesh, ESMF_MeshEmptyCreate @@ -1328,9 +1329,7 @@ subroutine realizeConnectedGrid(State,string,rc) enddo else ! geomtype - - call ESMF_LogWrite(trim(subname)//": ERROR geomtype not supported ", ESMF_LOGMSG_INFO) - rc=ESMF_FAILURE + call shr_log_error(trim(subname)//": ERROR geomtype not supported ", rc=rc) return endif ! geomtype @@ -1347,10 +1346,9 @@ subroutine realizeConnectedGrid(State,string,rc) else - call ESMF_LogWrite(trim(subname)//": ERROR fieldStatus not supported ", ESMF_LOGMSG_INFO) - rc=ESMF_FAILURE + call shr_log_error(trim(subname)//": ERROR fieldStatus not supported ", rc=rc) return - + endif ! fieldStatus enddo ! nflds @@ -1442,7 +1440,7 @@ subroutine completeFieldInitialization(State,rc) use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_FieldGet use ESMF , only : ESMF_GeomType_Flag, ESMF_FieldCreate, ESMF_MeshCreate, ESMF_GEOMTYPE_GRID use ESMF , only : ESMF_MeshLoc_Element, ESMF_TYPEKIND_R8, ESMF_FIELDSTATUS_GRIDSET - use ESMF , only : ESMF_AttributeGet, ESMF_MeshWrite, ESMF_FAILURE + use ESMF , only : ESMF_AttributeGet, ESMF_MeshWrite use NUOPC , only : NUOPC_getStateMemberLists, NUOPC_Realize ! input/output variables @@ -1522,8 +1520,7 @@ subroutine completeFieldInitialization(State,rc) call ESMF_FieldGet(meshField, status=fieldStatus, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (fieldStatus == ESMF_FIELDSTATUS_GRIDSET ) then - call ESMF_LogWrite(trim(subname)//": ERROR fieldStatus not complete ", ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE + call shr_log_error(trim(subname)//": ERROR fieldStatus not complete ", rc=rc) return end if call Field_GeomPrint(meshField, trim(subname)//':'//trim(fieldName), rc=rc) @@ -2263,15 +2260,15 @@ subroutine SetRunClock(gcomp, rc) use ESMF , only : ESMF_GridComp, ESMF_CLOCK, ESMF_Time, ESMF_TimeInterval use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_ClockGet, ESMF_ClockSet - use ESMF , only : ESMF_Success, ESMF_Failure + use ESMF , only : ESMF_Success use ESMF , only : ESMF_Alarm, ESMF_ALARMLIST_ALL, ESMF_ClockGetAlarmList use ESMF , only : ESMF_AlarmCreate, ESMF_AlarmSet, ESMF_ClockAdvance use ESMF , only : ESMF_ClockGetAlarmList use NUOPC , only : NUOPC_CompCheckSetClock, NUOPC_CompAttributeGet use NUOPC_Mediator , only : NUOPC_MediatorGet - ! NUOPC_shr_methods is now in cesm_share and cdeps + ! NUOPC_shr_methods is now in cesm_share and cdeps use nuopc_shr_methods, only : AlarmInit - + ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc @@ -2353,7 +2350,7 @@ subroutine med_meshinfo_create(FB, mesh_info, FBArea, rc) use ESMF , only : ESMF_Array, ESMF_ArrayCreate, ESMF_ArrayDestroy, ESMF_Field, ESMF_FieldGet use ESMF , only : ESMF_DistGrid, ESMF_FieldBundle, ESMF_FieldRegridGetArea, ESMF_FieldBundleGet use ESMF , only : ESMF_Mesh, ESMF_MeshGet, ESMF_MESHLOC_ELEMENT, ESMF_TYPEKIND_R8 - use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE, ESMF_LogWrite, ESMF_LOGMSG_INFO + use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO use ESMF , only : ESMF_FieldCreate, ESMF_FieldBundleCreate, ESMF_FieldBundleAdd use med_internalstate_mod , only : mesh_info_type @@ -2603,7 +2600,7 @@ subroutine med_dststatus_write (gcomp, rc) type(ESMF_Array) :: maskarray integer(I4), pointer :: meshmask(:) real(R8), pointer :: r8ptr(:) - integer :: m,n1,n2 + integer :: m,n2 character(CL) :: case_name, dststatusfile logical :: elementMaskIsPresent logical :: whead(2) = (/.true. , .false./) @@ -2641,9 +2638,9 @@ subroutine med_dststatus_write (gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! get mask Array call ESMF_FieldGet(maskfield, array=maskarray, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_MeshGet(mesh_dst, elemMaskArray=maskarray, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldGet(maskfield, localDe=0, farrayPtr=meshmask, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! now create an R8 mask for writing diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index bb0139ccb..df0d4e351 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -17,8 +17,7 @@ module med_diag_mod use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_CompAttributeSet, NUOPC_CompAttributeAdd use NUOPC_Mediator , only : NUOPC_MediatorGet - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS - use ESMF , only : ESMF_FAILURE, ESMF_LOGMSG_ERROR + use ESMF , only : ESMF_SUCCESS use ESMF , only : ESMF_GridComp, ESMF_Clock, ESMF_Time use ESMF , only : ESMF_VM, ESMF_VMReduce, ESMF_REDUCE_SUM use ESMF , only : ESMF_GridCompGet, ESMF_ClockGet, ESMF_TimeGet, ESMF_ClockGetNextTime @@ -33,7 +32,8 @@ module med_diag_mod use med_methods_mod , only : fldbun_fldChk => med_methods_FB_FldChk use med_utils_mod , only : chkerr => med_utils_ChkErr use perf_mod , only : t_startf, t_stopf - + use shr_log_mod , only : shr_log_error + implicit none private @@ -513,11 +513,9 @@ subroutine med_diag_zero_mode(mode, rc) budget_counter(:,:,period_inst) = 0.0_r8 budget_counter(:,:,period_inst+1:) = 1.0_r8 else - call ESMF_LogWrite(trim(subname)//' mode '//trim(mode)//& + call shr_log_error(trim(subname)//' mode '//trim(mode)//& ' not recognized', & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) - rc = ESMF_FAILURE - return + line=__LINE__, file=u_FILE_u, rc=rc) endif end subroutine med_diag_zero_mode diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index 3755b8f74..7f9cfb8ba 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -166,9 +166,8 @@ subroutine med_fraction_init(gcomp, rc) ! Initialize FBFrac(:) field bundles - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LOGMSG_ERROR - use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE - use ESMF , only : ESMF_LogSetError, ESMF_RC_NOT_VALID + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO + use ESMF , only : ESMF_SUCCESS use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_StateIsCreated use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleIsCreated, ESMF_FieldBundleDestroy use ESMF , only : ESMF_FieldBundleGet diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index 1b89f4634..c86f87c72 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -7,8 +7,8 @@ module med_io_mod use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, I8=>SHR_KIND_I8, R8=>SHR_KIND_R8 use med_kind_mod , only : R4=>SHR_KIND_R4 use med_constants_mod , only : fillvalue => SHR_CONST_SPVAL - use ESMF , only : ESMF_VM, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LogFoundError, ESMF_LOGMSG_ERROR - use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE, ESMF_END_ABORT, ESMF_LOGERR_PASSTHRU + use ESMF , only : ESMF_VM, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LogFoundError + use ESMF , only : ESMF_SUCCESS, ESMF_LOGERR_PASSTHRU use ESMF , only : ESMF_VMGetCurrent, ESMF_VMGet, ESMF_VMBroadCast, ESMF_Finalize use NUOPC , only : NUOPC_FieldDictionaryGetEntry use NUOPC , only : NUOPC_FieldDictionaryHasEntry @@ -19,7 +19,7 @@ module med_io_mod use med_methods_mod , only : FB_getFldPtr => med_methods_FB_getFldPtr use med_methods_mod , only : FB_getNameN => med_methods_FB_getNameN use med_utils_mod , only : chkerr => med_utils_ChkErr - + use shr_log_mod , only : shr_log_error implicit none private @@ -195,9 +195,8 @@ subroutine med_io_init(gcomp, rc) else if (trim(cvalue) .eq. '64BIT_DATA') then pio_ioformat = PIO_64BIT_DATA else - call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_ioformat (CLASSIC|64BIT_OFFSET|64BIT_DATA)', ESMF_LOGMSG_ERROR) - rc = ESMF_FAILURE - return + call shr_log_error(trim(subname)//': need to provide valid option for pio_ioformat (CLASSIC|64BIT_OFFSET|64BIT_DATA)', rc=rc) + return end if else cvalue = '64BIT_OFFSET' @@ -220,9 +219,8 @@ subroutine med_io_init(gcomp, rc) else if (trim(cvalue) .eq. 'NETCDF4P') then pio_iotype = PIO_IOTYPE_NETCDF4P else - call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_typename (NETCDF|PNETCDF|NETCDF4C|NETCDF4P)', ESMF_LOGMSG_ERROR) - rc = ESMF_FAILURE - return + call shr_log_error(trim(subname)//': need to provide valid option for pio_typename (NETCDF|PNETCDF|NETCDF4C|NETCDF4P)', rc=rc) + return end if else cvalue = 'NETCDF' @@ -331,9 +329,8 @@ subroutine med_io_init(gcomp, rc) else if (trim(cvalue) .eq. 'SUBSET') then pio_rearranger = PIO_REARR_SUBSET else - call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_rearranger (BOX|SUBSET)', ESMF_LOGMSG_ERROR) - rc = ESMF_FAILURE - return + call shr_log_error(trim(subname)//': need to provide valid option for pio_rearranger (BOX|SUBSET)', rc=rc) + return end if else cvalue = 'SUBSET' @@ -354,9 +351,8 @@ subroutine med_io_init(gcomp, rc) if (isPresent .and. isSet) then read(cvalue,*) pio_debug_level if (pio_debug_level < 0 .or. pio_debug_level > 6) then - call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_debug_level (0-6)', ESMF_LOGMSG_ERROR) - rc = ESMF_FAILURE - return + call shr_log_error(trim(subname)//': need to provide valid option for pio_debug_level (0-6)', rc=rc) + return end if else pio_debug_level = 0 @@ -378,9 +374,8 @@ subroutine med_io_init(gcomp, rc) else if (trim(cvalue) .eq. 'COLL') then pio_rearr_comm_type = PIO_REARR_COMM_COLL else - call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_rearr_comm_type (P2P|COLL)', ESMF_LOGMSG_ERROR) - rc = ESMF_FAILURE - return + call shr_log_error(trim(subname)//': need to provide valid option for pio_rearr_comm_type (P2P|COLL)', rc=rc) + return end if else cvalue = 'P2P' @@ -403,9 +398,8 @@ subroutine med_io_init(gcomp, rc) else if (trim(cvalue) .eq. '2DDISABLE') then pio_rearr_comm_fcd = PIO_REARR_COMM_FC_2D_DISABLE else - call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_rearr_comm_fcd (2DENABLE|IO2COMP|COMP2IO|2DDISABLE)', ESMF_LOGMSG_ERROR) - rc = ESMF_FAILURE - return + call shr_log_error(trim(subname)//': need to provide valid option for pio_rearr_comm_fcd (2DENABLE|IO2COMP|COMP2IO|2DDISABLE)', rc=rc) + return end if else cvalue = '2DENABLE' @@ -662,14 +656,13 @@ character(len=8) function med_io_sec2hms (seconds, rc) integer :: hours ! hours of hh:mm:ss integer :: minutes ! minutes of hh:mm:ss integer :: secs ! seconds of hh:mm:ss + character(len=CS) :: msg !---------------------------------------------------------------------- rc = ESMF_SUCCESS if (seconds < 0 .or. seconds > 86400) then - write(logunit,*)'med_io_sec2hms: bad input seconds:', seconds - call ESMF_LogWrite('med_io_sec2hms: bad input seconds', ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE + call shr_log_error('med_io_sec2hms: bad input seconds', rc=rc) return end if @@ -678,16 +671,14 @@ character(len=8) function med_io_sec2hms (seconds, rc) secs = (seconds - hours*3600 - minutes*60) if (minutes < 0 .or. minutes > 60) then - write(logunit,*)'med_io_sec2hms: bad minutes = ',minutes - call ESMF_LogWrite('med_io_sec2hms: bad minutes', ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE + write(msg,*)'med_io_sec2hms: bad minutes = ',minutes + call shr_log_error(msg, rc=rc) return end if if (secs < 0 .or. secs > 60) then - write(logunit,*)'med_io_sec2hms: bad secs = ',secs - call ESMF_LogWrite('med_io_sec2hms: bad secs', ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE + write(msg,*)'med_io_sec2hms: bad secs = ',secs + call shr_log_error(msg, rc=rc) return end if @@ -705,7 +696,7 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, & !--------------- use ESMF, only : operator(==) - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_FAILURE, ESMF_END_ABORT + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS use ESMF , only : ESMF_FieldBundleIsCreated, ESMF_FieldBundle, ESMF_Mesh, ESMF_DistGrid use ESMF , only : ESMF_FieldBundleGet, ESMF_FieldGet, ESMF_MeshGet, ESMF_DistGridGet use ESMF , only : ESMF_Field, ESMF_FieldGet, ESMF_AttributeGet @@ -880,8 +871,8 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, & call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) if (lnx*lny*lntile /= ng) then write(tmpstr,*) subname,' ERROR: grid size not consistent ',ng,lnx,lny,lntile - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) - call ESMF_Finalize(endflag=ESMF_END_ABORT) + call shr_log_error(trim(tmpstr), rc=rc) + return end if else lnx = ng @@ -1375,7 +1366,6 @@ subroutine med_io_define_time(io_file, time_units, calendar, rc) use ESMF, only : ESMF_CALKIND_360DAY, ESMF_CALKIND_GREGORIAN use ESMF, only : ESMF_CALKIND_JULIAN, ESMF_CALKIND_JULIANDAY, ESMF_CALKIND_MODJULIANDAY use ESMF, only : ESMF_CALKIND_NOCALENDAR, ESMF_CALKIND_NOLEAP - use ESMF, only : ESMF_LOGMSG_ERROR, ESMF_FAILURE use pio , only : var_desc_t, PIO_UNLIMITED use pio , only : pio_double, pio_def_dim, pio_def_var, pio_put_att use pio , only : pio_inq_varid, pio_put_var @@ -1398,9 +1388,8 @@ subroutine med_io_define_time(io_file, time_units, calendar, rc) rc = ESMF_SUCCESS if (.not. ESMF_CalendarIsCreated(calendar)) then - call ESMF_LogWrite(trim(subname)//' ERROR: calendar is not created ', & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) - rc = ESMF_FAILURE + call shr_log_error(trim(subname)//' ERROR: calendar is not created ', & + line=__LINE__, file=u_FILE_u, rc=rc) return end if @@ -1480,7 +1469,6 @@ subroutine med_io_read_FB(filename, vm, FB, pre, frame, rc) use ESMF , only : ESMF_FieldBundle, ESMF_Field, ESMF_Mesh, ESMF_DistGrid use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS - use ESMF , only : ESMF_LOGMSG_ERROR, ESMF_FAILURE use ESMF , only : ESMF_FieldBundleIsCreated, ESMF_FieldBundleGet use ESMF , only : ESMF_FieldGet, ESMF_MeshGet, ESMF_DistGridGet use pio , only : file_desc_T, var_desc_t, io_desc_t, pio_nowrite, pio_openfile @@ -1562,9 +1550,8 @@ subroutine med_io_read_FB(filename, vm, FB, pre, frame, rc) call ESMF_LogWrite(trim(subname)//' open file '//trim(filename), ESMF_LOGMSG_INFO) if (chkerr(rc,__LINE__,u_FILE_u)) return else - call ESMF_LogWrite(trim(subname)//' ERROR: file invalid '//trim(filename), & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) - rc = ESMF_FAILURE + call shr_log_error(trim(subname)//' ERROR: file invalid '//trim(filename), & + line=__LINE__, file=u_FILE_u, rc=rc) return endif @@ -1683,7 +1670,7 @@ end subroutine med_io_read_FB !=============================================================================== subroutine med_io_read_init_iodesc(FB, name1, pioid, iodesc, rc) - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_FAILURE + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS use ESMF , only : ESMF_FieldBundleIsCreated, ESMF_FieldBundle, ESMF_Mesh, ESMF_DistGrid use ESMF , only : ESMF_FieldBundleGet, ESMF_FieldGet, ESMF_MeshGet, ESMF_DistGridGet use ESMF , only : ESMF_Field, ESMF_FieldGet, ESMF_AttributeGet @@ -1758,9 +1745,7 @@ subroutine med_io_read_init_iodesc(FB, name1, pioid, iodesc, rc) if (ng > maxval(maxIndexPTile)) then write(tmpstr,*) subname,' WARNING: dimensions do not match', lnx, lny, maxval(maxIndexPTile) call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) - !TODO: this should not be an error for say CTSM which does not send a global grid - !rc = ESMF_Failure - !return + ! This should not be an error for say CTSM which does not send a global grid endif call ESMF_DistGridGet(distgrid, localDE=0, elementCount=ns, rc=rc) @@ -1776,9 +1761,8 @@ subroutine med_io_read_init_iodesc(FB, name1, pioid, iodesc, rc) deallocate(minIndexPTile, maxIndexPTile) else - if(maintask) write(logunit,'(a)') trim(subname)//' ERROR: '//trim(name1)//' is not present, aborting ' - call ESMF_LogWrite(trim(subname)//' ERROR: '//trim(name1)//' is not present, aborting ', ESMF_LOGMSG_ERROR) - rc = ESMF_FAILURE + call shr_log_error(trim(subname)//' ERROR: '//trim(name1)//' is not present, aborting ', rc=rc) + return end if ! end if rcode check end subroutine med_io_read_init_iodesc @@ -1851,9 +1835,7 @@ subroutine med_io_read_int1d(filename, vm, idata, dname, rc) rcode = pio_get_att(pioid,pio_global,"file_version",lversion) call pio_seterrorhandling(pioid,PIO_INTERNAL_ERROR) else - if(iam==0) write(logunit,*) subname,' ERROR: file invalid ',trim(filename),' ',trim(dname) - call ESMF_LogWrite(trim(subname)//'ERROR: file invalid '//trim(filename)//' '//trim(dname), ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE + call shr_log_error(trim(subname)//'ERROR: file invalid '//trim(filename)//' '//trim(dname), rc=rc) return endif @@ -1936,9 +1918,7 @@ subroutine med_io_read_r81d(filename, vm, rdata, dname, rc) rcode = pio_get_att(pioid,pio_global,"file_version",lversion) call pio_seterrorhandling(pioid,PIO_INTERNAL_ERROR) else - if(iam==0) write(logunit,*) subname,' ERROR: file invalid ',trim(filename),' ',trim(dname) - call ESMF_LogWrite(trim(subname)//'ERROR: file invalid '//trim(filename)//' '//trim(dname), ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE + call shr_log_error(trim(subname)//'ERROR: file invalid '//trim(filename)//' '//trim(dname), rc=rc) return endif @@ -1996,9 +1976,7 @@ subroutine med_io_read_char(filename, vm, rdata, dname, rc) rcode = pio_get_att(pioid,pio_global,"file_version",lversion) call pio_seterrorhandling(pioid,PIO_INTERNAL_ERROR) else - if(iam==0) write(logunit,*) subname,' ERROR: file invalid ',trim(filename),' ',trim(dname) - call ESMF_LogWrite(trim(subname)//'ERROR: file invalid '//trim(filename)//' '//trim(dname), ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE + call shr_log_error(trim(subname)//'ERROR: file invalid '//trim(filename)//' '//trim(dname), rc=rc) return endif diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 6282ddc3e..5caeb8ca6 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -2,14 +2,15 @@ module med_map_mod use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use med_kind_mod , only : I4=>SHR_KIND_I4 - use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE - use ESMF , only : ESMF_LOGMSG_ERROR, ESMF_LOGMSG_INFO, ESMF_LogWrite + use ESMF , only : ESMF_SUCCESS + use ESMF , only : ESMF_LOGMSG_INFO, ESMF_LogWrite use ESMF , only : ESMF_Field use med_internalstate_mod , only : InternalState, logunit, maintask use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_utils_mod , only : chkerr => med_utils_ChkErr use perf_mod , only : t_startf, t_stopf - + use shr_log_mod , only : shr_log_error + implicit none private @@ -144,9 +145,8 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun ! Check number of fields in source FB on destination mesh and get destination field if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(n1,n2))) then - call ESMF_LogWrite(trim(subname)//'FBImp('//trim(compname(n1))//','//trim(compname(n2))//')'// & - ' has not been created', ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) - rc = ESMF_FAILURE + call shr_log_error(trim(subname)//'FBImp('//trim(compname(n1))//','//trim(compname(n2))//')'// & + ' has not been created', line=__LINE__, file=u_FILE_u, rc=rc) return end if call ESMF_FieldBundleGet(is_local%wrap%FBImp(n1,n2), fieldCount=fieldCount, rc=rc) @@ -583,12 +583,8 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, if (chkerr(rc,__LINE__,u_FILE_u)) return end if else - if (maintask) then - write(logunit,'(A)') trim(subname)//' mapindex '//trim(mapname)//' not supported for '//trim(string) - end if - call ESMF_LogWrite(trim(subname)//' mapindex '//trim(mapname)//' not supported ', & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) - rc = ESMF_FAILURE + call shr_log_error(trim(subname)//' mapindex '//trim(mapname)//' not supported for '//trim(string), & + line=__LINE__, file=u_FILE_u, rc=rc) return end if @@ -816,8 +812,9 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & //', mapnorm '//trim(mapnorm_mapindex) & //' set; cannot set mapnorm to '//trim(packed_data(mapindex)%mapnorm) & //' '//trim(fieldnamelist(nf)) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_ERROR) - call ESMF_Finalize(endflag=ESMF_END_ABORT) + call shr_log_error(trim(tmpstr), rc=rc) + return + end if end if end if @@ -1372,7 +1369,7 @@ subroutine med_map_field(field_src, field_dst, routehandles, maptype, fldname, z !--------------------------------------------------- use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS - use ESMF , only : ESMF_LOGMSG_ERROR, ESMF_FAILURE, ESMF_MAXSTR + use ESMF , only : ESMF_MAXSTR use ESMF , only : ESMF_Field, ESMF_FieldRegrid use ESMF , only : ESMF_TERMORDER_SRCSEQ, ESMF_Region_Flag use ESMF , only : ESMF_REGION_TOTAL, ESMF_REGION_SELECT diff --git a/mediator/med_merge_mod.F90 b/mediator/med_merge_mod.F90 index f09c9311d..6d12fa929 100644 --- a/mediator/med_merge_mod.F90 +++ b/mediator/med_merge_mod.F90 @@ -16,7 +16,8 @@ module med_merge_mod use esmFlds , only : med_fldList_entry_type use esmFlds , only : med_fldList_findName use perf_mod , only : t_startf, t_stopf - + use shr_log_mod , only : shr_log_error + implicit none private @@ -45,8 +46,8 @@ subroutine med_merge_auto_multi_fldbuns(coupling_active, FBOut, FBfrac, FBImp, f use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleIsCreated, ESMF_FieldBundleGet use ESMF , only : ESMF_Field, ESMF_FieldGet - use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LOGMSG_ERROR, ESMF_LogSetError + use ESMF , only : ESMF_SUCCESS + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LogSetError ! ---------------------------------------------- ! Auto merge based on fldListTo info @@ -203,8 +204,8 @@ subroutine med_merge_auto_single_fldbun(compsrc, FBOut, FBfrac, FBIn, fldListTo, use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleIsCreated, ESMF_FieldBundleGet use ESMF , only : ESMF_Field, ESMF_FieldGet - use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LOGMSG_ERROR + use ESMF , only : ESMF_SUCCESS + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO use ESMF , only : ESMF_LogSetError ! input/output variables integer , intent(in) :: compsrc @@ -309,7 +310,7 @@ end subroutine med_merge_auto_single_fldbun subroutine med_merge_auto_field(merge_type, field_out, ungriddedUBound_out, & FB, FBfld, FBw, fldw, rc) - use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE, ESMF_LogMsg_Error + use ESMF , only : ESMF_SUCCESS use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet use ESMF , only : ESMF_LogWrite, ESMF_LogMsg_Info use ESMF , only : ESMF_FieldGet, ESMF_Field @@ -344,15 +345,13 @@ subroutine med_merge_auto_field(merge_type, field_out, ungriddedUBound_out, & if (merge_type == 'copy_with_weights' .or. merge_type == 'merge') then if (trim(fldw) == 'unset') then - call ESMF_LogWrite(trim(subname)//": error required merge_fracname is not set", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) - rc = ESMF_FAILURE + call shr_log_error(trim(subname)//": error required merge_fracname is not set", & + line=__LINE__, file=u_FILE_u, rc=rc) return end if if (.not. FB_FldChk(FBw, trim(fldw), rc=rc)) then - call ESMF_LogWrite(trim(subname)//": error "//trim(fldw)//"is not in FBw", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) - rc = ESMF_FAILURE + call shr_log_error(trim(subname)//": error "//trim(fldw)//"is not in FBw", & + line=__LINE__, file=u_FILE_u, rc=rc) return end if end if @@ -418,9 +417,8 @@ subroutine med_merge_auto_field(merge_type, field_out, ungriddedUBound_out, & dp1(:) = dp1(:) + dpf1(:) endif else - call ESMF_LogWrite(trim(subname)//": merge type "//trim(merge_type)//" not supported", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) - rc = ESMF_FAILURE + call shr_log_error(trim(subname)//": merge type "//trim(merge_type)//" not supported", & + line=__LINE__, file=u_FILE_u, rc=rc) return end if @@ -432,8 +430,8 @@ subroutine med_merge_auto_errcheck(compsrc, fldname_out, field_out, & use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleIsCreated, ESMF_FieldBundleGet use ESMF , only : ESMF_Field, ESMF_FieldGet - use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LOGMSG_ERROR + use ESMF , only : ESMF_SUCCESS + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO use ESMF , only : ESMF_LogSetError, ESMF_RC_OBJ_NOT_CREATED ! input/output variables @@ -475,10 +473,9 @@ subroutine med_merge_auto_errcheck(compsrc, fldname_out, field_out, & call ESMF_FieldBundleGet(FBMed2, trim(merge_fldname), field=field_in, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return else - call ESMF_LogWrite(trim(subname)//": ERROR merge_fldname = "//trim(merge_fldname)//" not found", & - ESMF_LOGMSG_ERROR, rc=rc) - rc = ESMF_FAILURE - if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_log_error(trim(subname)//": ERROR merge_fldname = "//trim(merge_fldname)//" not found", & + rc=rc) + return end if end if endif @@ -492,9 +489,8 @@ subroutine med_merge_auto_errcheck(compsrc, fldname_out, field_out, & write(errmsg,*) trim(subname),' input field ungriddedUbound ',ungriddedUbound_in(1),& ' for '//trim(merge_fldname), & ' not equal to output field ungriddedUbound ',ungriddedUbound_out,' for '//trim(fldname_out) - call ESMF_LogWrite(errmsg, ESMF_LOGMSG_ERROR) - rc = ESMF_FAILURE - return + + call shr_log_error(errmsg, rc=rc) endif end subroutine med_merge_auto_errcheck @@ -508,7 +504,7 @@ subroutine med_merge_field_1D(FBout, fnameout, & FBinE, fnameE, wgtE, rc) use ESMF , only : ESMF_FieldBundle, ESMF_LogWrite - use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE, ESMF_LOGMSG_ERROR + use ESMF , only : ESMF_SUCCESS use ESMF , only : ESMF_LOGMSG_WARNING, ESMF_LOGMSG_INFO ! ---------------------------------------------- @@ -555,10 +551,8 @@ subroutine med_merge_field_1D(FBout, fnameout, & (present(FBinC) .and. .not.present(fnameC)) .or. & (present(FBinD) .and. .not.present(fnameD)) .or. & (present(FBinE) .and. .not.present(fnameE))) then - - call ESMF_LogWrite(trim(subname)//": ERROR fname not present with FBin", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) - rc = ESMF_FAILURE + call shr_log_error(trim(subname)//": ERROR fname not present with FBin", & + line=__LINE__, file=u_FILE_u, rc=dbrc) return endif @@ -647,16 +641,15 @@ subroutine med_merge_field_1D(FBout, fnameout, & if (FBinfound) then if (lbound(dataPtr,1) /= lbound(dataOut,1) .or. ubound(dataPtr,1) /= ubound(dataOut,1)) then - call ESMF_LogWrite(trim(subname)//": ERROR FBin wrong size", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) - rc = ESMF_FAILURE + call shr_log_error(trim(subname)//": ERROR FBin wrong size", & + line=__LINE__, file=u_FILE_u, rc=dbrc) return endif if (wgtfound) then if (lbound(dataPtr,1) /= lbound(wgt,1) .or. ubound(dataPtr,1) /= ubound(wgt,1)) then - call ESMF_LogWrite(trim(subname)//": ERROR wgt wrong size", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) - rc = ESMF_FAILURE + + call shr_log_error(trim(subname)//": ERROR wgt wrong size", & + line=__LINE__, file=u_FILE_u, rc=dbrc) return endif do i = lb1,ub1 @@ -707,7 +700,7 @@ subroutine merge_listGetName(list, k, name, rc) ! Get name of k-th field in colon deliminted list - use ESMF, only : ESMF_SUCCESS, ESMF_FAILURE, ESMF_LogWrite, ESMF_LOGMSG_INFO + use ESMF, only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO ! input/output variables character(len=*) ,intent(in) :: list ! list/string @@ -745,19 +738,14 @@ subroutine merge_listGetName(list, k, name, rc) return end if if (.not. valid_list) then - write(logunit,*) "ERROR: invalid list = ",trim(list) - call ESMF_LogWrite("ERROR: invalid list = "//trim(list), ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE + call shr_log_error("ERROR: invalid list = "//trim(list), rc=rc) return end if !--- check that this is a valid index --- kFlds = merge_listGetNum(list) if (k<1 .or. kFlds fieldCount) then - call ESMF_LogWrite(trim(subname)//": ERROR fieldnum > fieldCount ", ESMF_LOGMSG_ERROR) - rc = ESMF_FAILURE - return + call shr_log_error(trim(subname)//": ERROR fieldnum > fieldCount ", rc=rc) + return endif allocate(lfieldnamelist(fieldCount)) call ESMF_FieldBundleGet(FB, fieldNameList=lfieldnamelist, rc=rc) @@ -633,9 +614,8 @@ subroutine med_methods_State_getNameN(State, fieldnum, fieldname, rc) call ESMF_StateGet(State, itemCount=fieldCount, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (fieldnum > fieldCount) then - call ESMF_LogWrite(trim(subname)//": ERROR fieldnum > fieldCount ", ESMF_LOGMSG_ERROR) - rc = ESMF_FAILURE - return + call shr_log_error(trim(subname)//": ERROR fieldnum > fieldCount ", rc=rc) + return endif allocate(lfieldnamelist(fieldCount)) call ESMF_StateGet(State, itemNameList=lfieldnamelist, rc=rc) @@ -750,9 +730,8 @@ subroutine med_methods_FB_reset(FB, value, rc) elseif (lrank == 2) then fldptr2 = lvalue else - call ESMF_LogWrite(trim(subname)//": ERROR in rank "//trim(lfieldnamelist(n)), & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) - rc = ESMF_FAILURE + call shr_log_error(trim(subname)//": ERROR in rank "//trim(lfieldnamelist(n)), & + line=__LINE__, file=u_FILE_u, rc=rc) return endif enddo @@ -822,9 +801,8 @@ subroutine med_methods_State_reset(State, value, rc) elseif (lrank == 2) then fldptr2 = lvalue else - call ESMF_LogWrite(trim(subname)//": ERROR in rank "//trim(lfieldnamelist(n)), & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) - rc = ESMF_FAILURE + call shr_log_error(trim(subname)//": ERROR in rank "//trim(lfieldnamelist(n)), & + line=__LINE__, file=u_FILE_u, rc=rc) return endif enddo @@ -901,9 +879,8 @@ subroutine med_methods_FB_average(FB, count, rc) enddo enddo else - call ESMF_LogWrite(trim(subname)//": ERROR rank not supported ", ESMF_LOGMSG_ERROR) - rc = ESMF_FAILURE - return + call shr_log_error(trim(subname)//": ERROR rank not supported ", rc=rc) + return endif enddo deallocate(lfieldnamelist) @@ -985,8 +962,7 @@ subroutine med_methods_FB_diagnose(FB, string, rc) endif else - call ESMF_LogWrite(trim(subname)//": ERROR rank not supported ", ESMF_LOGMSG_ERROR) - rc = ESMF_FAILURE + call shr_log_error(trim(subname)//": ERROR rank not supported ", rc=rc) return endif call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) @@ -1052,8 +1028,7 @@ subroutine med_methods_FB_write(FB, string, rc) call ESMF_FieldWriteVTK(lfield, trim(lfieldnamelist(n))//'_'//trim(lstring), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return else - call ESMF_LogWrite(trim(subname)//": ERROR rank not supported ", ESMF_LOGMSG_ERROR) - rc = ESMF_FAILURE + call shr_log_error(trim(subname)//": ERROR rank not supported ", rc=rc) return endif end do @@ -1179,8 +1154,7 @@ subroutine med_methods_State_diagnose(State, string, rc) " no data" endif else - call ESMF_LogWrite(trim(subname)//": ERROR rank not supported ", ESMF_LOGMSG_ERROR) - rc = ESMF_FAILURE + call shr_log_error(trim(subname)//": ERROR rank not supported ", rc=rc) return endif @@ -1320,8 +1294,7 @@ subroutine med_methods_Field_diagnose(field, fieldname, string, rc) write(msgString,'(A,a)') trim(subname)//' '//trim(lstring)//': '//trim(fieldname)," no data" endif else - call ESMF_LogWrite(trim(subname)//": ERROR rank not supported ", ESMF_LOGMSG_ERROR) - rc = ESMF_FAILURE + call shr_log_error(trim(subname)//": ERROR rank not supported ", rc=rc) return endif call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) @@ -1427,9 +1400,8 @@ subroutine med_methods_FB_accum(FBout, FBin, copy, rc) elseif (lranki == 1 .and. lranko == 1) then if (.not.med_methods_FieldPtr_Compare(dataPtro1, dataPtri1, subname, rc)) then - call ESMF_LogWrite(trim(subname)//": ERROR in dataPtr1 size ", ESMF_LOGMSG_ERROR) - rc = ESMF_FAILURE - return + call shr_log_error(trim(subname)//": ERROR in dataPtr1 size ", rc=rc) + return endif if (lcopy) then @@ -1445,9 +1417,8 @@ subroutine med_methods_FB_accum(FBout, FBin, copy, rc) elseif (lranki == 2 .and. lranko == 2) then if (.not.med_methods_FieldPtr_Compare(dataPtro2, dataPtri2, subname, rc)) then - call ESMF_LogWrite(trim(subname)//": ERROR in dataPtr2 size ", ESMF_LOGMSG_ERROR) - rc = ESMF_FAILURE - return + call shr_log_error(trim(subname)//": ERROR in dataPtr2 size ", rc=rc) + return endif if (lcopy) then @@ -1465,14 +1436,9 @@ subroutine med_methods_FB_accum(FBout, FBin, copy, rc) endif else - write(msgString,'(a,2i8)') trim(subname)//": ranki, ranko = ",lranki,lranko - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_ERROR) - call ESMF_LogWrite(trim(subname)//": ERROR ranki ranko not supported "//trim(lfieldnamelist(n)), & - ESMF_LOGMSG_ERROR) - rc = ESMF_FAILURE + call shr_log_error(trim(subname)//": ERROR ranki ranko not supported "//trim(msgstring)//"\n"//trim(lfieldnamelist(n)), rc=rc) return - endif endif @@ -1522,8 +1488,7 @@ logical function med_methods_FB_FldChk(FB, fldname, rc) call ESMF_FieldBundleGet(FB, fieldName=trim(fldname), isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) then - call ESMF_LogWrite(trim(subname)//" Error checking field: "//trim(fldname), & - ESMF_LOGMSG_ERROR) + call shr_log_error(string=trim(subname)//" Error checking field: "//trim(fldname), line=__LINE__,file=u_FILE_u, rc=rc) return endif if (isPresent) then @@ -1571,10 +1536,9 @@ subroutine med_methods_Field_GetFldPtr(field, fldptr1, fldptr2, rank, abort, rc) endif if (.not.present(rc)) then - call ESMF_LogWrite(trim(subname)//": ERROR rc not present ", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) - rc = ESMF_FAILURE - return + call shr_log_error(trim(subname)//": ERROR rc not present ", & + line=__LINE__, file=u_FILE_u, rc=rc) + return endif rc = ESMF_SUCCESS @@ -1591,9 +1555,8 @@ subroutine med_methods_Field_GetFldPtr(field, fldptr1, fldptr2, rank, abort, rc) if (status /= ESMF_FIELDSTATUS_COMPLETE) then lrank = 0 if (labort) then - call ESMF_LogWrite(trim(subname)//": ERROR data not allocated ", ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return + call shr_log_error(trim(subname)//": ERROR data not allocated ", rc=rc) + return else call ESMF_LogWrite(trim(subname)//": WARNING data not allocated ", ESMF_LOGMSG_INFO) endif @@ -1614,9 +1577,8 @@ subroutine med_methods_Field_GetFldPtr(field, fldptr1, fldptr2, rank, abort, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (nnodes == 0 .and. nelements == 0) lrank = 0 else - call ESMF_LogWrite(trim(subname)//": ERROR geomtype not supported ", ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return + call shr_log_error(trim(subname)//": ERROR geomtype not supported ", rc=rc) + return endif ! geomtype if (lrank == 0) then @@ -1625,29 +1587,26 @@ subroutine med_methods_Field_GetFldPtr(field, fldptr1, fldptr2, rank, abort, rc) elseif (lrank == 1) then if (.not.present(fldptr1)) then - call ESMF_LogWrite(trim(subname)//": ERROR missing rank=1 array ", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) - rc = ESMF_FAILURE - return + call shr_log_error(trim(subname)//": ERROR missing rank=1 array ", & + line=__LINE__, file=u_FILE_u, rc=rc) + return endif call ESMF_FieldGet(field, farrayPtr=fldptr1, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return elseif (lrank == 2) then if (.not.present(fldptr2)) then - call ESMF_LogWrite(trim(subname)//": ERROR missing rank=2 array ", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) - rc = ESMF_FAILURE - return + call shr_log_error(trim(subname)//": ERROR missing rank=2 array ", & + line=__LINE__, file=u_FILE_u, rc=rc) + return endif call ESMF_FieldGet(field, farrayPtr=fldptr2, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return else - call ESMF_LogWrite(trim(subname)//": ERROR in rank ", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) - rc = ESMF_FAILURE - return + call shr_log_error(trim(subname)//": ERROR in rank ", & + line=__LINE__, file=u_FILE_u, rc=rc) + return endif endif ! status @@ -1691,19 +1650,17 @@ subroutine med_methods_FB_GetFldPtr(FB, fldname, fldptr1, fldptr2, rank, field, endif if (.not.present(rc)) then - call ESMF_LogWrite(trim(subname)//": ERROR rc not present "//trim(fldname), & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) - rc = ESMF_FAILURE - return + call shr_log_error(trim(subname)//": ERROR rc not present "//trim(fldname), & + line=__LINE__, file=u_FILE_u, rc=rc) + return endif rc = ESMF_SUCCESS if (.not. med_methods_FB_FldChk(FB, trim(fldname), rc=rc)) then - call ESMF_LogWrite(trim(subname)//": ERROR field "//trim(fldname)//" not in FB ", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) - rc = ESMF_FAILURE - return + call shr_log_error(trim(subname)//": ERROR field "//trim(fldname)//" not in FB ", & + line=__LINE__, file=u_FILE_u, rc=rc) + return endif call ESMF_FieldBundleGet(FB, fieldName=trim(fldname), field=lfield, rc=rc) @@ -1744,12 +1701,10 @@ logical function med_methods_FieldPtr_Compare1(fldptr1, fldptr2, cstring, rc) med_methods_FieldPtr_Compare1 = .false. if (lbound(fldptr2,1) /= lbound(fldptr1,1) .or. ubound(fldptr2,1) /= ubound(fldptr1,1)) then - call ESMF_LogWrite(trim(subname)//": ERROR in data size "//trim(cstring), ESMF_LOGMSG_ERROR, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - write(msgString,*) trim(subname)//': fldptr1 ',lbound(fldptr1),ubound(fldptr1) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - write(msgString,*) trim(subname)//': fldptr2 ',lbound(fldptr2),ubound(fldptr2) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + write(msgString,*) trim(subname)//': fldptr1 ',lbound(fldptr1),ubound(fldptr1),"\n",& + trim(subname)//': fldptr2 ',lbound(fldptr2),ubound(fldptr2),": ERROR in data size "//trim(cstring) + call shr_log_error(msgstring,rc=rc) + return else med_methods_FieldPtr_Compare1 = .true. endif @@ -1782,12 +1737,10 @@ logical function med_methods_FieldPtr_Compare2(fldptr1, fldptr2, cstring, rc) med_methods_FieldPtr_Compare2 = .false. if (lbound(fldptr2,2) /= lbound(fldptr1,2) .or. lbound(fldptr2,1) /= lbound(fldptr1,1) .or. & ubound(fldptr2,2) /= ubound(fldptr1,2) .or. ubound(fldptr2,1) /= ubound(fldptr1,1)) then - call ESMF_LogWrite(trim(subname)//": ERROR in data size "//trim(cstring), ESMF_LOGMSG_ERROR, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - write(msgString,*) trim(subname)//': fldptr2 ',lbound(fldptr2),ubound(fldptr2) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - write(msgString,*) trim(subname)//': fldptr1 ',lbound(fldptr1),ubound(fldptr1) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + write(msgString,*) trim(subname)//': fldptr2 ',lbound(fldptr2),ubound(fldptr2),': fldptr1 ',lbound(fldptr1),ubound(fldptr1),& + ": ERROR in data size "//trim(cstring) + call shr_log_error(trim(msgString),rc=rc) + return else med_methods_FieldPtr_Compare2 = .true. endif @@ -1910,10 +1863,9 @@ subroutine med_methods_Field_GeomPrint(field, string, rc) call ESMF_FieldGet(field, status=status, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (status == ESMF_FIELDSTATUS_EMPTY) then - call ESMF_LogWrite(trim(subname)//":"//trim(string)//": ERROR field does not have a geom yet ", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) - rc = ESMF_FAILURE - return + call shr_log_error(trim(subname)//":"//trim(string)//": ERROR field does not have a geom yet ", & + line=__LINE__, file=u_FILE_u, rc=rc) + return endif call ESMF_FieldGet(field, geomtype=geomtype, rc=rc) @@ -1948,10 +1900,9 @@ subroutine med_methods_Field_GeomPrint(field, string, rc) ! means data allocation does not exist yet continue else - call ESMF_LogWrite(trim(subname)//": ERROR rank not supported ", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) - rc = ESMF_FAILURE - return + call shr_log_error(trim(subname)//": ERROR rank not supported ", & + line=__LINE__, file=u_FILE_u, rc=rc) + return endif if (dbug_flag > 10) then @@ -2203,8 +2154,8 @@ subroutine med_methods_Grid_Print(grid, string, rc) staggerloc = ESMF_STAGGERLOC_CORNER staggerstr = 'ESMF_STAGGERLOC_CORNER' else - rc = ESMF_FAILURE - call ESMF_LogWrite(trim(subname)//":staggerloc failure", ESMF_LOGMSG_INFO) + call shr_log_error(trim(subname)//":staggerloc failure", rc=rc) + return endif call ESMF_GridGetCoord(grid, staggerloc=staggerloc, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -2326,7 +2277,7 @@ subroutine med_methods_State_GetScalar(state, scalar_id, scalar_value, flds_scal ! ---------------------------------------------- use ESMF , only : ESMF_SUCCESS, ESMF_State, ESMF_StateGet, ESMF_Field, ESMF_FieldGet - use ESMF , only : ESMF_FAILURE, ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU, ESMF_LogWrite + use ESMF , only : ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU, ESMF_LogWrite use ESMF , only : ESMF_LOGMSG_INFO, ESMF_VM, ESMF_VMBroadCast, ESMF_VMGetCurrent use ESMF , only : ESMF_VMGet @@ -2367,9 +2318,8 @@ subroutine med_methods_State_GetScalar(state, scalar_id, scalar_value, flds_scal call ESMF_FieldGet(field, farrayPtr = farrayptr, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (scalar_id < 0 .or. scalar_id > flds_scalar_num) then - call ESMF_LogWrite(trim(subname)//": ERROR in scalar_id", ESMF_LOGMSG_INFO, line=__LINE__, file=u_FILE_u) - rc = ESMF_FAILURE - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + call shr_log_error(trim(subname)//": ERROR in scalar_id", line=__LINE__, file=u_FILE_u, rc=rc) + return endif tmp(:) = farrayptr(scalar_id,:) endif @@ -2425,9 +2375,8 @@ subroutine med_methods_State_SetScalar(scalar_value, scalar_id, State, flds_scal call ESMF_FieldGet(field, farrayPtr = farrayptr, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (scalar_id < 0 .or. scalar_id > flds_scalar_num) then - call ESMF_LogWrite(trim(subname)//": ERROR in scalar_id", ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return + call shr_log_error(trim(subname)//": ERROR in scalar_id", rc=rc) + return endif farrayptr(scalar_id,1) = scalar_value endif @@ -2577,7 +2526,7 @@ end subroutine med_methods_FB_getmesh !----------------------------------------------------------------------------- subroutine med_methods_FB_check_for_nans(FB, maintask, logunit, rc) - use ESMF, only : ESMF_FieldBundle, ESMF_Field, ESMF_FieldBundleGet, ESMF_FieldGet + use ESMF, only : ESMF_FieldBundle, ESMF_Field, ESMF_FieldBundleGet, ESMF_FieldGet, ESMF_LOGMSG_ERROR ! input/output variables type(ESMF_FieldBundle) , intent(in) :: FB logical , intent(in) :: maintask @@ -2626,13 +2575,13 @@ subroutine med_methods_FB_check_for_nans(FB, maintask, logunit, rc) if (nancount > 0) then write(nancount_char, '(i0)') nancount msg_error = "ERROR: " // trim(nancount_char) //" nans found in "//trim(fieldname) - call ESMF_LogWrite(trim(msg_error), ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) nanfound = .true. + call shr_log_error(trim(msg_error)) end if end do if (nanfound) then - call ESMF_LogWrite('ABORTING JOB', ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) - rc = ESMF_FAILURE + call shr_log_error('ABORTING JOB, see PET file for details', line=__LINE__, file=u_FILE_u, rc=rc) + return end if end subroutine med_methods_FB_check_for_nans diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index 6cf7280e7..b3618c1ba 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -22,7 +22,7 @@ module med_phases_aofluxes_mod use ESMF , only : ESMF_TERMORDER_SRCSEQ, ESMF_REGION_TOTAL, ESMF_MESHLOC_ELEMENT, ESMF_MAXSTR use ESMF , only : ESMF_XGRIDSIDE_B, ESMF_XGRIDSIDE_A, ESMF_END_ABORT, ESMF_LOGERR_PASSTHRU use ESMF , only : ESMF_Mesh, ESMF_MeshGet, ESMF_XGrid, ESMF_XGridCreate, ESMF_TYPEKIND_R8 - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_LOGMSG_ERROR, ESMF_FAILURE + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS use ESMF , only : ESMF_Finalize, ESMF_LogFoundError use ESMF , only : ESMF_XGridGet, ESMF_MeshCreate, ESMF_MeshWrite, ESMF_KIND_R8 use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 @@ -39,7 +39,7 @@ module med_phases_aofluxes_mod use shr_const_mod , only : rearth => SHR_CONST_REARTH use shr_const_mod , only : pi => SHR_CONST_PI #endif - + use shr_log_mod , only : shr_log_error implicit none private @@ -667,10 +667,9 @@ subroutine med_aofluxes_init_agrid(gcomp, aoflux_in, aoflux_out, rc) else if (med_map_RH_is_created(is_local%wrap%RH(compocn,compatm,:), mapconsd, rc=rc)) then maptype = mapconsd else - call ESMF_LogWrite(trim(subname)//& + call shr_log_error(trim(subname)//& ": maptype for atm->ocn mapping of So_mask must be either mapfcopy or mapconsd", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) - rc = ESMF_FAILURE + line=__LINE__, file=u_FILE_u, rc=rc) return end if @@ -1226,10 +1225,9 @@ subroutine med_aofluxes_map_ogrid2agrid_input(gcomp, rc) else if (med_map_RH_is_created(is_local%wrap%RH(compocn,compatm,:), mapconsd, rc=rc)) then maptype = mapconsd else - call ESMF_LogWrite(trim(subname)//& + call shr_log_error(trim(subname)//& ": maptype for atm->ocn mapping of aofluxes from atm->ocn either mapfcopy or mapconsd", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) - rc = ESMF_FAILURE + line=__LINE__, file=u_FILE_u, rc=rc) return end if @@ -1425,10 +1423,9 @@ subroutine med_aofluxes_map_agrid2ogrid_output(gcomp, rc) else if (med_map_RH_is_created(is_local%wrap%RH(compatm,compocn,:), mapconsf, rc=rc)) then maptype = mapconsf else - call ESMF_LogWrite(trim(subname)//& + call shr_log_error(trim(subname)//& ": maptype for atm->ocn mapping of aofluxes from atm->ocn either mapfcopy or mapconsf", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) - rc = ESMF_FAILURE + line=__LINE__, file=u_FILE_u, rc=rc) return end if call ESMF_FieldRegrid(field_src, field_dst, & diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 6859a6c9a..b3899c285 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -12,9 +12,8 @@ module med_phases_history_mod use ESMF , only : ESMF_TimeInterval, ESMF_TimeIntervalGet, ESMF_TimeIntervalSet use ESMF , only : ESMF_Alarm, ESMF_AlarmIsRinging, ESMF_AlarmRingerOff, ESMF_AlarmGet use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LOGMSG_ERROR, ESMF_LogFoundError - use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE, ESMF_MAXSTR, ESMF_LOGERR_PASSTHRU, ESMF_END_ABORT - use ESMF , only : ESMF_Finalize + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO + use ESMF , only : ESMF_SUCCESS, ESMF_MAXSTR, ESMF_LOGERR_PASSTHRU, ESMF_END_ABORT use ESMF , only : operator(-), operator(+) use NUOPC , only : NUOPC_CompAttributeGet use NUOPC_Model , only : NUOPC_ModelGet @@ -24,7 +23,7 @@ module med_phases_history_mod use med_io_mod , only : med_io_write, med_io_wopen, med_io_enddef, med_io_close use perf_mod , only : t_startf, t_stopf use pio , only : file_desc_t - + use shr_log_mod , only : shr_log_error implicit none private @@ -1208,12 +1207,8 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc) call ESMF_FieldBundleGet(auxcomp%files(nfcnt)%FBAccum, fieldCount=nfld, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (nfld == 0) then - call ESMF_LogWrite(subname//'FBAccum is zero for '//trim(auxcomp%files(nfcnt)%auxname), & - ESMF_LOGMSG_ERROR) - rc = ESMF_FAILURE - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) then - call ESMF_Finalize(endflag=ESMF_END_ABORT) - end if + call shr_log_error(subname//'FBAccum is zero for '//trim(auxcomp%files(nfcnt)%auxname), rc=rc) + return end if end if @@ -1376,9 +1371,7 @@ subroutine get_auxflds(str, flds, rc) valid = .false. end if if (.not. valid) then - if (maintask) write(logunit,*) "ERROR: invalid list = ",trim(str) - call ESMF_LogWrite("ERROR: invalid list = "//trim(str), ESMF_LOGMSG_ERROR) - rc = ESMF_FAILURE + call shr_log_error("ERROR: invalid list = "//trim(str), rc=rc) return end if ! get number of fields in a colon delimited string list @@ -1462,9 +1455,9 @@ subroutine med_phases_history_fldbun_accum(fldbun, fldbun_accum, count, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (ungriddedUBound(1) /= ungriddedUBound_accum(1)) then - call ESMF_LogWrite(" upper bounds for field and field_accum do not match", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) - rc = ESMF_FAILURE + call shr_log_error(" upper bounds for field and field_accum do not match", & + line=__LINE__, file=u_FILE_u, rc=rc) + return end if if (ungriddedUBound(1) > 0) then diff --git a/mediator/med_phases_ocnalb_mod.F90 b/mediator/med_phases_ocnalb_mod.F90 index 18d709cdd..0a09c76aa 100644 --- a/mediator/med_phases_ocnalb_mod.F90 +++ b/mediator/med_phases_ocnalb_mod.F90 @@ -10,8 +10,7 @@ module med_phases_ocnalb_mod use perf_mod , only : t_startf, t_stopf use shr_orb_mod , only : shr_orb_cosz, shr_orb_decl use shr_orb_mod , only : shr_orb_params, SHR_ORB_UNDEF_INT, SHR_ORB_UNDEF_REAL - use shr_log_mod , only : shr_log_unit - + use shr_log_mod , only : shr_log_unit, shr_log_error implicit none private @@ -572,8 +571,8 @@ subroutine med_phases_ocnalb_orbital_init(gcomp, logunit, maintask, rc) write(logunit,*) trim(subname),' ERROR: invalid settings orb_mode =',trim(orb_mode) write(logunit,*) trim(subname),' ERROR: fixed_year settings = ',orb_iyear write (msgstr, *) ' ERROR: invalid settings for orb_mode '//trim(orb_mode) - call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) - return ! bail out + call shr_log_error(msgstr, line=__LINE__, file=__FILE__, rc=rc) + return endif elseif (trim(orb_mode) == trim(orb_variable_year)) then orb_obliq = SHR_ORB_UNDEF_REAL @@ -583,8 +582,8 @@ subroutine med_phases_ocnalb_orbital_init(gcomp, logunit, maintask, rc) write(logunit,*) trim(subname),' ERROR: invalid settings orb_mode =',trim(orb_mode) write(logunit,*) trim(subname),' ERROR: variable_year settings = ',orb_iyear, orb_iyear_align write (msgstr, *) subname//' ERROR: invalid settings for orb_mode '//trim(orb_mode) - call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) - return ! bail out + call shr_log_error(msgstr, line=__LINE__, file=__FILE__, rc=rc) + return endif elseif (trim(orb_mode) == trim(orb_fixed_parameters)) then !-- force orb_iyear to undef to make sure shr_orb_params works properly @@ -598,14 +597,13 @@ subroutine med_phases_ocnalb_orbital_init(gcomp, logunit, maintask, rc) write(logunit,*) trim(subname),' ERROR: orb_obliq = ',orb_obliq write(logunit,*) trim(subname),' ERROR: orb_mvelp = ',orb_mvelp write (msgstr, *) subname//' ERROR: invalid settings for orb_mode '//trim(orb_mode) - call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) - return ! bail out + call shr_log_error(msgstr, line=__LINE__, file=__FILE__, rc=rc) + return endif else write (msgstr, *) subname//' ERROR: invalid orb_mode '//trim(orb_mode) - call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) - rc = ESMF_FAILURE - return ! bail out + call shr_log_error(msgstr, line=__LINE__, file=__FILE__, rc=rc) + return endif end subroutine med_phases_ocnalb_orbital_init @@ -665,8 +663,8 @@ subroutine med_phases_ocnalb_orbital_update(clock, logunit, maintask, eccen, ob if ( eccen == SHR_ORB_UNDEF_REAL .or. obliqr == SHR_ORB_UNDEF_REAL .or. & mvelpp == SHR_ORB_UNDEF_REAL .or. lambm0 == SHR_ORB_UNDEF_REAL) then write (msgstr, *) subname//' ERROR: orb params incorrect' - call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) - return ! bail out + call shr_log_error(msgstr, line=__LINE__, file=__FILE__, rc=rc) + return endif end subroutine med_phases_ocnalb_orbital_update diff --git a/mediator/med_phases_post_glc_mod.F90 b/mediator/med_phases_post_glc_mod.F90 index 959f2873b..311324229 100644 --- a/mediator/med_phases_post_glc_mod.F90 +++ b/mediator/med_phases_post_glc_mod.F90 @@ -7,7 +7,7 @@ module med_phases_post_glc_mod use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use NUOPC , only : NUOPC_CompAttributeGet - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LOGMSG_ERROR, ESMF_SUCCESS, ESMF_FAILURE + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet use ESMF , only : ESMF_GridComp, ESMF_GridCompGet use ESMF , only : ESMF_StateGet, ESMF_StateItem_Flag @@ -30,7 +30,7 @@ module med_phases_post_glc_mod use med_map_mod , only : med_map_field_packed, med_map_field_normalized, med_map_field use glc_elevclass_mod , only : glc_mean_elevation_virtual, glc_get_fractional_icecov use perf_mod , only : t_startf, t_stopf - + use shr_log_mod , only : shr_log_error implicit none private @@ -333,10 +333,8 @@ subroutine map_glc2lnd_init(gcomp, rc) ! Currently cannot map hflx in multiple elevation classes from glc to land if (fldbun_fldchk(is_local%wrap%FBExp(complnd), trim(Flgg_hflx), rc=rc)) then - call ESMF_LogWrite(trim(subname)//'ERROR: Flgg_hflx to land has not been implemented yet', & - ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__) - rc = ESMF_FAILURE - return + call shr_log_error(trim(subname)//'ERROR: Flgg_hflx to land has not been implemented yet', & + line=__LINE__, file=__FILE__, rc=rc) end if end subroutine map_glc2lnd_init diff --git a/mediator/med_phases_post_rof_mod.F90 b/mediator/med_phases_post_rof_mod.F90 index 036eeca30..f21bf2271 100644 --- a/mediator/med_phases_post_rof_mod.F90 +++ b/mediator/med_phases_post_rof_mod.F90 @@ -5,7 +5,7 @@ module med_phases_post_rof_mod 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_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS 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 @@ -22,7 +22,7 @@ module med_phases_post_rof_mod 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 + use shr_log_mod , only : shr_log_error implicit none private @@ -105,7 +105,8 @@ subroutine med_phases_post_rof_init(gcomp, rc) 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') + call shr_log_error('remove_negative_runoff_lnd and remove_negative_runoff_glc must be set to false when flds_wiso is true', rc=rc) + return end if if (maintask) then diff --git a/mediator/med_phases_prep_glc_mod.F90 b/mediator/med_phases_prep_glc_mod.F90 index 4eff5966f..e0e29089a 100644 --- a/mediator/med_phases_prep_glc_mod.F90 +++ b/mediator/med_phases_prep_glc_mod.F90 @@ -7,7 +7,7 @@ module med_phases_prep_glc_mod use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use NUOPC , only : NUOPC_CompAttributeGet use NUOPC_Model , only : NUOPC_ModelGet - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LOGMSG_ERROR, ESMF_SUCCESS, ESMF_FAILURE + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_FAILURE use ESMF , only : ESMF_VM, ESMF_VMGet, ESMF_VMAllReduce, ESMF_REDUCE_SUM, ESMF_REDUCE_MAX use ESMF , only : ESMF_Clock, ESMF_ClockCreate, ESMF_ClockIsCreated use ESMF , only : ESMF_ClockGetAlarm, ESMF_ClockAdvance, ESMF_ClockGet @@ -44,7 +44,8 @@ module med_phases_prep_glc_mod use glc_elevclass_mod , only : glc_get_elevation_classes use glc_elevclass_mod , only : glc_get_fractional_icecov use perf_mod , only : t_startf, t_stopf - + use shr_log_mod , only : shr_log_error + implicit none private @@ -222,9 +223,8 @@ subroutine med_phases_prep_glc_init(gcomp, rc) ! create route handle if it has not been created if (.not. med_map_RH_is_created(is_local%wrap%RH(complnd,compglc(ns),:),mapbilnr,rc=rc)) then - call ESMF_LogWrite(trim(subname)//" mapbilnr is not created for lnd->glc mapping", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) - rc = ESMF_FAILURE + call shr_log_error(trim(subname)//" mapbilnr is not created for lnd->glc mapping", & + line=__LINE__, file=u_FILE_u, rc=rc) return end if end do @@ -239,10 +239,8 @@ subroutine med_phases_prep_glc_init(gcomp, rc) case ('off') smb_renormalize = .false. case default - write(logunit,*) subname,' ERROR: unknown value for glc_renormalize_smb: ', trim(glc_renormalize_smb) - call ESMF_LogWrite(trim(subname)//' ERROR: unknown value for glc_renormalize_smb: '// trim(glc_renormalize_smb), & - ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__) - rc = ESMF_FAILURE + call shr_log_error(trim(subname)//' ERROR: unknown value for glc_renormalize_smb: '// trim(glc_renormalize_smb), & + line=__LINE__, file=__FILE__, rc=rc) return end select if (maintask) then @@ -331,9 +329,8 @@ subroutine med_phases_prep_glc_init(gcomp, rc) ! create route handle if it has not been created do ns = 1,is_local%wrap%num_icesheets if (.not. med_map_RH_is_created(is_local%wrap%RH(compocn,compglc(ns),:),mapbilnr,rc=rc)) then - call ESMF_LogWrite(trim(subname)//" mapbilnr is not created for ocn->glc mapping", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) - rc = ESMF_FAILURE + call shr_log_error(trim(subname)//" mapbilnr is not created for ocn->glc mapping", & + line=__LINE__, file=u_FILE_u, rc=rc) return end if end do diff --git a/mediator/med_phases_prep_ice_mod.F90 b/mediator/med_phases_prep_ice_mod.F90 index 524313622..4aaa8c264 100644 --- a/mediator/med_phases_prep_ice_mod.F90 +++ b/mediator/med_phases_prep_ice_mod.F90 @@ -27,7 +27,6 @@ subroutine med_phases_prep_ice(gcomp, rc) use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_StateGet use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS use ESMF , only : ESMF_FieldBundleGet, ESMF_FieldGet, ESMF_Field - use ESMF , only : ESMF_LOGMSG_ERROR, ESMF_FAILURE use ESMF , only : ESMF_StateItem_Flag, ESMF_STATEITEM_NOTFOUND use ESMF , only : ESMF_VMBroadCast use med_utils_mod , only : chkerr => med_utils_ChkErr diff --git a/mediator/med_phases_prep_lnd_mod.F90 b/mediator/med_phases_prep_lnd_mod.F90 index 4be8bb402..a8c298042 100644 --- a/mediator/med_phases_prep_lnd_mod.F90 +++ b/mediator/med_phases_prep_lnd_mod.F90 @@ -23,7 +23,7 @@ subroutine med_phases_prep_lnd(gcomp, rc) use NUOPC , only : NUOPC_CompAttributeGet use ESMF , only : operator(/=), operator(==) - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LOGMSG_ERROR, ESMF_SUCCESS, ESMF_FAILURE + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet, ESMF_Field, ESMF_FieldGet use ESMF , only : ESMF_GridComp, ESMF_GridCompGet use ESMF , only : ESMF_StateGet, ESMF_StateItem_Flag, ESMF_STATEITEM_NOTFOUND diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index 246ec5866..e30c4ada5 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -78,7 +78,6 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) use ESMF , only : ESMF_GridComp, ESMF_FieldBundleGet use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS - use ESMF , only : ESMF_FAILURE, ESMF_LOGMSG_ERROR use med_constants_mod , only : shr_const_cpsw, shr_const_tkfrz, shr_const_pi use med_phases_prep_atm_mod , only : med_phases_prep_atm_enthalpy_correction @@ -354,7 +353,6 @@ subroutine med_phases_prep_ocn_custom(gcomp, rc) use ESMF , only : ESMF_GridComp, ESMF_StateGet, ESMF_Field, ESMF_FieldGet use ESMF , only : ESMF_VMBroadCast use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS - use ESMF , only : ESMF_FAILURE, ESMF_LOGMSG_ERROR ! input/output variables type(ESMF_GridComp) :: gcomp diff --git a/mediator/med_phases_prep_rof_mod.F90 b/mediator/med_phases_prep_rof_mod.F90 index f0ec87c37..1f6eeb0ba 100644 --- a/mediator/med_phases_prep_rof_mod.F90 +++ b/mediator/med_phases_prep_rof_mod.F90 @@ -26,7 +26,8 @@ module med_phases_prep_rof_mod 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 - + use shr_log_mod , only : shr_log_error + implicit none private @@ -471,7 +472,7 @@ subroutine med_phases_prep_rof_irrig(gcomp, rc) use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet, ESMF_FieldIsCreated use ESMF , only : ESMF_Mesh, ESMF_TYPEKIND_R8, ESMF_MESHLOC_ELEMENT use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE - use ESMF , only : ESMF_LOGMSG_INFO, ESMF_LogWrite, ESMF_LOGMSG_ERROR + use ESMF , only : ESMF_LOGMSG_INFO, ESMF_LogWrite use med_map_mod , only : med_map_rh_is_created, med_map_field, med_map_field_normalized ! input/output variables @@ -516,10 +517,8 @@ subroutine med_phases_prep_rof_irrig(gcomp, rc) else if ( med_map_RH_is_created(is_local%wrap%RH(complnd,comprof,:),mapfcopy, rc=rc)) then maptype_lnd2rof = mapfcopy else - call ESMF_LogWrite(trim(subname)//& - ": ERROR conservative or redist route handles not created for lnd->rof mapping", & - ESMF_LOGMSG_ERROR) - rc = ESMF_FAILURE + call shr_log_error(trim(subname)//& + ": ERROR conservative or redist route handles not created for lnd->rof mapping", rc=rc) return end if @@ -528,10 +527,8 @@ subroutine med_phases_prep_rof_irrig(gcomp, rc) else if ( med_map_RH_is_created(is_local%wrap%RH(comprof,complnd,:),mapfcopy, rc=rc)) then maptype_rof2lnd = mapfcopy else - call ESMF_LogWrite(trim(subname)//& - ": ERROR conservative or redist route handles not created for rof->lnd mapping", & - ESMF_LOGMSG_ERROR) - rc = ESMF_FAILURE + call shr_log_error(trim(subname)//& + ": ERROR conservative or redist route handles not created for rof->lnd mapping", rc=rc) return end if diff --git a/mediator/med_phases_prep_wav_mod.F90 b/mediator/med_phases_prep_wav_mod.F90 index 93755d59c..1cfd158be 100644 --- a/mediator/med_phases_prep_wav_mod.F90 +++ b/mediator/med_phases_prep_wav_mod.F90 @@ -74,7 +74,6 @@ subroutine med_phases_prep_wav_accum(gcomp, rc) use ESMF , only : ESMF_GridComp, ESMF_FieldBundleGet use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS - use ESMF , only : ESMF_FAILURE, ESMF_LOGMSG_ERROR ! input/output variables type(ESMF_GridComp) :: gcomp diff --git a/mediator/med_phases_restart_mod.F90 b/mediator/med_phases_restart_mod.F90 index 3248f5ee4..9f6065fcc 100644 --- a/mediator/med_phases_restart_mod.F90 +++ b/mediator/med_phases_restart_mod.F90 @@ -17,6 +17,8 @@ module med_phases_restart_mod #ifndef CESMCOUPLED use shr_is_restart_fh_mod, only : init_is_restart_fh, is_restart_fh, is_restart_fh_type #endif + use shr_log_mod , only : shr_log_error + implicit none private @@ -48,8 +50,8 @@ subroutine med_phases_restart_alarm_init(gcomp, rc) use ESMF , only : ESMF_Clock, ESMF_ClockGet, ESMF_ClockAdvance, ESMF_ClockSet use ESMF , only : ESMF_Time, ESMF_TimeInterval, ESMF_TimeIntervalGet use ESMF , only : ESMF_Alarm, ESMF_AlarmSet - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LOGMSG_ERROR - use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO + use ESMF , only : ESMF_SUCCESS use NUOPC , only : NUOPC_CompAttributeGet use NUOPC_Model , only : NUOPC_ModelGet use nuopc_shr_methods, only : AlarmInit @@ -135,8 +137,8 @@ subroutine med_phases_restart_write(gcomp, rc) use ESMF , only : ESMF_GridComp, ESMF_VM, ESMF_Clock, ESMF_Time, ESMF_Alarm use ESMF , only : ESMF_TimeInterval, ESMF_CalKind_Flag, ESMF_MAXSTR - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_FAILURE - use ESMF , only : ESMF_LOGMSG_ERROR, operator(==), operator(-) + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS + use ESMF , only : operator(==), operator(-) use ESMF , only : ESMF_GridCompGet, ESMF_ClockGet, ESMF_ClockGetNextTime use ESMF , only : ESMF_TimeGet, ESMF_ClockGetAlarm, ESMF_ClockPrint, ESMF_TimeIntervalGet use ESMF , only : ESMF_AlarmIsRinging, ESMF_AlarmRingerOff, ESMF_FieldBundleIsCreated @@ -189,7 +191,9 @@ subroutine med_phases_restart_write(gcomp, rc) real(R8) :: tbnds(2) ! CF1.0 time bounds logical :: isPresent logical :: first_time = .true. +#ifndef CESMCOUPLED logical :: write_restartfh +#endif character(len=*), parameter :: subname='(med_phases_restart_write)' !--------------------------------------- @@ -497,8 +501,8 @@ subroutine med_phases_restart_read(gcomp, rc) ! Read mediator restart use ESMF , only : ESMF_GridComp, ESMF_VM, ESMF_Clock, ESMF_Time, ESMF_MAXSTR - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_FAILURE - use ESMF , only : ESMF_LOGMSG_ERROR, ESMF_VMBroadCast + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS + use ESMF , only : ESMF_VMBroadCast use ESMF , only : ESMF_GridCompGet, ESMF_ClockGet, ESMF_ClockPrint use ESMF , only : ESMF_FieldBundleIsCreated, ESMF_TimeGet use NUOPC , only : NUOPC_CompAttributeGet @@ -522,7 +526,6 @@ subroutine med_phases_restart_read(gcomp, rc) character(ESMF_MAXSTR) :: case_name ! case name character(ESMF_MAXSTR) :: restart_file ! Local path to restart filename character(ESMF_MAXSTR) :: restart_pfile ! Local path to restart pointer filename - logical :: isPresent character(len=*), parameter :: subname='(med_phases_restart_read)' !--------------------------------------- call t_startf('MED:'//subname) @@ -563,8 +566,7 @@ subroutine med_phases_restart_read(gcomp, rc) open(newunit=unitn, file=restart_pfile, form='FORMATTED', status='old', iostat=ierr) read (unitn,'(a)', iostat=ierr) restart_file if (ierr < 0) then - call ESMF_LogWrite(trim(subname)//' rpointer file read returns error', ESMF_LOGMSG_INFO) - rc=ESMF_Failure + call shr_log_error(trim(subname)//' rpointer file read returns error', rc=rc) return end if close(unitn) From a5e7ab492cd38e1acb869839cdfcd6606cb3ca5a Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Thu, 27 Mar 2025 13:46:55 -0600 Subject: [PATCH 021/123] allow years up to 999999 --- .github/workflows/srt.yml | 4 ++-- mediator/med_phases_history_mod.F90 | 21 +++++++++++++++------ mediator/med_phases_restart_mod.F90 | 12 ++++++++++-- 3 files changed, 27 insertions(+), 10 deletions(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 8b11bfe12..958ca757b 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -27,7 +27,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.7.0 + ESMF_VERSION: v8.8.0 PARALLELIO_VERSION: pio2_6_5 CIME_MODEL: cesm CIME_DRIVER: nuopc @@ -124,7 +124,7 @@ jobs: - name: Build ParallelIO if: steps.cache-PARALLELIO.outputs.cache-hit != 'true' - uses: NCAR/ParallelIO/.github/actions/parallelio_cmake@05173a6556ea8d80eb34e3881a5014ea8f4b7543 + uses: NCAR/ParallelIO/.github/actions/parallelio_cmake@8f5cfc9 with: parallelio_version: ${{ env.ParallelIO_VERSION }} enable_fortran: True diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index b3899c285..5f3bba1e7 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -268,14 +268,20 @@ subroutine med_phases_history_write(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeGet(currtime,yy=yr, mm=mon, dd=day, s=sec, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - write(currtimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec - + if(yr .le. 9999) then + write(currtimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + else + write(currtimestr,'(i6.6,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + endif call ESMF_ClockGetNextTime(mclock, nextTime=nexttime, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeGet(nexttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - write(nexttimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec - + if(yr .le. 9999) then + write(nexttimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + else + write(nexttimestr,'(i6.6,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + endif if (maintask) then write(logunit,*) write(logunit,'(a,i8)') trim(subname)//" : history alarmname "//trim(alarmname)//& @@ -1781,8 +1787,11 @@ subroutine med_phases_history_set_timeinfo(gcomp, hclock, alarmname, & call ESMF_TimeGet(nexttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - write(nexttime_str,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec - + if(yr .le. 9999) then + write(nexttime_str,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + else + write(nexttime_str,'(i6.6,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + endif if (trim(case_name) == 'unset') then call NUOPC_CompAttributeGet(gcomp, name='case_name', value=case_name, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/mediator/med_phases_restart_mod.F90 b/mediator/med_phases_restart_mod.F90 index 9f6065fcc..fc3a0198d 100644 --- a/mediator/med_phases_restart_mod.F90 +++ b/mediator/med_phases_restart_mod.F90 @@ -266,13 +266,21 @@ subroutine med_phases_restart_write(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeGet(currtime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - write(currtimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + if(yr <= 9999) then + write(currtimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + else + write(currtimestr,'(i6.6,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + endif if (dbug_flag > 1) then call ESMF_LogWrite(trim(subname)//": currtime = "//trim(currtimestr), ESMF_LOGMSG_INFO) endif call ESMF_TimeGet(nexttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - write(nexttimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + if(yr <= 9999) then + write(nexttimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + else + write(nexttimestr,'(i6.6,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + endif if (dbug_flag > 1) then call ESMF_LogWrite(trim(subname)//": nexttime = "//trim(nexttimestr), ESMF_LOGMSG_INFO) endif From 9aa34f489444d86210b5f62b3f357d3ce70c5852 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Thu, 27 Mar 2025 14:22:12 -0600 Subject: [PATCH 022/123] change from <= to .le. --- mediator/med_phases_restart_mod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/mediator/med_phases_restart_mod.F90 b/mediator/med_phases_restart_mod.F90 index fc3a0198d..35ea162a6 100644 --- a/mediator/med_phases_restart_mod.F90 +++ b/mediator/med_phases_restart_mod.F90 @@ -266,7 +266,7 @@ subroutine med_phases_restart_write(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeGet(currtime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if(yr <= 9999) then + if(yr .le. 9999) then write(currtimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec else write(currtimestr,'(i6.6,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec @@ -276,7 +276,7 @@ subroutine med_phases_restart_write(gcomp, rc) endif call ESMF_TimeGet(nexttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if(yr <= 9999) then + if(yr .le. 9999) then write(nexttimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec else write(nexttimestr,'(i6.6,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec From eba8a68989eb76d2e85decd21ce02bcebdd79e81 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 28 Mar 2025 08:11:54 -0600 Subject: [PATCH 023/123] update pio hash in github workflow --- .github/workflows/srt.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 958ca757b..31ee1d131 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -124,7 +124,7 @@ jobs: - name: Build ParallelIO if: steps.cache-PARALLELIO.outputs.cache-hit != 'true' - uses: NCAR/ParallelIO/.github/actions/parallelio_cmake@8f5cfc9 + uses: NCAR/ParallelIO/.github/actions/parallelio_cmake@b38e34eeb9b75ce81ac94daf7c5245931de00b9d with: parallelio_version: ${{ env.ParallelIO_VERSION }} enable_fortran: True From 655c342b9e2b1c69166e5b60f0df293c5b81cb98 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 8 Apr 2025 19:09:51 -0600 Subject: [PATCH 024/123] Add glc-derived runoff fluxes and associated heat fluxes to budgets The glc-derived runoff fluxes were being folded into the overall runoff fluxes rather than separated out; the associated heat fluxes were missing entirely. --- mediator/med_diag_mod.F90 | 43 ++++++++++++++++++++++++++++----------- 1 file changed, 31 insertions(+), 12 deletions(-) diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index df0d4e351..6dd8e9808 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -142,13 +142,16 @@ module med_diag_mod integer :: f_heat_latvap = unset_index ! heat : latent, vaporization integer :: f_heat_latf = unset_index ! heat : latent, fusion, snow integer :: f_heat_ioff = unset_index ! heat : latent, fusion, frozen runoff + integer :: f_heat_ioff_glc = unset_index ! heat : latent, fusion, frozen runoff from glc integer :: f_heat_sen = unset_index ! heat : sensible integer :: f_heat_rain = unset_index ! heat : heat content of rain integer :: f_heat_snow = unset_index ! heat : heat content of snow integer :: f_heat_evap = unset_index ! heat : heat content of evaporation integer :: f_heat_cond = unset_index ! heat : heat content of evaporation integer :: f_heat_rofl = unset_index ! heat : heat content of liquid runoff + integer :: f_heat_rofl_glc = unset_index ! heat : heat content of liquid runoff from glc integer :: f_heat_rofi = unset_index ! heat : heat content of ice runoff + integer :: f_heat_rofi_glc = unset_index ! heat : heat content of ice runoff from glc integer :: f_watr_frz = unset_index ! water: freezing integer :: f_watr_melt = unset_index ! water: melting @@ -157,7 +160,9 @@ module med_diag_mod integer :: f_watr_evap = unset_index ! water: evaporation integer :: f_watr_salt = unset_index ! water: water equivalent of salt flux integer :: f_watr_roff = unset_index ! water: runoff/flood + integer :: f_watr_roff_glc = unset_index ! water: runoff/flood from glc integer :: f_watr_ioff = unset_index ! water: frozen runoff + integer :: f_watr_ioff_glc = unset_index ! water: frozen runoff from glc integer :: f_watr_frz_16O = unset_index ! water isotope: freezing integer :: f_watr_melt_16O = unset_index ! water isotope: melting integer :: f_watr_rain_16O = unset_index ! water isotope: precip, liquid @@ -324,6 +329,7 @@ subroutine med_diag_init(gcomp, rc) call add_to_budget_diag(budget_diags%fields, f_heat_latvap ,'hlatvap' ) ! field heat : latent, vaporization call add_to_budget_diag(budget_diags%fields, f_heat_latf ,'hlatfus' ) ! field heat : latent, fusion, snow call add_to_budget_diag(budget_diags%fields, f_heat_ioff ,'hiroff' ) ! field heat : latent, fusion, frozen runoff + call add_to_budget_diag(budget_diags%fields, f_heat_ioff_glc ,'hiroff_glc' ) ! field heat : latent, fusion, frozen runoff from glc call add_to_budget_diag(budget_diags%fields, f_heat_sen ,'hsen' ) ! field heat : sensible if (trim(budget_table_version) == 'v0') then f_heat_beg = f_heat_frz ! field first index for heat @@ -334,9 +340,11 @@ subroutine med_diag_init(gcomp, rc) call add_to_budget_diag(budget_diags%fields, f_heat_evap ,'hevap' ) ! field heat : enthalpy of evaporation call add_to_budget_diag(budget_diags%fields, f_heat_cond ,'hcond' ) ! field heat : enthalpy of evaporation call add_to_budget_diag(budget_diags%fields, f_heat_rofl ,'hrofl' ) ! field heat : enthalpy of liquid runoff + call add_to_budget_diag(budget_diags%fields, f_heat_rofl_glc ,'hrofl_glc') ! field heat : enthalpy of liquid runoff from glc call add_to_budget_diag(budget_diags%fields, f_heat_rofi ,'hrofi' ) ! field heat : enthalpy of ice runoff + call add_to_budget_diag(budget_diags%fields, f_heat_rofi_glc ,'hrofi_glc') ! field heat : enthalpy of ice runoff from glc f_heat_beg = f_heat_frz ! field first index for heat - f_heat_end = f_heat_rofi ! field last index for heat + f_heat_end = f_heat_rofi_glc ! field last index for heat end if ! ----------------------------------------- @@ -355,13 +363,15 @@ subroutine med_diag_init(gcomp, rc) call add_to_budget_diag(budget_diags%fields, f_watr_salt ,'weqsaltf' ) ! field water: water equivalent of salt flux endif call add_to_budget_diag(budget_diags%fields, f_watr_roff ,'wrunoff' ) ! field water: runoff/flood + call add_to_budget_diag(budget_diags%fields, f_watr_roff_glc ,'wrunoff_glc' ) ! field water: runoff/flood from glc call add_to_budget_diag(budget_diags%fields, f_watr_ioff ,'wfrzrof' ) ! field water: frozen runoff + call add_to_budget_diag(budget_diags%fields, f_watr_ioff_glc ,'wfrzrof_glc' ) ! field water: frozen runoff from glc if (trim(budget_table_version) == 'v0') then f_watr_beg = f_watr_frz ! field firs index for water else f_watr_beg = f_watr_melt ! field firs index for water end if - f_watr_end = f_watr_ioff ! field last index for water + f_watr_end = f_watr_ioff_glc ! field last index for water if (flds_wiso) then call add_to_budget_diag(budget_diags%fields, f_watr_frz_16O ,'wfreeze_16O' ) ! field water isotope: freezing @@ -1201,11 +1211,13 @@ subroutine med_phases_diag_rof( gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if ( fldbun_fldchk(is_local%wrap%FBImp(comprof,comprof), 'Forr_rofl_glc', rc=rc)) then - call diag_rof(is_local%wrap%FBImp(comprof,comprof), 'Forr_rofl_glc' , f_watr_roff, ic, areas, budget_local, minus=.true., rc=rc) + call diag_rof(is_local%wrap%FBImp(comprof,comprof), 'Forr_rofl_glc' , f_watr_roff_glc, & + 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) + call diag_rof(is_local%wrap%FBImp(comprof,comprof), 'Forr_rofi_glc' , f_watr_ioff_glc, & + ic, areas, budget_local, minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -1222,6 +1234,7 @@ subroutine med_phases_diag_rof( gcomp, rc) end if budget_local(f_heat_ioff,ic,ip) = -budget_local(f_watr_ioff,ic,ip)*shr_const_latice + budget_local(f_heat_ioff_glc,ic,ip) = -budget_local(f_watr_ioff_glc,ic,ip)*shr_const_latice !------------------------------- ! to river from mediator @@ -1241,11 +1254,11 @@ subroutine med_phases_diag_rof( gcomp, rc) 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) + call diag_rof(is_local%wrap%FBExp(comprof), 'Fgrg_rofl' , f_watr_roff_glc, 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) + call diag_rof(is_local%wrap%FBExp(comprof), 'Fgrg_rofi' , f_watr_ioff_glc, ic, areas, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -1259,6 +1272,7 @@ subroutine med_phases_diag_rof( gcomp, rc) end if budget_local(f_heat_ioff,ic,ip) = -budget_local(f_watr_ioff,ic,ip)*shr_const_latice + budget_local(f_heat_ioff_glc,ic,ip) = -budget_local(f_watr_ioff_glc,ic,ip)*shr_const_latice call t_stopf('MED:'//subname) end subroutine med_phases_diag_rof @@ -1367,15 +1381,15 @@ 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)), 'Fgrg_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_glc, 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)), 'Fgrg_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_glc, 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) + call diag_glc(is_local%wrap%FBImp(compglc(ns),compglc(ns)), 'Figg_rofi', f_watr_ioff_glc, ic, areas, budget_local, minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end do - budget_local(f_heat_ioff,ic,ip) = -budget_local(f_watr_ioff,ic,ip)*shr_const_latice + budget_local(f_heat_ioff_glc,ic,ip) = -budget_local(f_watr_ioff_glc,ic,ip)*shr_const_latice call t_stopf('MED:'//subname) end subroutine med_phases_diag_glc @@ -1555,11 +1569,11 @@ subroutine med_phases_diag_ocn( gcomp, 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) + call diag_ocn(is_local%wrap%FBExp(compocn), 'Forr_rofl_glc' , f_watr_roff_glc, 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) + call diag_ocn(is_local%wrap%FBExp(compocn), 'Forr_rofi_glc' , f_watr_ioff_glc, ic, areas, sfrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -1594,11 +1608,16 @@ subroutine med_phases_diag_ocn( gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hrofl', f_heat_rofl , ic, areas, sfrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hrofl_glc', f_heat_rofl_glc , ic, areas, sfrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hrofi', f_heat_rofi , ic, areas, sfrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hrofi_glc', f_heat_rofi_glc , ic, areas, sfrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return 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 + budget_local(f_heat_ioff_glc,ic,ip) = -budget_local(f_watr_ioff_glc,ic,ip)*shr_const_latice deallocate(sfrac) call t_stopf('MED:'//subname) From 45e055d4d492a3f23c7a1fe93861a13547ba1d85 Mon Sep 17 00:00:00 2001 From: kdraeder Date: Thu, 10 Apr 2025 09:12:21 -0600 Subject: [PATCH 025/123] Make check of ROF_NCPL pass by updating default Fixes issue #551. Components with "_DATM.*_MOM6.*_DROF" in their names have ROF_NCPL set to $ATM_NCPL by default, which can fail the check against $OCN_NCPL. This change enables a resolution TL319_t232 in compset G_JRA_RYF in cesm3.0_alphabranch to build. --- cime_config/config_component_cesm.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/config_component_cesm.xml b/cime_config/config_component_cesm.xml index 0502a47c5..a392f9f88 100644 --- a/cime_config/config_component_cesm.xml +++ b/cime_config/config_component_cesm.xml @@ -379,7 +379,7 @@ integer 8 - $ATM_NCPL + $OCN_NCPL $ATM_NCPL $ATM_NCPL $ATM_NCPL From 17810f3dfd8522afb8fe530de5ef7971a9179969 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Thu, 10 Apr 2025 16:05:42 -0600 Subject: [PATCH 026/123] megan coefs fix --- cesm/nuopc_cap_share/shr_megan_mod.F90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/cesm/nuopc_cap_share/shr_megan_mod.F90 b/cesm/nuopc_cap_share/shr_megan_mod.F90 index 57a218dd7..d26b85814 100644 --- a/cesm/nuopc_cap_share/shr_megan_mod.F90 +++ b/cesm/nuopc_cap_share/shr_megan_mod.F90 @@ -43,13 +43,13 @@ module shr_megan_mod integer :: index real(r8), pointer :: emis_factors(:) ! function of plant-function-type (PFT) integer :: class_number ! MEGAN class number - real(r8) :: coeff ! emissions component coeffecient real(r8) :: molec_weight ! molecular weight of the MEGAN compound (g/mole) type(shr_megan_megcomp_t), pointer :: next_megcomp ! points to next member in the linked list endtype shr_megan_megcomp_t type shr_megan_comp_ptr - type(shr_megan_megcomp_t), pointer :: ptr + type(shr_megan_megcomp_t), pointer :: ptr + real(r8) :: coeff ! emissions component coeffecient endtype shr_megan_comp_ptr ! chemical compound in CAM mechanism that has MEGAN emissions @@ -227,7 +227,8 @@ subroutine shr_megan_init( specifier) if (localPet==0) write(logunit,*) ' species : ', item%name do j = 1,item%n_terms if (localPet==0) write(logunit,'(f12.4,a,a)') item%coeffs(j),' * ', item%vars(j) - shr_megan_mechcomps(i)%megan_comps(j)%ptr => add_megan_comp( item%vars(j), item%coeffs(j) ) + shr_megan_mechcomps(i)%megan_comps(j)%ptr => add_megan_comp( item%vars(j) ) + shr_megan_mechcomps(i)%megan_comps(j)%coeff = item%coeffs(j) enddo shr_megan_mechcomps_n = shr_megan_mechcomps_n+1 @@ -243,10 +244,9 @@ end subroutine shr_megan_init !------------------------------------------------------------------------- - function add_megan_comp( name, coeff ) result(megan_comp) + function add_megan_comp( name ) result(megan_comp) character(len=16), intent(in) :: name - real(r8), intent(in) :: coeff type(shr_megan_megcomp_t), pointer :: megan_comp megan_comp => get_megan_comp_by_name(shr_megan_linkedlist, name) @@ -264,7 +264,7 @@ function add_megan_comp( name, coeff ) result(megan_comp) megan_comp%index = shr_megan_megcomps_n+1 megan_comp%name = trim(name) - megan_comp%coeff = coeff + nullify(megan_comp%next_megcomp) call add_megan_comp_to_list(megan_comp) From a086e9201bcfb3d29396725f03a03462fecfcb09 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Mon, 14 Apr 2025 15:09:27 -0600 Subject: [PATCH 027/123] fix st_archive issues with timestamped rpointer files --- cime_config/config_archive.xml | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/cime_config/config_archive.xml b/cime_config/config_archive.xml index ff8bbf533..4b1a0a091 100644 --- a/cime_config/config_archive.xml +++ b/cime_config/config_archive.xml @@ -4,14 +4,15 @@ hi?\d*.*\.nc$ unset - rpointer.cpl$NINST_STRING + rpointer.cpl$NINST_STRING.$DATENAME $CASE.cpl$NINST_STRING.r.$DATENAME.nc cpl_0001.log.5548574.chadmin1.180228-124723.gz casename.cpl.r.1976-01-01-00000.nc - rpointer.drv_0001 - rpointer.drv + rpointer.cpl_0001.1976-01-01-00000 + rpointer.cpl_0001.1976-01-01-43200 + rpointer.cpl.1976-01-01-00000 casenamenot.cpl.r.1976-01-01-00000.nc From 34c03b799c83fa83d497a7063f90fbbdc24093c5 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Fri, 18 Apr 2025 11:53:46 -0600 Subject: [PATCH 028/123] Improve description of histaux_l2x1yrg Use a description more like what was in cpl7. --- cime_config/namelist_definition_drv.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index bf4c17ccb..318fc8235 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -1794,7 +1794,7 @@ logical aux_hist ALLCOMP_attributes - Auxiliary mediator lnd2med fields every year + Turns on history stream for annual lnd to mediator glc forcing fields .false. From 00cf7e02ab4cb3cd095ac033b245e9dce924efba Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Mon, 21 Apr 2025 13:49:34 -0400 Subject: [PATCH 029/123] add log fh for cmeps restart writing (#140) --- mediator/med_phases_restart_mod.F90 | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/mediator/med_phases_restart_mod.F90 b/mediator/med_phases_restart_mod.F90 index 9f6065fcc..9d1099943 100644 --- a/mediator/med_phases_restart_mod.F90 +++ b/mediator/med_phases_restart_mod.F90 @@ -15,7 +15,8 @@ module med_phases_restart_mod use med_phases_prep_rof_mod , only : FBlndAccum2rof_l, lndAccum2rof_cnt use pio , only : file_desc_t #ifndef CESMCOUPLED - use shr_is_restart_fh_mod, only : init_is_restart_fh, is_restart_fh, is_restart_fh_type + use shr_is_restart_fh_mod , only : init_is_restart_fh, is_restart_fh, is_restart_fh_type + use shr_is_restart_fh_mod , only : log_restart_fh #endif use shr_log_mod , only : shr_log_error @@ -482,6 +483,10 @@ subroutine med_phases_restart_write(gcomp, rc) ! Close file call med_io_close(io_file, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return +#ifndef CESMCOUPLED + call log_restart_fh(nextTime, startTime, 'cmeps', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return +#endif endif !--------------------------------------- From dfa3cb7f3c562e1c073686133987b2619b4e921e Mon Sep 17 00:00:00 2001 From: kdraeder Date: Tue, 22 Apr 2025 11:48:12 -0600 Subject: [PATCH 030/123] Added code to make st-archive handle DART files --- cime_config/config_archive.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/config_archive.xml b/cime_config/config_archive.xml index ff8bbf533..49e64e104 100644 --- a/cime_config/config_archive.xml +++ b/cime_config/config_archive.xml @@ -1,7 +1,7 @@ r - hi?\d*.*\.nc$ + h[ix]?\d*\..*\.nc(\.gz)?$ unset rpointer.cpl$NINST_STRING From c13a393bc0ba6b7dd1a465c98120d456fafe64ed Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Fri, 25 Apr 2025 10:50:57 -0400 Subject: [PATCH 031/123] add missing if-statement --- mediator/med_map_mod.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index e3ae3ae99..363a10bb6 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -1040,6 +1040,8 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, use_data, field_ call med_map_uv_cart3d(FBsrc, FBdst, routehandles, mapbilnr_uv3d, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + else if (mapindex == mapconsf_uv3d) then + ! For mapconsf_uv3d do not use packed field bundles call med_map_uv_cart3d(FBsrc, FBdst, routehandles, mapconsf_uv3d, map_stress=.true., rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return From 89aaadbc9263634702d5e80747a8302c58bca811 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 2 May 2025 09:17:09 -0600 Subject: [PATCH 032/123] add USE_FTORCH variable --- cime_config/config_component.xml | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index 5d831eac9..763031ba0 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -859,7 +859,18 @@ on linking to the PETSc library. Currently this is used by CLM. This is currently only supported for certain machines. - + + + logical + TRUE,FALSE + FALSE + build_def + env_build.xml + TRUE implies linking to the FTorch library to allow calls between + fortran and a PyTorch model that has been saved to TorchScript. + + + logical TRUE,FALSE From a2833b0f53682ed80dff68e9af6d0347c1ea64d2 Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Mon, 5 May 2025 09:47:16 -0400 Subject: [PATCH 033/123] Implement vector remapping from ATM->ICE,OCN and bilinear mapping of ATM states->ICE interpolation (#136) --- .github/workflows/srt.yml | 6 +- cime_config/config_component_cesm.xml | 1 + mediator/esmFldsExchange_ufs_mod.F90 | 174 +++++++++----- mediator/med_internalstate_mod.F90 | 15 +- mediator/med_map_mod.F90 | 323 +++++++++++++++----------- mediator/med_phases_history_mod.F90 | 21 +- mediator/med_phases_ocnalb_mod.F90 | 2 +- mediator/med_phases_restart_mod.F90 | 12 +- 8 files changed, 342 insertions(+), 212 deletions(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 2983dea6f..31ee1d131 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -27,8 +27,8 @@ 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.1 - PARALLELIO_VERSION: pio2_6_3 + ESMF_VERSION: v8.8.0 + PARALLELIO_VERSION: pio2_6_5 CIME_MODEL: cesm CIME_DRIVER: nuopc GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} @@ -124,7 +124,7 @@ jobs: - name: Build ParallelIO if: steps.cache-PARALLELIO.outputs.cache-hit != 'true' - uses: NCAR/ParallelIO/.github/actions/parallelio_cmake@05173a6556ea8d80eb34e3881a5014ea8f4b7543 + uses: NCAR/ParallelIO/.github/actions/parallelio_cmake@b38e34eeb9b75ce81ac94daf7c5245931de00b9d with: parallelio_version: ${{ env.ParallelIO_VERSION }} enable_fortran: True diff --git a/cime_config/config_component_cesm.xml b/cime_config/config_component_cesm.xml index b801f156e..0502a47c5 100644 --- a/cime_config/config_component_cesm.xml +++ b/cime_config/config_component_cesm.xml @@ -269,6 +269,7 @@ 384 192 384 + 192 48 48 48 diff --git a/mediator/esmFldsExchange_ufs_mod.F90 b/mediator/esmFldsExchange_ufs_mod.F90 index cef1a5f69..42acda4d3 100644 --- a/mediator/esmFldsExchange_ufs_mod.F90 +++ b/mediator/esmFldsExchange_ufs_mod.F90 @@ -17,9 +17,9 @@ module esmFldsExchange_ufs_mod character(*), parameter :: u_FILE_u = & __FILE__ -!================================================================================ + !================================================================================ contains -!================================================================================ + !================================================================================ subroutine esmFldsExchange_ufs(gcomp, phase, rc) @@ -30,9 +30,9 @@ subroutine esmFldsExchange_ufs(gcomp, phase, rc) use med_methods_mod , only : fldchk => med_methods_FB_FldChk use med_internalstate_mod , only : InternalState use med_internalstate_mod , only : compmed, compatm, compocn, compice, complnd, compwav, ncomps - use med_internalstate_mod , only : mapbilnr, mapconsf, mapconsd, mappatch + use med_internalstate_mod , only : mapbilnr, mapconsf, mapconsd, mappatch, mappatch_uv3d use med_internalstate_mod , only : mapfcopy, mapnstod, mapnstod_consd, mapnstod_consf - use med_internalstate_mod , only : mapconsf_aofrac, mapbilnr_nstod + use med_internalstate_mod , only : mapconsf_aofrac, mapbilnr_nstod, mapconsf_uv3d use med_internalstate_mod , only : coupling_mode, mapnames, samegrid_atmlnd use esmFlds , only : med_fldList_type use esmFlds , only : addfld_to => med_fldList_addfld_to @@ -53,6 +53,8 @@ subroutine esmFldsExchange_ufs(gcomp, phase, rc) type(InternalState) :: is_local integer :: n, maptype logical :: med_aoflux_to_ocn + logical :: mapuv_with_cart3d + logical :: isPresent, isSet character(len=CX) :: msgString character(len=CL) :: cvalue character(len=CS) :: fldname @@ -60,7 +62,7 @@ subroutine esmFldsExchange_ufs(gcomp, phase, rc) character(len=*) , parameter :: subname='(esmFldsExchange_ufs)' ! component name - character(len=CS) :: lnd_name = '' + character(len=CS) :: lnd_name = '' !-------------------------------------- rc = ESMF_SUCCESS @@ -75,9 +77,9 @@ subroutine esmFldsExchange_ufs(gcomp, phase, rc) ! Set maptype according to coupling_mode if (trim(coupling_mode) == 'ufs.nfrac' .or. trim(coupling_mode) == 'ufs.nfrac.aoflux') then - maptype = mapnstod_consf + maptype = mapnstod_consf else - maptype = mapconsf + maptype = mapconsf end if write(msgString,'(A,i6,A)') trim(subname)//': maptype is ',maptype,', '//mapnames(maptype) call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) @@ -89,6 +91,16 @@ subroutine esmFldsExchange_ufs(gcomp, phase, rc) lnd_name = trim(cvalue) end if + ! uv cart3d mapping, default is true + mapuv_with_cart3d = .true. + call NUOPC_CompAttributeGet(gcomp, name='mapuv_with_cart3d', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + if (trim(cvalue) == 'false') then + mapuv_with_cart3d = .false. + end if + end if + if (trim(coupling_mode) == 'ufs.nfrac.aoflux' .or. trim(coupling_mode) == 'ufs.frac.aoflux') then med_aoflux_to_ocn = .true. else @@ -456,7 +468,11 @@ subroutine esmFldsExchange_ufs(gcomp, phase, rc) fldchk(is_local%wrap%FBImp(compice,compice), 'Fioi_'//fldname, rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_'//fldname, rc=rc)) then call addmap_from(compice, 'Fioi_'//fldname, compocn, mapfcopy, 'unset', 'unset') - call addmap_from(compatm, 'Faxa_'//fldname, compocn, mapconsf_aofrac, 'aofrac', 'unset') + if (mapuv_with_cart3d) then + call addmap_from(compatm, 'Faxa_'//fldname, compocn, mapconsf_uv3d, 'aofrac', 'unset') + else + call addmap_from(compatm, 'Faxa_'//fldname, compocn, mapconsf_aofrac, 'aofrac', 'unset') + end if call addmrg_to(compocn, 'Foxx_'//fldname, & mrg_from=compice, mrg_fld='Fioi_'//fldname, mrg_type='merge', mrg_fracname='ifrac') call addmrg_to(compocn, 'Foxx_'//fldname, & @@ -464,7 +480,7 @@ subroutine esmFldsExchange_ufs(gcomp, phase, rc) end if end if end if - end do + end do deallocate(flds) ! to ocn: net long wave via auto merge @@ -628,8 +644,8 @@ subroutine esmFldsExchange_ufs(gcomp, phase, rc) ! - zonal wind at the lowest model level from atm ! - meridional wind at the lowest model level from atm ! - specific humidity at the lowest model level from atm - allocate(flds(6)) - flds = (/'Sa_u ', 'Sa_v ', 'Sa_z ', 'Sa_tbot', 'Sa_pbot', 'Sa_shum'/) + allocate(flds(4)) + flds = (/'Sa_z ', 'Sa_tbot', 'Sa_pbot', 'Sa_shum'/) do n = 1,size(flds) fldname = trim(flds(n)) if (phase == 'advertise') then @@ -640,13 +656,45 @@ subroutine esmFldsExchange_ufs(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBexp(compice) , fldname, rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), fldname, rc=rc)) then - call addmap_from(compatm, fldname, compice, maptype, 'one', 'unset') + if (med_aoflux_to_ocn) then + call addmap_from(compatm, fldname, compice, maptype, 'one', 'unset') + else + call addmap_from(compatm, fldname, compice, mapbilnr, 'one', 'unset') + end if + call addmrg_to(compice, fldname, mrg_from=compatm, mrg_fld=fldname, mrg_type='copy') + end if + end if + end do + deallocate(flds) + + allocate(flds(2)) + flds = (/'Sa_u', 'Sa_v'/) + do n = 1,size(flds) + fldname = trim(flds(n)) + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compice)) then + call addfld_from(compatm , fldname) + call addfld_to(compice , fldname) + endif + else + if ( fldchk(is_local%wrap%FBexp(compice) , fldname, rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), fldname, rc=rc)) then + if (med_aoflux_to_ocn) then + call addmap_from(compatm, fldname, compice, maptype, 'one', 'unset') + else + if (mapuv_with_cart3d) then + call addmap_from(compatm, fldname, compice, mappatch_uv3d, 'one', 'unset') + else + call addmap_from(compatm, fldname, compice, mappatch, 'one', 'unset') + end if + end if call addmrg_to(compice, fldname, mrg_from=compatm, mrg_fld=fldname, mrg_type='copy') end if end if end do deallocate(flds) + ! to ice: states and fluxes from ocn ! - sea surface temperature from ocn ! - sea surface salinity from ocn @@ -707,58 +755,58 @@ subroutine esmFldsExchange_ufs(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBexp(compwav) , fldname, rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), fldname, rc=rc)) then - call addmap_from(compatm, fldname, compwav, mapbilnr_nstod, 'one', 'unset') + call addmap_from(compatm, fldname, compwav, mapbilnr, 'one', 'unset') call addmrg_to(compwav, fldname, mrg_from=compatm, mrg_fld=fldname, mrg_type='copy') end if end if - end do - deallocate(flds) - - ! to wav: states from ice - ! - sea ice fraction - ! - sea ice thickness - ! - sea ice floe diameter - allocate(flds(3)) - flds = (/'Si_ifrac ', 'Si_floediam', 'Si_thick '/) - do n = 1,size(flds) - fldname = trim(flds(n)) - if (phase == 'advertise') then - if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compwav)) then - call addfld_from(compice , fldname) - call addfld_to(compwav , fldname) - end if - else - if ( fldchk(is_local%wrap%FBexp(compwav) , fldname, rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compice,compice), fldname, rc=rc)) then - call addmap_from(compice, fldname, compwav, mapbilnr_nstod , 'one', 'unset') - call addmrg_to(compwav, fldname, mrg_from=compice, mrg_fld=fldname, mrg_type='copy') - end if - end if - end do - deallocate(flds) - - ! to wav: states from ocn - ! - zonal sea water velocity from ocn - ! - meridional sea water velocity from ocn - ! - surface temperature from ocn - allocate(flds(3)) - flds = (/'So_u', 'So_v', 'So_t'/) - do n = 1,size(flds) - fldname = trim(flds(n)) - if (phase == 'advertise') then - if (is_local%wrap%comp_present(compocn) .and. is_local%wrap%comp_present(compwav)) then - call addfld_from(compocn , fldname) - call addfld_to(compwav , fldname) - end if - else - if ( fldchk(is_local%wrap%FBexp(compwav) , fldname, rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compocn,compocn), fldname, rc=rc)) then - call addmap_from(compocn, fldname, compwav, mapbilnr_nstod , 'one', 'unset') - call addmrg_to(compwav, fldname, mrg_from=compocn, mrg_fld=fldname, mrg_type='copy') - end if - end if - end do - deallocate(flds) + end do + deallocate(flds) + + ! to wav: states from ice + ! - sea ice fraction + ! - sea ice thickness + ! - sea ice floe diameter + allocate(flds(3)) + flds = (/'Si_ifrac ', 'Si_floediam', 'Si_thick '/) + do n = 1,size(flds) + fldname = trim(flds(n)) + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compwav)) then + call addfld_from(compice , fldname) + call addfld_to(compwav , fldname) + end if + else + if ( fldchk(is_local%wrap%FBexp(compwav) , fldname, rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice), fldname, rc=rc)) then + call addmap_from(compice, fldname, compwav, mapbilnr_nstod , 'one', 'unset') + call addmrg_to(compwav, fldname, mrg_from=compice, mrg_fld=fldname, mrg_type='copy') + end if + end if + end do + deallocate(flds) + + ! to wav: states from ocn + ! - zonal sea water velocity from ocn + ! - meridional sea water velocity from ocn + ! - surface temperature from ocn + allocate(flds(3)) + flds = (/'So_u', 'So_v', 'So_t'/) + do n = 1,size(flds) + fldname = trim(flds(n)) + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compocn) .and. is_local%wrap%comp_present(compwav)) then + call addfld_from(compocn , fldname) + call addfld_to(compwav , fldname) + end if + else + if ( fldchk(is_local%wrap%FBexp(compwav) , fldname, rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compocn,compocn), fldname, rc=rc)) then + call addmap_from(compocn, fldname, compwav, mapbilnr_nstod , 'one', 'unset') + call addmrg_to(compwav, fldname, mrg_from=compocn, mrg_fld=fldname, mrg_type='copy') + end if + end if + end do + deallocate(flds) !===================================================================== ! FIELDS TO LAND (complnd) @@ -814,8 +862,8 @@ subroutine esmFldsExchange_ufs(gcomp, phase, rc) call addmrg_to(complnd, fldname, mrg_from=compatm, mrg_fld=fldname, mrg_type='copy') end if end if - end do - deallocate(flds) + end do + deallocate(flds) end if ! lm4 end subroutine esmFldsExchange_ufs diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index e8d30eb5d..b0caebd9a 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -77,7 +77,8 @@ module med_internalstate_mod integer , public, parameter :: mapfillv_bilnr = 15 ! fill value followed by bilinear integer , public, parameter :: mapbilnr_nstod = 16 ! bilinear with nstod extrapolation integer , public, parameter :: mapconsf_aofrac = 17 ! conservative with aofrac normalization (ufs only) - integer , public, parameter :: nmappers = 17 + integer , public, parameter :: mapconsf_uv3d = 18 ! conservative with uv3d mapping + integer , public, parameter :: nmappers = 18 character(len=*) , public, parameter :: mapnames(nmappers) = & (/'bilnr ',& 'consf ',& @@ -95,7 +96,8 @@ module med_internalstate_mod 'glc2ocn_liq ',& 'fillv_bilnr ',& 'bilnr_nstod ',& - 'consf_aofrac'/) + 'consf_aofrac',& + 'consf_uv3d '/) type, public :: packed_data_type integer, allocatable :: fldindex(:) ! size of number of packed fields @@ -688,17 +690,16 @@ subroutine med_internalstate_defaultmasks(gcomp, rc) if (is_local%wrap%comp_present(compice)) defaultMasks(compice,:) = 0 if (is_local%wrap%comp_present(compwav)) defaultMasks(compwav,:) = 0 if ( coupling_mode(1:3) == 'ufs') then - if (is_local%wrap%comp_present(compatm)) defaultMasks(compatm,:) = 1 + if (is_local%wrap%comp_present(compatm)) defaultMasks(compatm,2) = 1 endif - if ( trim(coupling_mode) == 'hafs') then + if ( trim(coupling_mode) == 'hafs') then ! not hafs.mom6 if (is_local%wrap%comp_present(compatm)) defaultMasks(compatm,1) = 1 endif - if ( trim(coupling_mode) /= 'cesm') then - if (is_local%wrap%comp_present(compatm) .and. trim(atm_name(1:4)) == 'datm') then + if ( coupling_mode /= 'cesm') then + if (is_local%wrap%comp_present(compatm) .and. atm_name(1:4) == 'datm') then defaultMasks(compatm,1) = 0 end if end if - end subroutine med_internalstate_defaultmasks end module med_internalstate_mod diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 5caeb8ca6..a3d50c5e4 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -10,7 +10,7 @@ module med_map_mod use med_utils_mod , only : chkerr => med_utils_ChkErr use perf_mod , only : t_startf, t_stopf use shr_log_mod , only : shr_log_error - + implicit none private @@ -299,7 +299,7 @@ end subroutine med_map_RouteHandles_initfrom_esmflds subroutine med_map_routehandles_initfrom_fieldbundle(n1, n2, FBsrc, FBdst, mapindex, RouteHandle, rc) use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_LogFlush - use ESMF , only : ESMf_Field, ESMF_FieldBundle, ESMF_RouteHandle + use ESMF , only : ESMF_Field, ESMF_FieldBundle, ESMF_RouteHandle use med_methods_mod , only : med_methods_FB_getFieldN !--------------------------------------------- @@ -361,7 +361,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, use med_internalstate_mod , only : mapbilnr, mapconsf, mapconsd, mappatch, mappatch_uv3d, mapbilnr_uv3d, mapfcopy use med_internalstate_mod , only : mapunset, mapnames, nmappers use med_internalstate_mod , only : mapnstod, mapnstod_consd, mapnstod_consf, mapnstod_consd - use med_internalstate_mod , only : mapfillv_bilnr, mapbilnr_nstod, mapconsf_aofrac + use med_internalstate_mod , only : mapfillv_bilnr, mapbilnr_nstod, mapconsf_aofrac, mapconsf_uv3d use med_internalstate_mod , only : compocn, compwav, complnd, compname, compatm use med_internalstate_mod , only : coupling_mode use med_internalstate_mod , only : defaultMasks @@ -467,34 +467,46 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, ignoreUnmatchedIndices=.true., & srcTermProcessing=srcTermProcessing_Value, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - else if (mapindex == mapbilnr .or. mapindex == mapbilnr_uv3d) then - if (.not. ESMF_RouteHandleIsCreated(routehandles(mapbilnr))) then + else if (mapindex == mapbilnr ) then if (maintask) then write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//' for '//trim(string) end if call ESMF_FieldRegridStore(fldsrc, flddst, routehandle=routehandles(mapbilnr), & - srcMaskValues=(/srcMaskValue/), & - dstMaskValues=(/dstMaskValue/), & - regridmethod=ESMF_REGRIDMETHOD_BILINEAR, & - polemethod=polemethod, & + srcMaskValues=(/srcMaskValue/), & + dstMaskValues=(/dstMaskValue/), & + regridmethod=ESMF_REGRIDMETHOD_BILINEAR, & + polemethod=polemethod, & srcTermProcessing=srcTermProcessing_Value, & - ignoreDegenerate=.true., & - dstStatusField=lfield, & + ignoreDegenerate=.true., & + dstStatusField=lfield, & unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + else if (mapindex == mapbilnr_uv3d ) then + if (maintask) then + write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//' for '//trim(string) end if + call ESMF_FieldRegridStore(fldsrc, flddst, routehandle=routehandles(mapbilnr_uv3d), & + srcMaskValues=(/srcMaskValue/), & + dstMaskValues=(/dstMaskValue/), & + regridmethod=ESMF_REGRIDMETHOD_BILINEAR, & + polemethod=polemethod, & + srcTermProcessing=srcTermProcessing_Value, & + ignoreDegenerate=.true., & + dstStatusField=lfield, & + unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return else if (mapindex == mapfillv_bilnr) then if (maintask) then write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//' for '//trim(string) end if call ESMF_FieldRegridStore(fldsrc, flddst, routehandle=routehandles(mapfillv_bilnr), & - srcMaskValues=(/srcMaskValue/), & - dstMaskValues=(/dstMaskValue/), & - regridmethod=ESMF_REGRIDMETHOD_BILINEAR, & - polemethod=polemethod, & + srcMaskValues=(/srcMaskValue/), & + dstMaskValues=(/dstMaskValue/), & + regridmethod=ESMF_REGRIDMETHOD_BILINEAR, & + polemethod=polemethod, & srcTermProcessing=srcTermProcessing_Value, & - ignoreDegenerate=.true., & - dstStatusField=lfield, & + ignoreDegenerate=.true., & + dstStatusField=lfield, & unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return else if (mapindex == mapbilnr_nstod) then @@ -502,14 +514,14 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//' for '//trim(string) end if call ESMF_FieldRegridStore(fldsrc, flddst, routehandle=routehandles(mapbilnr_nstod), & - srcMaskValues=(/srcMaskValue/), & - dstMaskValues=(/dstMaskValue/), & - regridmethod=ESMF_REGRIDMETHOD_BILINEAR, & + srcMaskValues=(/srcMaskValue/), & + dstMaskValues=(/dstMaskValue/), & + regridmethod=ESMF_REGRIDMETHOD_BILINEAR, & extrapMethod=ESMF_EXTRAPMETHOD_NEAREST_STOD, & - polemethod=polemethod, & - srcTermProcessing=srcTermProcessing_Value, & - ignoreDegenerate=.true., & - dstStatusField=lfield, & + polemethod=polemethod, & + srcTermProcessing=srcTermProcessing_Value, & + ignoreDegenerate=.true., & + dstStatusField=lfield, & unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return else if (mapindex == mapconsf .or. mapindex == mapnstod_consf) then @@ -517,71 +529,85 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//' for '//trim(string) end if call ESMF_FieldRegridStore(fldsrc, flddst, routehandle=routehandles(mapconsf), & - srcMaskValues=(/srcMaskValue/), & - dstMaskValues=(/dstMaskValue/), & - regridmethod=ESMF_REGRIDMETHOD_CONSERVE, & - normType=ESMF_NORMTYPE_FRACAREA, & + srcMaskValues=(/srcMaskValue/), & + dstMaskValues=(/dstMaskValue/), & + regridmethod=ESMF_REGRIDMETHOD_CONSERVE, & + normType=ESMF_NORMTYPE_FRACAREA, & srcTermProcessing=srcTermProcessing_Value, & - ignoreDegenerate=.true., & - dstStatusField=lfield, & - unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & - rc=rc) + ignoreDegenerate=.true., & + dstStatusField=lfield, & + unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return else if (mapindex == mapconsf_aofrac) then - if (.not. ESMF_RouteHandleIsCreated(routehandles(mapconsf))) then - if (maintask) then - write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//' for '//trim(string) - end if - call ESMF_FieldRegridStore(fldsrc, flddst, routehandle=routehandles(mapconsf_aofrac), & - srcMaskValues=(/srcMaskValue/), & - dstMaskValues=(/dstMaskValue/), & - regridmethod=ESMF_REGRIDMETHOD_CONSERVE, & - normType=ESMF_NORMTYPE_FRACAREA, & - srcTermProcessing=srcTermProcessing_Value, & - ignoreDegenerate=.true., & - dstStatusField=lfield, & - unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & - rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - else - ! Copy existing consf RH - if (maintask) then - write(logunit,'(A)') trim(subname)//' copying RH(mapconsf) to '//trim(mapname)//' for '//trim(string) - end if - routehandles(mapconsf_aofrac) = ESMF_RouteHandleCreate(routehandles(mapconsf), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + if (maintask) then + write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//' for '//trim(string) + end if + call ESMF_FieldRegridStore(fldsrc, flddst, routehandle=routehandles(mapconsf_aofrac), & + srcMaskValues=(/srcMaskValue/), & + dstMaskValues=(/dstMaskValue/), & + regridmethod=ESMF_REGRIDMETHOD_CONSERVE, & + normType=ESMF_NORMTYPE_FRACAREA, & + srcTermProcessing=srcTermProcessing_Value, & + ignoreDegenerate=.true., & + dstStatusField=lfield, & + unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else if (mapindex == mapconsf_uv3d) then + if (maintask) then + write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//' for '//trim(string) end if + call ESMF_FieldRegridStore(fldsrc, flddst, routehandle=routehandles(mapconsf_uv3d), & + srcMaskValues=(/srcMaskValue/), & + dstMaskValues=(/dstMaskValue/), & + regridmethod=ESMF_REGRIDMETHOD_CONSERVE, & + normType=ESMF_NORMTYPE_FRACAREA, & + srcTermProcessing=srcTermProcessing_Value, & + ignoreDegenerate=.true., & + dstStatusField=lfield, & + unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return else if (mapindex == mapconsd .or. mapindex == mapnstod_consd) then if (maintask) then write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//' for '//trim(string) end if call ESMF_FieldRegridStore(fldsrc, flddst, routehandle=routehandles(mapconsd), & - srcMaskValues=(/srcMaskValue/), & - dstMaskValues=(/dstMaskValue/), & - regridmethod=ESMF_REGRIDMETHOD_CONSERVE, & - normType=ESMF_NORMTYPE_DSTAREA, & + srcMaskValues=(/srcMaskValue/), & + dstMaskValues=(/dstMaskValue/), & + regridmethod=ESMF_REGRIDMETHOD_CONSERVE, & + normType=ESMF_NORMTYPE_DSTAREA, & srcTermProcessing=srcTermProcessing_Value, & - ignoreDegenerate=.true., & - dstStatusField=lfield, & - unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & - rc=rc) + ignoreDegenerate=.true., & + dstStatusField=lfield, & + unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - else if (mapindex == mappatch .or. mapindex == mappatch_uv3d) then - if (.not. ESMF_RouteHandleIsCreated(routehandles(mappatch))) then - if (maintask) then - write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//' for '//trim(string) - end if - call ESMF_FieldRegridStore(fldsrc, flddst, routehandle=routehandles(mappatch), & - srcMaskValues=(/srcMaskValue/), & - dstMaskValues=(/dstMaskValue/), & - regridmethod=ESMF_REGRIDMETHOD_PATCH, & - polemethod=polemethod, & - srcTermProcessing=srcTermProcessing_Value, & - ignoreDegenerate=.true., & - dstStatusField=lfield, & - unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + else if (mapindex == mappatch ) then + if (maintask) then + write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//' for '//trim(string) end if + call ESMF_FieldRegridStore(fldsrc, flddst, routehandle=routehandles(mappatch), & + srcMaskValues=(/srcMaskValue/), & + dstMaskValues=(/dstMaskValue/), & + regridmethod=ESMF_REGRIDMETHOD_PATCH, & + polemethod=polemethod, & + srcTermProcessing=srcTermProcessing_Value, & + ignoreDegenerate=.true., & + dstStatusField=lfield, & + unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else if (mapindex == mappatch_uv3d ) then + if (maintask) then + write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//' for '//trim(string) + end if + call ESMF_FieldRegridStore(fldsrc, flddst, routehandle=routehandles(mappatch_uv3d), & + srcMaskValues=(/srcMaskValue/), & + dstMaskValues=(/dstMaskValue/), & + regridmethod=ESMF_REGRIDMETHOD_PATCH, & + polemethod=polemethod, & + srcTermProcessing=srcTermProcessing_Value, & + ignoreDegenerate=.true., & + dstStatusField=lfield, & + unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return else call shr_log_error(trim(subname)//' mapindex '//trim(mapname)//' not supported for '//trim(string), & line=__LINE__, file=u_FILE_u, rc=rc) @@ -922,7 +948,7 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, use_data, field_ use ESMF , only : ESMF_KIND_R8 use ESMF , only : ESMF_Region_Flag, ESMF_REGION_SELECT, ESMF_REGION_TOTAL use med_internalstate_mod , only : nmappers, mapfcopy - use med_internalstate_mod , only : mappatch_uv3d, mappatch, mapbilnr_uv3d, mapbilnr + use med_internalstate_mod , only : mappatch_uv3d, mappatch, mapbilnr_uv3d, mapconsf_uv3d, mapbilnr use med_internalstate_mod , only : packed_data_type use med_methods_mod , only : Field_diagnose => med_methods_Field_diagnose @@ -1005,15 +1031,20 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, use_data, field_ if (mapindex == mappatch_uv3d) then ! For mappatch_uv3d do not use packed field bundles - call med_map_uv_cart3d(FBsrc, FBdst, routehandles, mappatch, rc=rc) + call med_map_uv_cart3d(FBsrc, FBdst, routehandles, mappatch_uv3d, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return else if (mapindex == mapbilnr_uv3d) then ! For mapbilnr_uv3d do not use packed field bundles - call med_map_uv_cart3d(FBsrc, FBdst, routehandles, mapbilnr, rc=rc) + call med_map_uv_cart3d(FBsrc, FBdst, routehandles, mapbilnr_uv3d, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + else if (mapindex == mapconsf_uv3d) then + + ! For mapconsf_uv3d do not use packed field bundles + call med_map_uv_cart3d(FBsrc, FBdst, routehandles, mapconsf_uv3d, map_stress=.true., rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return else ! ----------------------------------- @@ -1454,12 +1485,14 @@ subroutine med_map_field(field_src, field_dst, routehandles, maptype, fldname, z end subroutine med_map_field !================================================================================ - subroutine med_map_uv_cart3d(FBsrc, FBdst, routehandles, mapindex, rc) - - use ESMF , only : ESMF_Mesh, ESMF_MeshGet, ESMF_MESHLOC_ELEMENT, ESMF_TYPEKIND_R8 - use ESMF , only : ESMF_Field, ESMF_FieldCreate, ESMF_FieldGet - use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet - use ESMF , only : ESMF_RouteHandle + subroutine med_map_uv_cart3d(FBsrc, FBdst, routehandles, mapindex, map_stress, rc) + + use ESMF , only : operator(==) + use ESMF , only : ESMF_Mesh, ESMF_MeshGet, ESMF_MESHLOC_ELEMENT, ESMF_TYPEKIND_R8 + use ESMF , only : ESMF_Field, ESMF_FieldCreate, ESMF_FieldGet + use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet + use ESMF , only : ESMF_RouteHandle + use ESMF , only : ESMF_CoordSys_Flag, ESMF_COORDSYS_SPH_DEG, ESMF_COORDSYS_SPH_RAD use med_constants_mod , only : shr_const_pi ! input/output variables @@ -1467,48 +1500,68 @@ subroutine med_map_uv_cart3d(FBsrc, FBdst, routehandles, mapindex, rc) type(ESMF_FieldBundle) , intent(inout) :: FBdst type(ESMF_RouteHandle) , intent(inout) :: routehandles(:) integer , intent(in) :: mapindex + logical, optional , intent(in) :: map_stress integer , intent(out) :: rc ! local variables - type(ESMF_Field) :: usrc - type(ESMF_Field) :: vsrc - type(ESMF_Field) :: udst - type(ESMF_Field) :: vdst - integer :: n - real(r8) :: lon,lat - real(r8) :: coslon,coslat - real(r8) :: sinlon,sinlat - real(r8) :: ux,uy,uz - type(ESMF_Mesh) :: lmesh_src - type(ESMF_Mesh) :: lmesh_dst - real(r8), pointer :: data_u_src(:) - real(r8), pointer :: data_u_dst(:) - real(r8), pointer :: data_v_src(:) - real(r8), pointer :: data_v_dst(:) - real(r8), pointer :: data2d_src(:,:) - real(r8), pointer :: data2d_dst(:,:) - real(r8), pointer :: ownedElemCoords_src(:) - real(r8), pointer :: ownedElemCoords_dst(:) - integer :: numOwnedElements - integer :: spatialDim - real(r8), parameter :: deg2rad = shr_const_pi/180.0_R8 ! deg to rads - logical :: first_time = .true. + type(ESMF_Field) :: usrc + type(ESMF_Field) :: vsrc + type(ESMF_Field) :: udst + type(ESMF_Field) :: vdst + type(ESMF_CoordSys_Flag) :: coordsys_src + type(ESMF_CoordSys_Flag) :: coordsys_dst + integer :: n + real(r8) :: lon,lat + real(r8) :: coslon,coslat + real(r8) :: sinlon,sinlat + real(r8) :: ux,uy,uz + type(ESMF_Mesh) :: lmesh_src + type(ESMF_Mesh) :: lmesh_dst + real(r8), pointer :: data_u_src(:) + real(r8), pointer :: data_u_dst(:) + real(r8), pointer :: data_v_src(:) + real(r8), pointer :: data_v_dst(:) + real(r8), pointer :: data2d_src(:,:) + real(r8), pointer :: data2d_dst(:,:) + real(r8), pointer :: ownedElemCoords_src(:) + real(r8), pointer :: ownedElemCoords_dst(:) + integer :: numOwnedElements + integer :: spatialDim + real(r8), parameter :: deg2rad = shr_const_pi/180.0_R8 ! deg to rads + logical :: first_time = .true. + logical :: lmap_stress + character(len=CS) :: uname, vname character(len=*), parameter :: subname=' (med_map_mod:med_map_uv_cart3d) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS + lmap_stress = .false. + if (present(map_stress)) then + lmap_stress = map_stress + end if + + if (lmap_stress) then + ! Get fields for atm zonal and merid stresses + uname = 'Faxa_taux' + vname = 'Faxa_tauy' + else + ! Get fields for atm u,v velocities + uname = 'Sa_u' + vname = 'Sa_v' + end if + ! Get fields for atm u,v velocities - call ESMF_FieldBundleGet(FBSrc, fieldName='Sa_u', field=usrc, rc=rc) + call ESMF_FieldBundleGet(FBSrc, fieldName=trim(uname), field=usrc, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldBundleGet(FBDst, fieldName='Sa_u', field=udst, rc=rc) + call ESMF_FieldBundleGet(FBDst, fieldName=trim(uname), field=udst, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldBundleGet(FBSrc, fieldName='Sa_v', field=vsrc, rc=rc) + call ESMF_FieldBundleGet(FBSrc, fieldName=trim(vname), field=vsrc, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldBundleGet(FBDst, fieldName='Sa_v', field=vdst, rc=rc) + call ESMF_FieldBundleGet(FBDst, fieldName=trim(vname), field=vdst, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ! GET pointer to input u and v data source field data + ! Get pointer to input u and v data source field data call ESMF_FieldGet(usrc, farrayPtr=data_u_src, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldGet(vsrc, farrayPtr=data_v_src, rc=rc) @@ -1524,19 +1577,19 @@ subroutine med_map_uv_cart3d(FBsrc, FBdst, routehandles, mapindex, rc) ! Get source mesh and coordinates call ESMF_FieldGet(usrc, mesh=lmesh_src, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_MeshGet(lmesh_src, spatialDim=spatialDim, numOwnedElements=numOwnedElements, rc=rc) + call ESMF_MeshGet(lmesh_src, spatialDim=spatialDim, numOwnedElements=numOwnedElements, coordSys=coordsys_src, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return allocate(ownedElemCoords_src(spatialDim*numOwnedElements)) - call ESMF_MeshGet(lmesh_src, ownedElemCoords=ownedElemCoords_src) + call ESMF_MeshGet(lmesh_src, ownedElemCoords=ownedElemCoords_src, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! Get destination mesh and coordinates call ESMF_FieldGet(udst, mesh=lmesh_dst, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_MeshGet(lmesh_dst, spatialDim=spatialDim, numOwnedElements=numOwnedElements, rc=rc) + call ESMF_MeshGet(lmesh_dst, spatialDim=spatialDim, numOwnedElements=numOwnedElements, coordSys=coordsys_dst, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return allocate(ownedElemCoords_dst(spatialDim*numOwnedElements)) - call ESMF_MeshGet(lmesh_dst, ownedElemCoords=ownedElemCoords_dst) + call ESMF_MeshGet(lmesh_dst, ownedElemCoords=ownedElemCoords_dst, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (first_time) then @@ -1561,12 +1614,17 @@ subroutine med_map_uv_cart3d(FBsrc, FBdst, routehandles, mapindex, rc) ! Rotate Source data to cart3d do n = 1,size(data_u_src) - lon = ownedElemCoords_src(2*n-1) - lat = ownedElemCoords_src(2*n) - sinlon = sin(lon*deg2rad) - coslon = cos(lon*deg2rad) - sinlat = sin(lat*deg2rad) - coslat = cos(lat*deg2rad) + if (coordsys_src == ESMF_COORDSYS_SPH_DEG) then + lon = deg2rad*ownedElemCoords_src(2*n-1) + lat = deg2rad*ownedElemCoords_src(2*n) + else + lon = ownedElemCoords_src(2*n-1) + lat = ownedElemCoords_src(2*n) + end if + sinlon = sin(lon) + coslon = cos(lon) + sinlat = sin(lat) + coslat = cos(lat) data2d_src(1,n) = -coslon*sinlat*data_v_src(n) - sinlon*data_u_src(n) ! x data2d_src(2,n) = -sinlon*sinlat*data_v_src(n) + coslon*data_u_src(n) ! y data2d_src(3,n) = coslat*data_v_src(n) ! z @@ -1579,12 +1637,17 @@ subroutine med_map_uv_cart3d(FBsrc, FBdst, routehandles, mapindex, rc) ! Rotate destination data back from cart3d to original do n = 1,size(data_u_dst) - lon = ownedElemCoords_dst(2*n-1) - lat = ownedElemCoords_dst(2*n) - sinlon = sin(lon*deg2rad) - coslon = cos(lon*deg2rad) - sinlat = sin(lat*deg2rad) - coslat = cos(lat*deg2rad) + if (coordsys_dst == ESMF_COORDSYS_SPH_DEG) then + lon = deg2rad*ownedElemCoords_dst(2*n-1) + lat = deg2rad*ownedElemCoords_dst(2*n) + else + lon = ownedElemCoords_dst(2*n-1) + lat = ownedElemCoords_dst(2*n) + end if + sinlon = sin(lon) + coslon = cos(lon) + sinlat = sin(lat) + coslat = cos(lat) ux = data2d_dst(1,n) uy = data2d_dst(2,n) uz = data2d_dst(3,n) diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index b3899c285..5f3bba1e7 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -268,14 +268,20 @@ subroutine med_phases_history_write(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeGet(currtime,yy=yr, mm=mon, dd=day, s=sec, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - write(currtimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec - + if(yr .le. 9999) then + write(currtimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + else + write(currtimestr,'(i6.6,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + endif call ESMF_ClockGetNextTime(mclock, nextTime=nexttime, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeGet(nexttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - write(nexttimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec - + if(yr .le. 9999) then + write(nexttimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + else + write(nexttimestr,'(i6.6,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + endif if (maintask) then write(logunit,*) write(logunit,'(a,i8)') trim(subname)//" : history alarmname "//trim(alarmname)//& @@ -1781,8 +1787,11 @@ subroutine med_phases_history_set_timeinfo(gcomp, hclock, alarmname, & call ESMF_TimeGet(nexttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - write(nexttime_str,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec - + if(yr .le. 9999) then + write(nexttime_str,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + else + write(nexttime_str,'(i6.6,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + endif if (trim(case_name) == 'unset') then call NUOPC_CompAttributeGet(gcomp, name='case_name', value=case_name, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/mediator/med_phases_ocnalb_mod.F90 b/mediator/med_phases_ocnalb_mod.F90 index 0a09c76aa..b7c95389a 100644 --- a/mediator/med_phases_ocnalb_mod.F90 +++ b/mediator/med_phases_ocnalb_mod.F90 @@ -519,7 +519,7 @@ subroutine med_phases_ocnalb_orbital_init(gcomp, logunit, maintask, rc) use ESMF , only : ESMF_GridComp, ESMF_GridCompGet use ESMF , only : ESMF_LogWrite, ESMF_LogFoundError, ESMF_LogSetError - use ESMF , only : ESMf_SUCCESS, ESMF_FAILURE, ESMF_LOGMSG_INFO, ESMF_RC_NOT_VALID + use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE, ESMF_LOGMSG_INFO, ESMF_RC_NOT_VALID use NUOPC , only : NUOPC_CompAttributeGet ! input/output variables diff --git a/mediator/med_phases_restart_mod.F90 b/mediator/med_phases_restart_mod.F90 index 9d1099943..f3a83198e 100644 --- a/mediator/med_phases_restart_mod.F90 +++ b/mediator/med_phases_restart_mod.F90 @@ -267,13 +267,21 @@ subroutine med_phases_restart_write(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeGet(currtime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - write(currtimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + if(yr .le. 9999) then + write(currtimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + else + write(currtimestr,'(i6.6,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + endif if (dbug_flag > 1) then call ESMF_LogWrite(trim(subname)//": currtime = "//trim(currtimestr), ESMF_LOGMSG_INFO) endif call ESMF_TimeGet(nexttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - write(nexttimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + if(yr .le. 9999) then + write(nexttimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + else + write(nexttimestr,'(i6.6,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + endif if (dbug_flag > 1) then call ESMF_LogWrite(trim(subname)//": nexttime = "//trim(nexttimestr), ESMF_LOGMSG_INFO) endif From 3b69aeab2dd93a04276a51e68c9d5e9c92c88712 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Tue, 6 May 2025 12:45:14 -0600 Subject: [PATCH 034/123] add TORCH_DIR xml variable --- cime_config/config_component.xml | 18 +++++++++++++----- 1 file changed, 13 insertions(+), 5 deletions(-) diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index 763031ba0..11df016e5 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -859,7 +859,7 @@ on linking to the PETSc library. Currently this is used by CLM. This is currently only supported for certain machines. - + logical TRUE,FALSE @@ -870,7 +870,15 @@ fortran and a PyTorch model that has been saved to TorchScript. - + + + char + + build_def + env_build.xml + location of libtorch and supporting libraries, may be supplied by ftorch interface if not present + + logical TRUE,FALSE @@ -1451,7 +1459,7 @@ env_run.xml wav2ocn state mapping file - + char 1.0e-02 @@ -1824,7 +1832,7 @@ env_mach_pes.xml Number of GPUs per node used for simulation - + integer 0 @@ -1832,7 +1840,7 @@ env_mach_pes.xml Maximum number of GPUs allowed per node - + integer $MAX_MPITASKS_PER_NODE From 0a246bb7e7ad2a93aa5190b95cecdf3e75be1ad5 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Thu, 8 May 2025 07:38:08 -0600 Subject: [PATCH 035/123] update for external compatibilty --- cime_config/config_component.xml | 37 ++++++++++++++++++++++++++++++++ 1 file changed, 37 insertions(+) diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index 11df016e5..c1270ae24 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -62,6 +62,27 @@ + + char + rpointer.cpl + run_begin_stop_restart + env_run.xml + + Name of the restart pointer file, this can be used to restart from an + intermediate restart by appending the restart date and time in format YYYY-MM-DD-SSSSS + + + + + logical + TRUE,FALSE + FALSE + run_data_archive + env_run.xml + Logical to run post-processing analysis tools. + If TRUE, post-processing scripts will be run + + char UNSET @@ -1744,6 +1765,22 @@ env_mach_pes.xml ROOTPE (mpi task in MPI_COMM_WORLD) for each component + + integer + 0 + mach_pes_last + env_mach_pes.xml + minimum memory request per node (currently only used on derecho) + + + + integer + 0 + mach_pes_last + env_mach_pes.xml + maximum memory request per node (currently only used on derecho) + + logical TRUE From 21c28034c334742fe1770a0a716ced57ea02a2b5 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Mon, 12 May 2025 11:24:07 -0600 Subject: [PATCH 036/123] add FTorch support --- cime_config/config_component.xml | 38 +------------------------------- 1 file changed, 1 insertion(+), 37 deletions(-) diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index 9716a16af..872f45c93 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -62,27 +62,6 @@ - - char - rpointer.cpl - run_begin_stop_restart - env_run.xml - - Name of the restart pointer file, this can be used to restart from an - intermediate restart by appending the restart date and time in format YYYY-MM-DD-SSSSS - - - - - logical - TRUE,FALSE - FALSE - run_data_archive - env_run.xml - Logical to run post-processing analysis tools. - If TRUE, post-processing scripts will be run - - char UNSET @@ -1786,22 +1765,7 @@ env_mach_pes.xml ROOTPE (mpi task in MPI_COMM_WORLD) for each component - - integer - 0 - mach_pes_last - env_mach_pes.xml - minimum memory request per node (currently only used on derecho) - - - - integer - 0 - mach_pes_last - env_mach_pes.xml - maximum memory request per node (currently only used on derecho) - - + logical TRUE From 5c3a8409a24cdd393d7cb626bca3098e668a928e Mon Sep 17 00:00:00 2001 From: "G. Dylan Dickerson" Date: Fri, 28 Apr 2023 10:08:30 -0600 Subject: [PATCH 037/123] Compatability patch before merging 'cmeps0.14.2' for esmFldsExchange_cesm_mod.F90 Since EarthWorksOrg/cmeps has been based on 'cmeps0.13.68' the routine signatures are different to those used in 'cmeps0.14.2'. So, logic added for mpas-ocean and mpas-seaice fields did not automatically update to the new implementations. This commit manually does that update. --- mediator/esmFldsExchange_cesm_mod.F90 | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index cf0f8192a..cfb9030d3 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -1562,13 +1562,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ocn: seaice basal pressure ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compice)%flds, 'Si_bpress') - call addfld(fldListTo(compocn)%flds, 'Si_bpress') + call addfld_from(compice, 'Si_bpress') + call addfld_to(compocn, 'Si_bpress') else if ( fldchk(is_local%wrap%FBImp(compice, compice), 'Si_bpress', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compocn) , 'Si_bpress', rc=rc)) then - call addmap(fldListFr(compice)%flds, 'Si_bpress', compocn, mapfcopy, 'unset', 'unset') - call addmrg(fldListTo(compocn)%flds, 'Si_bpress', mrg_from=compice, mrg_fld='Si_bpress', mrg_type='copy') + call addmap_from(compice, 'Si_bpress', compocn, mapfcopy, 'unset', 'unset') + call addmrg_to(compocn, 'Si_bpress', mrg_from=compice, mrg_fld='Si_bpress', mrg_type='copy') end if end if @@ -2755,13 +2755,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ice: frazil from ocn ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compocn)%flds, 'Fioo_frazil') - call addfld(fldListTo(compice)%flds, 'Fioo_frazil') + call addfld_from(compocn, 'Fioo_frazil') + call addfld_to(compice, 'Fioo_frazil') else if ( fldchk(is_local%wrap%FBImp(compocn, compocn), 'Fioo_frazil', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compice) , 'Fioo_frazil', rc=rc)) then - call addmap(fldListFr(compocn)%flds, 'Fioo_frazil', compice, mapfcopy, 'unset', 'unset') - call addmrg(fldListTo(compice)%flds, 'Fioo_frazil', mrg_from=compocn, mrg_fld='Fioo_frazil', mrg_type='copy') + call addmap_from(compocn, 'Fioo_frazil', compice, mapfcopy, 'unset', 'unset') + call addmrg_to(compice, 'Fioo_frazil', mrg_from=compocn, mrg_fld='Fioo_frazil', mrg_type='copy') end if end if !----------------------------- From c0570015c2f0465cc0b79e7fc731315087bf0494 Mon Sep 17 00:00:00 2001 From: "G. Dylan Dickerson" Date: Mon, 12 May 2025 20:00:26 -0600 Subject: [PATCH 038/123] Configure ATM_NCPL based on mpasa grids used As the resolution of simulation increases, it makes sense to also increase the coupling intervals to maintain stability and realism. --- cime_config/config_component_cesm.xml | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/cime_config/config_component_cesm.xml b/cime_config/config_component_cesm.xml index a71731097..0ea8ab63a 100644 --- a/cime_config/config_component_cesm.xml +++ b/cime_config/config_component_cesm.xml @@ -240,6 +240,14 @@ 24 48 + 48 + 48 + 48 + 96 + 192 + 360 + 720 + 1440 run_coupling env_run.xml From d7cf7d69de141120c29ea32aae9273d2923e206b Mon Sep 17 00:00:00 2001 From: "G. Dylan Dickerson" Date: Fri, 17 May 2024 11:39:47 -0600 Subject: [PATCH 039/123] Duplicate mpasa grid NCPL entries for _MPAS compsets If the compset name contains "_MPAS" then NCPL_BASE_PERIOD changes to hour instead of day. The new values are equivalent to the day-based values. Also add an entry for ROF, so that it is set to ATM_NCPL if the compset includes "_MPAS" in the name. --- cime_config/config_component_cesm.xml | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/cime_config/config_component_cesm.xml b/cime_config/config_component_cesm.xml index 0ea8ab63a..ec0589149 100644 --- a/cime_config/config_component_cesm.xml +++ b/cime_config/config_component_cesm.xml @@ -248,6 +248,14 @@ 360 720 1440 + 2 + 2 + 2 + 4 + 8 + 15 + 30 + 60 run_coupling env_run.xml @@ -352,6 +360,7 @@ $ATM_NCPL 1 $ATM_NCPL + $ATM_NCPL run_coupling env_run.xml From be66c78bfd5702f99abff8809f3a5f1cb5947277 Mon Sep 17 00:00:00 2001 From: Donald Dazlich Date: Mon, 7 Oct 2024 13:01:22 -0600 Subject: [PATCH 040/123] MPAS-Ocean update Necessary coupling fields associated with the new version of MPAS-Ocean have been added. These fields are associated with Stokes drift and may not actually be used. --- mediator/esmFldsExchange_cesm_mod.F90 | 233 ++++++++++++++++++++++++++ mediator/fd_cesm.yaml | 64 +++++++ 2 files changed, 297 insertions(+) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 54952af9f..0a23c78ac 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -1487,6 +1487,16 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmrg_to(compatm, 'Si_vice', mrg_from=compice, mrg_fld='Si_vice', mrg_type='copy') end if end if + if (phase == 'advertise') then + call addfld_from(compice, 'Si_ithick') + call addfld_to(compatm, 'Si_ithick') + else + if ( fldchk(is_local%wrap%FBexp(compatm) , 'Si_ithick', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice), 'Si_ithick', rc=rc)) then + call addmap_from(compice, 'Si_ithick', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg_to(compatm, 'Si_ithick', mrg_from=compice, mrg_fld='Si_ithick', mrg_type='copy') + end if + end if if (phase == 'advertise') then call addfld_from(compice, 'Si_vsno') call addfld_to(compatm, 'Si_vsno') @@ -2492,6 +2502,229 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if !----------------------------- + ! to ocn: + !----------------------------- + if (phase == 'advertise') then + call addfld_from(compwav, 'Sw_Hs') + call addfld_to(compocn, 'Sw_Hs') + else + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_Hs', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_Hs', rc=rc)) then + call addmap_from(compwav, 'Sw_Hs', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmrg_to(compocn, 'Sw_Hs', mrg_from=compwav, mrg_fld='Sw_hs', mrg_type='copy') + end if + end if + !----------------------------- + ! to ocn: + !----------------------------- + if (phase == 'advertise') then + call addfld_from(compwav, 'Sw_Fp') + call addfld_to(compocn, 'Sw_Fp') + else + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_Fp', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_Fp', rc=rc)) then + call addmap_from(compwav, 'Sw_Fp', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmrg_to(compocn, 'Sw_Fp', mrg_from=compwav, mrg_fld='Sw_Fp', mrg_type='copy') + end if + end if + !----------------------------- + ! to ocn: + !----------------------------- + if (phase == 'advertise') then + call addfld_from(compwav, 'Sw_ustokes_wavenumber_1') + call addfld_to(compocn, 'Sw_ustokes_wavenumber_1') + else + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_ustokes_wavenumber_1', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_ustokes_wavenumber_1', rc=rc)) then + call addmap_from(compwav, 'Sw_ustokes_wavenumber_1', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmrg_to(compocn, 'Sw_ustokes_wavenumber_1', mrg_from=compwav, mrg_fld='Sw_ustokes_wavenumber_1', mrg_type='copy') + end if + end if + !----------------------------- + ! to ocn: + !----------------------------- + if (phase == 'advertise') then + call addfld_from(compwav, 'Sw_vstokes_wavenumber_1') + call addfld_to(compocn, 'Sw_vstokes_wavenumber_1') + else + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_vstokes_wavenumber_1', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_vstokes_wavenumber_1', rc=rc)) then + call addmap_from(compwav, 'Sw_vstokes_wavenumber_1', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmrg_to(compocn, 'Sw_vstokes_wavenumber_1', mrg_from=compwav, mrg_fld='Sw_lamult', mrg_type='copy') + end if + end if + !----------------------------- + ! to ocn: + !----------------------------- + if (phase == 'advertise') then + call addfld_from(compwav, 'Sw_ustokes_wavenumber_2') + call addfld_to(compocn, 'Sw_ustokes_wavenumber_2') + else + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_ustokes_wavenumber_2', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_ustokes_wavenumber_2', rc=rc)) then + call addmap_from(compwav, 'Sw_ustokes_wavenumber_2', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmrg_to(compocn, 'Sw_ustokes_wavenumber_2', mrg_from=compwav, mrg_fld='Sw_ustokes_wavenumber_2', mrg_type='copy') + end if + end if + !----------------------------- + ! to ocn: + !----------------------------- + if (phase == 'advertise') then + call addfld_from(compwav, 'Sw_vstokes_wavenumber_2') + call addfld_to(compocn, 'Sw_vstokes_wavenumber_2') + else + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_vstokes_wavenumber_2', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_vstokes_wavenumber_2', rc=rc)) then + call addmap_from(compwav, 'Sw_vstokes_wavenumber_2', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmrg_to(compocn, 'Sw_vstokes_wavenumber_2', mrg_from=compwav, mrg_fld='Sw_lamult', mrg_type='copy') + end if + end if + !----------------------------- + ! to ocn: + !----------------------------- + if (phase == 'advertise') then + call addfld_from(compwav, 'Sw_ustokes_wavenumber_3') + call addfld_to(compocn, 'Sw_ustokes_wavenumber_3') + else + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_ustokes_wavenumber_3', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_ustokes_wavenumber_3', rc=rc)) then + call addmap_from(compwav, 'Sw_ustokes_wavenumber_3', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmrg_to(compocn, 'Sw_ustokes_wavenumber_3', mrg_from=compwav, mrg_fld='Sw_ustokes_wavenumber_3', mrg_type='copy') + end if + end if + !----------------------------- + ! to ocn: + !----------------------------- + if (phase == 'advertise') then + call addfld_from(compwav, 'Sw_vstokes_wavenumber_3') + call addfld_to(compocn, 'Sw_vstokes_wavenumber_3') + else + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_vstokes_wavenumber_3', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_vstokes_wavenumber_3', rc=rc)) then + call addmap_from(compwav, 'Sw_vstokes_wavenumber_3', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmrg_to(compocn, 'Sw_vstokes_wavenumber_3', mrg_from=compwav, mrg_fld='Sw_lamult', mrg_type='copy') + end if + end if + !----------------------------- + ! to ocn: + !----------------------------- + if (phase == 'advertise') then + call addfld_from(compwav, 'Sw_ustokes_wavenumber_4') + call addfld_to(compocn, 'Sw_ustokes_wavenumber_4') + else + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_ustokes_wavenumber_4', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_ustokes_wavenumber_4', rc=rc)) then + call addmap_from(compwav, 'Sw_ustokes_wavenumber_4', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmrg_to(compocn, 'Sw_ustokes_wavenumber_4', mrg_from=compwav, mrg_fld='Sw_ustokes_wavenumber_4', mrg_type='copy') + end if + end if + !----------------------------- + ! to ocn: + !----------------------------- + if (phase == 'advertise') then + call addfld_from(compwav, 'Sw_vstokes_wavenumber_4') + call addfld_to(compocn, 'Sw_vstokes_wavenumber_4') + else + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_vstokes_wavenumber_4', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_vstokes_wavenumber_4', rc=rc)) then + call addmap_from(compwav, 'Sw_vstokes_wavenumber_4', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmrg_to(compocn, 'Sw_vstokes_wavenumber_4', mrg_from=compwav, mrg_fld='Sw_lamult', mrg_type='copy') + end if + end if + !----------------------------- + ! to ocn: + !----------------------------- + if (phase == 'advertise') then + call addfld_from(compwav, 'Sw_ustokes_wavenumber_5') + call addfld_to(compocn, 'Sw_ustokes_wavenumber_5') + else + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_ustokes_wavenumber_5', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_ustokes_wavenumber_5', rc=rc)) then + call addmap_from(compwav, 'Sw_ustokes_wavenumber_5', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmrg_to(compocn, 'Sw_ustokes_wavenumber_5', mrg_from=compwav, mrg_fld='Sw_ustokes_wavenumber_5', mrg_type='copy') + end if + end if + !----------------------------- + ! to ocn: + !----------------------------- + if (phase == 'advertise') then + call addfld_from(compwav, 'Sw_vstokes_wavenumber_5') + call addfld_to(compocn, 'Sw_vstokes_wavenumber_5') + else + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_vstokes_wavenumber_5', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_vstokes_wavenumber_5', rc=rc)) then + call addmap_from(compwav, 'Sw_vstokes_wavenumber_5', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmrg_to(compocn, 'Sw_vstokes_wavenumber_5', mrg_from=compwav, mrg_fld='Sw_lamult', mrg_type='copy') + end if + end if + !----------------------------- + ! to ocn: + !----------------------------- + if (phase == 'advertise') then + call addfld_from(compwav, 'Sw_ustokes_wavenumber_6') + call addfld_to(compocn, 'Sw_ustokes_wavenumber_6') + else + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_ustokes_wavenumber_6', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_ustokes_wavenumber_6', rc=rc)) then + call addmap_from(compwav, 'Sw_ustokes_wavenumber_6', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmrg_to(compocn, 'Sw_ustokes_wavenumber_6', mrg_from=compwav, mrg_fld='Sw_ustokes_wavenumber_6', mrg_type='copy') + end if + end if + !----------------------------- + ! to ocn: + !----------------------------- + if (phase == 'advertise') then + call addfld_from(compwav, 'Sw_vstokes_wavenumber_6') + call addfld_to(compocn, 'Sw_vstokes_wavenumber_6') + else + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_vstokes_wavenumber_6', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_vstokes_wavenumber_6', rc=rc)) then + call addmap_from(compwav, 'Sw_vstokes_wavenumber_6', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmrg_to(compocn, 'Sw_vstokes_wavenumber_6', mrg_from=compwav, mrg_fld='Sw_lamult', mrg_type='copy') + end if + end if + !----------------------------- + ! to ocn: + !----------------------------- + if (phase == 'advertise') then + call addfld_from(compwav, 'Sw_ustokes_wavenumber_6') + call addfld_to(compocn, 'Sw_ustokes_wavenumber_6') + else + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_ustokes_wavenumber_6', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_ustokes_wavenumber_6', rc=rc)) then + call addmap_from(compwav, 'Sw_ustokes_wavenumber_6', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmrg_to(compocn, 'Sw_ustokes_wavenumber_6', mrg_from=compwav, mrg_fld='Sw_ustokes_wavenumber_6', mrg_type='copy') + end if + end if + !----------------------------- + ! to ocn: + !----------------------------- + if (phase == 'advertise') then + call addfld_from(compwav, 'Sw_vstokes_wavenumber_6') + call addfld_to(compocn, 'Sw_vstokes_wavenumber_6') + else + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_vstokes_wavenumber_6', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_vstokes_wavenumber_6', rc=rc)) then + call addmap_from(compwav, 'Sw_vstokes_wavenumber_6', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmrg_to(compocn, 'Sw_vstokes_wavenumber_6', mrg_from=compwav, mrg_fld='Sw_lamult', mrg_type='copy') + end if + end if + + + !----------------------------- + ! to ocn: + !----------------------------- + if (phase == 'advertise') then + call addfld_from(compwav, 'Sw_Dp') + call addfld_to(compocn, 'Sw_Dp') + else + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_Dp', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_Dp', rc=rc)) then + call addmap_from(compwav, 'Sw_Dp', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmrg_to(compocn, 'Sw_Dp', mrg_from=compwav, mrg_fld='Sw_Dp', mrg_type='copy') + end if + end if + !----------------------------- ! to ocn: Stokes drift u component from wave !----------------------------- if (phase == 'advertise') then diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index 825d0fa2e..d9248bf93 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -833,6 +833,10 @@ canonical_units: m description: ice import to med - surface_snow_water_equivalent # + - standard_name: Si_ithick + canonical_units: m + description: sea-ice export - ice thickness + # - standard_name: Si_vsno alias: mean_snow_volume canonical_units: m @@ -1236,6 +1240,66 @@ canonical_units: 1 description: ocean import - Langmuir multiplier # + - standard_name: Sw_Hs + canonical_units: m + description: ocean import - Significant wave height + # + - standard_name: Sw_Fp + canonical_units: 1 + description: ocean import - Peak wave frequency + # + - standard_name: Sw_Dp + canonical_units: 1 + description: ocean import - Peak wave direction + # + - standard_name: Sw_ustokes_wavenumber_1 + canonical_units: m/s + description: ocean import - partitioned Stokes drift zonal wavenumber 1 + # + - standard_name: Sw_vstokes_wavenumber_1 + canonical_units: m/s + description: ocean import - partitioned Stokes drift meridional wavenumber 1 + # + - standard_name: Sw_ustokes_wavenumber_2 + canonical_units: m/s + description: ocean import - partitioned Stokes drift zonal wavenumber 2 + # + - standard_name: Sw_vstokes_wavenumber_2 + canonical_units: m/s + description: ocean import - partitioned Stokes drift meridional wavenumber 2 + # + - standard_name: Sw_ustokes_wavenumber_3 + canonical_units: m/s + description: ocean import - partitioned Stokes drift zonal wavenumber 3 + # + - standard_name: Sw_vstokes_wavenumber_3 + canonical_units: m/s + description: ocean import - partitioned Stokes drift meridional wavenumber 3 + # + - standard_name: Sw_ustokes_wavenumber_4 + canonical_units: m/s + description: ocean import - partitioned Stokes drift zonal wavenumber 4 + # + - standard_name: Sw_vstokes_wavenumber_4 + canonical_units: m/s + description: ocean import - partitioned Stokes drift meridional wavenumber 4 + # + - standard_name: Sw_ustokes_wavenumber_5 + canonical_units: m/s + description: ocean import - partitioned Stokes drift zonal wavenumber 5 + # + - standard_name: Sw_vstokes_wavenumber_5 + canonical_units: m/s + description: ocean import - partitioned Stokes drift meridional wavenumber 5 + # + - standard_name: Sw_ustokes_wavenumber_6 + canonical_units: m/s + description: ocean import - partitioned Stokes drift zonal wavenumber 6 + # + - standard_name: Sw_vstokes_wavenumber_6 + canonical_units: m/s + description: ocean import - partitioned Stokes drift meridional wavenumber 6 + # - standard_name: Sw_ustokes canonical_units: m/s description: ocean import - Stokes drift u component From decbf4e4eb1cc77275ad1789563b40ac6ccdd725 Mon Sep 17 00:00:00 2001 From: Donald Dazlich Date: Wed, 9 Oct 2024 14:41:06 -0600 Subject: [PATCH 041/123] Typo fix --- mediator/esmFldsExchange_cesm_mod.F90 | 34 +++++++++++++-------------- 1 file changed, 17 insertions(+), 17 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 0a23c78ac..d5444eae9 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -2510,7 +2510,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_Hs', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_Hs', rc=rc)) then - call addmap_from(compwav, 'Sw_Hs', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmap_from(compwav, 'Sw_Hs', compocn, mapbilnr_nstod, 'one', wav2ocn_map) call addmrg_to(compocn, 'Sw_Hs', mrg_from=compwav, mrg_fld='Sw_hs', mrg_type='copy') end if end if @@ -2523,7 +2523,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_Fp', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_Fp', rc=rc)) then - call addmap_from(compwav, 'Sw_Fp', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmap_from(compwav, 'Sw_Fp', compocn, mapbilnr_nstod, 'one', wav2ocn_map) call addmrg_to(compocn, 'Sw_Fp', mrg_from=compwav, mrg_fld='Sw_Fp', mrg_type='copy') end if end if @@ -2536,7 +2536,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_ustokes_wavenumber_1', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_ustokes_wavenumber_1', rc=rc)) then - call addmap_from(compwav, 'Sw_ustokes_wavenumber_1', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmap_from(compwav, 'Sw_ustokes_wavenumber_1', compocn, mapbilnr_nstod, 'one', wav2ocn_map) call addmrg_to(compocn, 'Sw_ustokes_wavenumber_1', mrg_from=compwav, mrg_fld='Sw_ustokes_wavenumber_1', mrg_type='copy') end if end if @@ -2549,7 +2549,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_vstokes_wavenumber_1', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_vstokes_wavenumber_1', rc=rc)) then - call addmap_from(compwav, 'Sw_vstokes_wavenumber_1', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmap_from(compwav, 'Sw_vstokes_wavenumber_1', compocn, mapbilnr_nstod, 'one', wav2ocn_map) call addmrg_to(compocn, 'Sw_vstokes_wavenumber_1', mrg_from=compwav, mrg_fld='Sw_lamult', mrg_type='copy') end if end if @@ -2562,7 +2562,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_ustokes_wavenumber_2', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_ustokes_wavenumber_2', rc=rc)) then - call addmap_from(compwav, 'Sw_ustokes_wavenumber_2', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmap_from(compwav, 'Sw_ustokes_wavenumber_2', compocn, mapbilnr_nstod, 'one', wav2ocn_map) call addmrg_to(compocn, 'Sw_ustokes_wavenumber_2', mrg_from=compwav, mrg_fld='Sw_ustokes_wavenumber_2', mrg_type='copy') end if end if @@ -2575,7 +2575,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_vstokes_wavenumber_2', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_vstokes_wavenumber_2', rc=rc)) then - call addmap_from(compwav, 'Sw_vstokes_wavenumber_2', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmap_from(compwav, 'Sw_vstokes_wavenumber_2', compocn, mapbilnr_nstod, 'one', wav2ocn_map) call addmrg_to(compocn, 'Sw_vstokes_wavenumber_2', mrg_from=compwav, mrg_fld='Sw_lamult', mrg_type='copy') end if end if @@ -2588,7 +2588,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_ustokes_wavenumber_3', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_ustokes_wavenumber_3', rc=rc)) then - call addmap_from(compwav, 'Sw_ustokes_wavenumber_3', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmap_from(compwav, 'Sw_ustokes_wavenumber_3', compocn, mapbilnr_nstod, 'one', wav2ocn_map) call addmrg_to(compocn, 'Sw_ustokes_wavenumber_3', mrg_from=compwav, mrg_fld='Sw_ustokes_wavenumber_3', mrg_type='copy') end if end if @@ -2601,7 +2601,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_vstokes_wavenumber_3', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_vstokes_wavenumber_3', rc=rc)) then - call addmap_from(compwav, 'Sw_vstokes_wavenumber_3', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmap_from(compwav, 'Sw_vstokes_wavenumber_3', compocn, mapbilnr_nstod, 'one', wav2ocn_map) call addmrg_to(compocn, 'Sw_vstokes_wavenumber_3', mrg_from=compwav, mrg_fld='Sw_lamult', mrg_type='copy') end if end if @@ -2614,7 +2614,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_ustokes_wavenumber_4', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_ustokes_wavenumber_4', rc=rc)) then - call addmap_from(compwav, 'Sw_ustokes_wavenumber_4', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmap_from(compwav, 'Sw_ustokes_wavenumber_4', compocn, mapbilnr_nstod, 'one', wav2ocn_map) call addmrg_to(compocn, 'Sw_ustokes_wavenumber_4', mrg_from=compwav, mrg_fld='Sw_ustokes_wavenumber_4', mrg_type='copy') end if end if @@ -2627,7 +2627,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_vstokes_wavenumber_4', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_vstokes_wavenumber_4', rc=rc)) then - call addmap_from(compwav, 'Sw_vstokes_wavenumber_4', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmap_from(compwav, 'Sw_vstokes_wavenumber_4', compocn, mapbilnr_nstod, 'one', wav2ocn_map) call addmrg_to(compocn, 'Sw_vstokes_wavenumber_4', mrg_from=compwav, mrg_fld='Sw_lamult', mrg_type='copy') end if end if @@ -2640,7 +2640,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_ustokes_wavenumber_5', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_ustokes_wavenumber_5', rc=rc)) then - call addmap_from(compwav, 'Sw_ustokes_wavenumber_5', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmap_from(compwav, 'Sw_ustokes_wavenumber_5', compocn, mapbilnr_nstod, 'one', wav2ocn_map) call addmrg_to(compocn, 'Sw_ustokes_wavenumber_5', mrg_from=compwav, mrg_fld='Sw_ustokes_wavenumber_5', mrg_type='copy') end if end if @@ -2653,7 +2653,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_vstokes_wavenumber_5', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_vstokes_wavenumber_5', rc=rc)) then - call addmap_from(compwav, 'Sw_vstokes_wavenumber_5', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmap_from(compwav, 'Sw_vstokes_wavenumber_5', compocn, mapbilnr_nstod, 'one', wav2ocn_map) call addmrg_to(compocn, 'Sw_vstokes_wavenumber_5', mrg_from=compwav, mrg_fld='Sw_lamult', mrg_type='copy') end if end if @@ -2666,7 +2666,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_ustokes_wavenumber_6', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_ustokes_wavenumber_6', rc=rc)) then - call addmap_from(compwav, 'Sw_ustokes_wavenumber_6', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmap_from(compwav, 'Sw_ustokes_wavenumber_6', compocn, mapbilnr_nstod, 'one', wav2ocn_map) call addmrg_to(compocn, 'Sw_ustokes_wavenumber_6', mrg_from=compwav, mrg_fld='Sw_ustokes_wavenumber_6', mrg_type='copy') end if end if @@ -2679,7 +2679,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_vstokes_wavenumber_6', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_vstokes_wavenumber_6', rc=rc)) then - call addmap_from(compwav, 'Sw_vstokes_wavenumber_6', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmap_from(compwav, 'Sw_vstokes_wavenumber_6', compocn, mapbilnr_nstod, 'one', wav2ocn_map) call addmrg_to(compocn, 'Sw_vstokes_wavenumber_6', mrg_from=compwav, mrg_fld='Sw_lamult', mrg_type='copy') end if end if @@ -2692,7 +2692,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_ustokes_wavenumber_6', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_ustokes_wavenumber_6', rc=rc)) then - call addmap_from(compwav, 'Sw_ustokes_wavenumber_6', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmap_from(compwav, 'Sw_ustokes_wavenumber_6', compocn, mapbilnr_nstod, 'one', wav2ocn_map) call addmrg_to(compocn, 'Sw_ustokes_wavenumber_6', mrg_from=compwav, mrg_fld='Sw_ustokes_wavenumber_6', mrg_type='copy') end if end if @@ -2705,7 +2705,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_vstokes_wavenumber_6', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_vstokes_wavenumber_6', rc=rc)) then - call addmap_from(compwav, 'Sw_vstokes_wavenumber_6', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmap_from(compwav, 'Sw_vstokes_wavenumber_6', compocn, mapbilnr_nstod, 'one', wav2ocn_map) call addmrg_to(compocn, 'Sw_vstokes_wavenumber_6', mrg_from=compwav, mrg_fld='Sw_lamult', mrg_type='copy') end if end if @@ -2720,7 +2720,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_Dp', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_Dp', rc=rc)) then - call addmap_from(compwav, 'Sw_Dp', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmap_from(compwav, 'Sw_Dp', compocn, mapbilnr_nstod, 'one', wav2ocn_map) call addmrg_to(compocn, 'Sw_Dp', mrg_from=compwav, mrg_fld='Sw_Dp', mrg_type='copy') end if end if From 0524c14fe4c3cbf25f844c82e0bdefd1e03c7a7a Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 14 May 2025 08:27:45 -0600 Subject: [PATCH 042/123] test push of minor revision change --- .github/workflows/bumpversion.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/bumpversion.yml b/.github/workflows/bumpversion.yml index b17d491f0..408869e28 100644 --- a/.github/workflows/bumpversion.yml +++ b/.github/workflows/bumpversion.yml @@ -14,6 +14,6 @@ jobs: with: github_token: ${{ secrets.GITHUB_TOKEN }} create_annotated_tag: true - default_bump: patch - dry_run: false + default_bump: minor + dry_run: true tag_prefix: cmeps From f1c0df1b276b11d69eb2649e091a9c07c1d9c778 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 14 May 2025 08:30:55 -0600 Subject: [PATCH 043/123] trigger minor version change due to shr_megan_mod api change in cmeps1.0.48 #minor --- .github/workflows/bumpversion.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/bumpversion.yml b/.github/workflows/bumpversion.yml index 408869e28..fcc648126 100644 --- a/.github/workflows/bumpversion.yml +++ b/.github/workflows/bumpversion.yml @@ -15,5 +15,5 @@ jobs: github_token: ${{ secrets.GITHUB_TOKEN }} create_annotated_tag: true default_bump: minor - dry_run: true + dry_run: false tag_prefix: cmeps From 57e5026521b939209236b3a5dd09574ce8af87e8 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 14 May 2025 08:37:38 -0600 Subject: [PATCH 044/123] revert change in bumpversion --- .github/workflows/bumpversion.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/bumpversion.yml b/.github/workflows/bumpversion.yml index fcc648126..2289f5add 100644 --- a/.github/workflows/bumpversion.yml +++ b/.github/workflows/bumpversion.yml @@ -10,10 +10,10 @@ jobs: - uses: actions/checkout@v2 - name: Bump version and push tag id: tag_version - uses: mathieudutour/github-tag-action@v5.5 + uses: mathieudutour/github-tag-action@v6.2 with: github_token: ${{ secrets.GITHUB_TOKEN }} create_annotated_tag: true - default_bump: minor + default_bump: patch dry_run: false tag_prefix: cmeps From 5209116642af42ea4e6d85190d994556fda89ced Mon Sep 17 00:00:00 2001 From: "G. Dylan Dickerson" Date: Tue, 17 Jun 2025 18:06:59 -0600 Subject: [PATCH 045/123] Review request, guard field exchanges added by MPAS-O and MPAS-SI This change tries to ensure that adding MPAS-O and MPAS-SI won't affect CESM results. --- mediator/esmFldsExchange_cesm_mod.F90 | 401 ++++++++++++++------------ 1 file changed, 221 insertions(+), 180 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 7e70fd518..8e6152508 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -119,6 +119,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) 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_rof2ocn_ice, map_rof2ocn_liq + use med_internalstate_mod, only : ocn_name, ice_name 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 @@ -1510,15 +1511,17 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmrg_to(compatm, 'Si_vice', mrg_from=compice, mrg_fld='Si_vice', mrg_type='copy') end if end if - if (phase == 'advertise') then - call addfld_from(compice, 'Si_ithick') - call addfld_to(compatm, 'Si_ithick') - else - if ( fldchk(is_local%wrap%FBexp(compatm) , 'Si_ithick', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compice,compice), 'Si_ithick', rc=rc)) then - call addmap_from(compice, 'Si_ithick', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrg_to(compatm, 'Si_ithick', mrg_from=compice, mrg_fld='Si_ithick', mrg_type='copy') - end if + if (ice_name == 'mpassi') then + if (phase == 'advertise') then + call addfld_from(compice, 'Si_ithick') + call addfld_to(compatm, 'Si_ithick') + else + if ( fldchk(is_local%wrap%FBexp(compatm) , 'Si_ithick', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice), 'Si_ithick', rc=rc)) then + call addmap_from(compice, 'Si_ithick', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg_to(compatm, 'Si_ithick', mrg_from=compice, mrg_fld='Si_ithick', mrg_type='copy') + end if + end if end if if (phase == 'advertise') then call addfld_from(compice, 'Si_vsno') @@ -1798,15 +1801,17 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! --------------------------------------------------------------------- ! to ocn: seaice basal pressure ! --------------------------------------------------------------------- - if (phase == 'advertise') then - call addfld_from(compice, 'Si_bpress') - call addfld_to(compocn, 'Si_bpress') - else - if ( fldchk(is_local%wrap%FBImp(compice, compice), 'Si_bpress', rc=rc) .and. & - fldchk(is_local%wrap%FBExp(compocn) , 'Si_bpress', rc=rc)) then - call addmap_from(compice, 'Si_bpress', compocn, mapfcopy, 'unset', 'unset') - call addmrg_to(compocn, 'Si_bpress', mrg_from=compice, mrg_fld='Si_bpress', mrg_type='copy') - end if + if (ice_name == 'mpassi' .or. ocn_name == 'mpaso') then + if (phase == 'advertise') then + call addfld_from(compice, 'Si_bpress') + call addfld_to(compocn, 'Si_bpress') + else + if ( fldchk(is_local%wrap%FBImp(compice, compice), 'Si_bpress', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compocn) , 'Si_bpress', rc=rc)) then + call addmap_from(compice, 'Si_bpress', compocn, mapfcopy, 'unset', 'unset') + call addmrg_to(compocn, 'Si_bpress', mrg_from=compice, mrg_fld='Si_bpress', mrg_type='copy') + end if + end if end if ! --------------------------------------------------------------------- @@ -2545,225 +2550,259 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) !----------------------------- ! to ocn: !----------------------------- - if (phase == 'advertise') then - call addfld_from(compwav, 'Sw_Hs') - call addfld_to(compocn, 'Sw_Hs') - else - if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_Hs', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_Hs', rc=rc)) then - call addmap_from(compwav, 'Sw_Hs', compocn, mapbilnr_nstod, 'one', wav2ocn_map) - call addmrg_to(compocn, 'Sw_Hs', mrg_from=compwav, mrg_fld='Sw_hs', mrg_type='copy') - end if + if (ocn_name == 'mpaso') then + if (phase == 'advertise') then + call addfld_from(compwav, 'Sw_Hs') + call addfld_to(compocn, 'Sw_Hs') + else + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_Hs', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_Hs', rc=rc)) then + call addmap_from(compwav, 'Sw_Hs', compocn, mapbilnr_nstod, 'one', wav2ocn_map) + call addmrg_to(compocn, 'Sw_Hs', mrg_from=compwav, mrg_fld='Sw_hs', mrg_type='copy') + end if + end if end if !----------------------------- ! to ocn: !----------------------------- - if (phase == 'advertise') then - call addfld_from(compwav, 'Sw_Fp') - call addfld_to(compocn, 'Sw_Fp') - else - if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_Fp', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_Fp', rc=rc)) then - call addmap_from(compwav, 'Sw_Fp', compocn, mapbilnr_nstod, 'one', wav2ocn_map) - call addmrg_to(compocn, 'Sw_Fp', mrg_from=compwav, mrg_fld='Sw_Fp', mrg_type='copy') - end if + if (ocn_name == 'mpaso') then + if (phase == 'advertise') then + call addfld_from(compwav, 'Sw_Fp') + call addfld_to(compocn, 'Sw_Fp') + else + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_Fp', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_Fp', rc=rc)) then + call addmap_from(compwav, 'Sw_Fp', compocn, mapbilnr_nstod, 'one', wav2ocn_map) + call addmrg_to(compocn, 'Sw_Fp', mrg_from=compwav, mrg_fld='Sw_Fp', mrg_type='copy') + end if + end if end if !----------------------------- ! to ocn: !----------------------------- - if (phase == 'advertise') then - call addfld_from(compwav, 'Sw_ustokes_wavenumber_1') - call addfld_to(compocn, 'Sw_ustokes_wavenumber_1') - else - if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_ustokes_wavenumber_1', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_ustokes_wavenumber_1', rc=rc)) then - call addmap_from(compwav, 'Sw_ustokes_wavenumber_1', compocn, mapbilnr_nstod, 'one', wav2ocn_map) - call addmrg_to(compocn, 'Sw_ustokes_wavenumber_1', mrg_from=compwav, mrg_fld='Sw_ustokes_wavenumber_1', mrg_type='copy') - end if + if (ocn_name == 'mpaso') then + if (phase == 'advertise') then + call addfld_from(compwav, 'Sw_ustokes_wavenumber_1') + call addfld_to(compocn, 'Sw_ustokes_wavenumber_1') + else + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_ustokes_wavenumber_1', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_ustokes_wavenumber_1', rc=rc)) then + call addmap_from(compwav, 'Sw_ustokes_wavenumber_1', compocn, mapbilnr_nstod, 'one', wav2ocn_map) + call addmrg_to(compocn, 'Sw_ustokes_wavenumber_1', mrg_from=compwav, mrg_fld='Sw_ustokes_wavenumber_1', mrg_type='copy') + end if + end if end if !----------------------------- ! to ocn: !----------------------------- - if (phase == 'advertise') then - call addfld_from(compwav, 'Sw_vstokes_wavenumber_1') - call addfld_to(compocn, 'Sw_vstokes_wavenumber_1') - else - if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_vstokes_wavenumber_1', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_vstokes_wavenumber_1', rc=rc)) then - call addmap_from(compwav, 'Sw_vstokes_wavenumber_1', compocn, mapbilnr_nstod, 'one', wav2ocn_map) - call addmrg_to(compocn, 'Sw_vstokes_wavenumber_1', mrg_from=compwav, mrg_fld='Sw_lamult', mrg_type='copy') - end if + if (ocn_name == 'mpaso') then + if (phase == 'advertise') then + call addfld_from(compwav, 'Sw_vstokes_wavenumber_1') + call addfld_to(compocn, 'Sw_vstokes_wavenumber_1') + else + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_vstokes_wavenumber_1', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_vstokes_wavenumber_1', rc=rc)) then + call addmap_from(compwav, 'Sw_vstokes_wavenumber_1', compocn, mapbilnr_nstod, 'one', wav2ocn_map) + call addmrg_to(compocn, 'Sw_vstokes_wavenumber_1', mrg_from=compwav, mrg_fld='Sw_lamult', mrg_type='copy') + end if + end if end if !----------------------------- ! to ocn: !----------------------------- - if (phase == 'advertise') then - call addfld_from(compwav, 'Sw_ustokes_wavenumber_2') - call addfld_to(compocn, 'Sw_ustokes_wavenumber_2') - else - if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_ustokes_wavenumber_2', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_ustokes_wavenumber_2', rc=rc)) then - call addmap_from(compwav, 'Sw_ustokes_wavenumber_2', compocn, mapbilnr_nstod, 'one', wav2ocn_map) - call addmrg_to(compocn, 'Sw_ustokes_wavenumber_2', mrg_from=compwav, mrg_fld='Sw_ustokes_wavenumber_2', mrg_type='copy') - end if + if (ocn_name == 'mpaso') then + if (phase == 'advertise') then + call addfld_from(compwav, 'Sw_ustokes_wavenumber_2') + call addfld_to(compocn, 'Sw_ustokes_wavenumber_2') + else + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_ustokes_wavenumber_2', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_ustokes_wavenumber_2', rc=rc)) then + call addmap_from(compwav, 'Sw_ustokes_wavenumber_2', compocn, mapbilnr_nstod, 'one', wav2ocn_map) + call addmrg_to(compocn, 'Sw_ustokes_wavenumber_2', mrg_from=compwav, mrg_fld='Sw_ustokes_wavenumber_2', mrg_type='copy') + end if + end if end if !----------------------------- ! to ocn: !----------------------------- - if (phase == 'advertise') then - call addfld_from(compwav, 'Sw_vstokes_wavenumber_2') - call addfld_to(compocn, 'Sw_vstokes_wavenumber_2') - else - if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_vstokes_wavenumber_2', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_vstokes_wavenumber_2', rc=rc)) then - call addmap_from(compwav, 'Sw_vstokes_wavenumber_2', compocn, mapbilnr_nstod, 'one', wav2ocn_map) - call addmrg_to(compocn, 'Sw_vstokes_wavenumber_2', mrg_from=compwav, mrg_fld='Sw_lamult', mrg_type='copy') - end if + if (ocn_name == 'mpaso') then + if (phase == 'advertise') then + call addfld_from(compwav, 'Sw_vstokes_wavenumber_2') + call addfld_to(compocn, 'Sw_vstokes_wavenumber_2') + else + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_vstokes_wavenumber_2', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_vstokes_wavenumber_2', rc=rc)) then + call addmap_from(compwav, 'Sw_vstokes_wavenumber_2', compocn, mapbilnr_nstod, 'one', wav2ocn_map) + call addmrg_to(compocn, 'Sw_vstokes_wavenumber_2', mrg_from=compwav, mrg_fld='Sw_lamult', mrg_type='copy') + end if + end if end if !----------------------------- ! to ocn: !----------------------------- - if (phase == 'advertise') then - call addfld_from(compwav, 'Sw_ustokes_wavenumber_3') - call addfld_to(compocn, 'Sw_ustokes_wavenumber_3') - else - if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_ustokes_wavenumber_3', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_ustokes_wavenumber_3', rc=rc)) then - call addmap_from(compwav, 'Sw_ustokes_wavenumber_3', compocn, mapbilnr_nstod, 'one', wav2ocn_map) - call addmrg_to(compocn, 'Sw_ustokes_wavenumber_3', mrg_from=compwav, mrg_fld='Sw_ustokes_wavenumber_3', mrg_type='copy') - end if + if (ocn_name == 'mpaso') then + if (phase == 'advertise') then + call addfld_from(compwav, 'Sw_ustokes_wavenumber_3') + call addfld_to(compocn, 'Sw_ustokes_wavenumber_3') + else + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_ustokes_wavenumber_3', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_ustokes_wavenumber_3', rc=rc)) then + call addmap_from(compwav, 'Sw_ustokes_wavenumber_3', compocn, mapbilnr_nstod, 'one', wav2ocn_map) + call addmrg_to(compocn, 'Sw_ustokes_wavenumber_3', mrg_from=compwav, mrg_fld='Sw_ustokes_wavenumber_3', mrg_type='copy') + end if + end if end if !----------------------------- ! to ocn: !----------------------------- - if (phase == 'advertise') then - call addfld_from(compwav, 'Sw_vstokes_wavenumber_3') - call addfld_to(compocn, 'Sw_vstokes_wavenumber_3') - else - if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_vstokes_wavenumber_3', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_vstokes_wavenumber_3', rc=rc)) then - call addmap_from(compwav, 'Sw_vstokes_wavenumber_3', compocn, mapbilnr_nstod, 'one', wav2ocn_map) - call addmrg_to(compocn, 'Sw_vstokes_wavenumber_3', mrg_from=compwav, mrg_fld='Sw_lamult', mrg_type='copy') - end if + if (ocn_name == 'mpaso') then + if (phase == 'advertise') then + call addfld_from(compwav, 'Sw_vstokes_wavenumber_3') + call addfld_to(compocn, 'Sw_vstokes_wavenumber_3') + else + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_vstokes_wavenumber_3', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_vstokes_wavenumber_3', rc=rc)) then + call addmap_from(compwav, 'Sw_vstokes_wavenumber_3', compocn, mapbilnr_nstod, 'one', wav2ocn_map) + call addmrg_to(compocn, 'Sw_vstokes_wavenumber_3', mrg_from=compwav, mrg_fld='Sw_lamult', mrg_type='copy') + end if + end if end if !----------------------------- ! to ocn: !----------------------------- - if (phase == 'advertise') then - call addfld_from(compwav, 'Sw_ustokes_wavenumber_4') - call addfld_to(compocn, 'Sw_ustokes_wavenumber_4') - else - if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_ustokes_wavenumber_4', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_ustokes_wavenumber_4', rc=rc)) then - call addmap_from(compwav, 'Sw_ustokes_wavenumber_4', compocn, mapbilnr_nstod, 'one', wav2ocn_map) - call addmrg_to(compocn, 'Sw_ustokes_wavenumber_4', mrg_from=compwav, mrg_fld='Sw_ustokes_wavenumber_4', mrg_type='copy') - end if + if (ocn_name == 'mpaso') then + if (phase == 'advertise') then + call addfld_from(compwav, 'Sw_ustokes_wavenumber_4') + call addfld_to(compocn, 'Sw_ustokes_wavenumber_4') + else + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_ustokes_wavenumber_4', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_ustokes_wavenumber_4', rc=rc)) then + call addmap_from(compwav, 'Sw_ustokes_wavenumber_4', compocn, mapbilnr_nstod, 'one', wav2ocn_map) + call addmrg_to(compocn, 'Sw_ustokes_wavenumber_4', mrg_from=compwav, mrg_fld='Sw_ustokes_wavenumber_4', mrg_type='copy') + end if + end if end if !----------------------------- ! to ocn: !----------------------------- - if (phase == 'advertise') then - call addfld_from(compwav, 'Sw_vstokes_wavenumber_4') - call addfld_to(compocn, 'Sw_vstokes_wavenumber_4') - else - if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_vstokes_wavenumber_4', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_vstokes_wavenumber_4', rc=rc)) then - call addmap_from(compwav, 'Sw_vstokes_wavenumber_4', compocn, mapbilnr_nstod, 'one', wav2ocn_map) - call addmrg_to(compocn, 'Sw_vstokes_wavenumber_4', mrg_from=compwav, mrg_fld='Sw_lamult', mrg_type='copy') - end if + if (ocn_name == 'mpaso') then + if (phase == 'advertise') then + call addfld_from(compwav, 'Sw_vstokes_wavenumber_4') + call addfld_to(compocn, 'Sw_vstokes_wavenumber_4') + else + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_vstokes_wavenumber_4', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_vstokes_wavenumber_4', rc=rc)) then + call addmap_from(compwav, 'Sw_vstokes_wavenumber_4', compocn, mapbilnr_nstod, 'one', wav2ocn_map) + call addmrg_to(compocn, 'Sw_vstokes_wavenumber_4', mrg_from=compwav, mrg_fld='Sw_lamult', mrg_type='copy') + end if + end if end if !----------------------------- ! to ocn: !----------------------------- - if (phase == 'advertise') then - call addfld_from(compwav, 'Sw_ustokes_wavenumber_5') - call addfld_to(compocn, 'Sw_ustokes_wavenumber_5') - else - if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_ustokes_wavenumber_5', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_ustokes_wavenumber_5', rc=rc)) then - call addmap_from(compwav, 'Sw_ustokes_wavenumber_5', compocn, mapbilnr_nstod, 'one', wav2ocn_map) - call addmrg_to(compocn, 'Sw_ustokes_wavenumber_5', mrg_from=compwav, mrg_fld='Sw_ustokes_wavenumber_5', mrg_type='copy') - end if + if (ocn_name == 'mpaso') then + if (phase == 'advertise') then + call addfld_from(compwav, 'Sw_ustokes_wavenumber_5') + call addfld_to(compocn, 'Sw_ustokes_wavenumber_5') + else + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_ustokes_wavenumber_5', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_ustokes_wavenumber_5', rc=rc)) then + call addmap_from(compwav, 'Sw_ustokes_wavenumber_5', compocn, mapbilnr_nstod, 'one', wav2ocn_map) + call addmrg_to(compocn, 'Sw_ustokes_wavenumber_5', mrg_from=compwav, mrg_fld='Sw_ustokes_wavenumber_5', mrg_type='copy') + end if + end if end if !----------------------------- ! to ocn: !----------------------------- - if (phase == 'advertise') then - call addfld_from(compwav, 'Sw_vstokes_wavenumber_5') - call addfld_to(compocn, 'Sw_vstokes_wavenumber_5') - else - if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_vstokes_wavenumber_5', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_vstokes_wavenumber_5', rc=rc)) then - call addmap_from(compwav, 'Sw_vstokes_wavenumber_5', compocn, mapbilnr_nstod, 'one', wav2ocn_map) - call addmrg_to(compocn, 'Sw_vstokes_wavenumber_5', mrg_from=compwav, mrg_fld='Sw_lamult', mrg_type='copy') - end if + if (ocn_name == 'mpaso') then + if (phase == 'advertise') then + call addfld_from(compwav, 'Sw_vstokes_wavenumber_5') + call addfld_to(compocn, 'Sw_vstokes_wavenumber_5') + else + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_vstokes_wavenumber_5', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_vstokes_wavenumber_5', rc=rc)) then + call addmap_from(compwav, 'Sw_vstokes_wavenumber_5', compocn, mapbilnr_nstod, 'one', wav2ocn_map) + call addmrg_to(compocn, 'Sw_vstokes_wavenumber_5', mrg_from=compwav, mrg_fld='Sw_lamult', mrg_type='copy') + end if + end if end if !----------------------------- ! to ocn: !----------------------------- - if (phase == 'advertise') then - call addfld_from(compwav, 'Sw_ustokes_wavenumber_6') - call addfld_to(compocn, 'Sw_ustokes_wavenumber_6') - else - if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_ustokes_wavenumber_6', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_ustokes_wavenumber_6', rc=rc)) then - call addmap_from(compwav, 'Sw_ustokes_wavenumber_6', compocn, mapbilnr_nstod, 'one', wav2ocn_map) - call addmrg_to(compocn, 'Sw_ustokes_wavenumber_6', mrg_from=compwav, mrg_fld='Sw_ustokes_wavenumber_6', mrg_type='copy') - end if + if (ocn_name == 'mpaso') then + if (phase == 'advertise') then + call addfld_from(compwav, 'Sw_ustokes_wavenumber_6') + call addfld_to(compocn, 'Sw_ustokes_wavenumber_6') + else + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_ustokes_wavenumber_6', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_ustokes_wavenumber_6', rc=rc)) then + call addmap_from(compwav, 'Sw_ustokes_wavenumber_6', compocn, mapbilnr_nstod, 'one', wav2ocn_map) + call addmrg_to(compocn, 'Sw_ustokes_wavenumber_6', mrg_from=compwav, mrg_fld='Sw_ustokes_wavenumber_6', mrg_type='copy') + end if + end if end if !----------------------------- ! to ocn: !----------------------------- - if (phase == 'advertise') then - call addfld_from(compwav, 'Sw_vstokes_wavenumber_6') - call addfld_to(compocn, 'Sw_vstokes_wavenumber_6') - else - if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_vstokes_wavenumber_6', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_vstokes_wavenumber_6', rc=rc)) then - call addmap_from(compwav, 'Sw_vstokes_wavenumber_6', compocn, mapbilnr_nstod, 'one', wav2ocn_map) - call addmrg_to(compocn, 'Sw_vstokes_wavenumber_6', mrg_from=compwav, mrg_fld='Sw_lamult', mrg_type='copy') - end if + if (ocn_name == 'mpaso') then + if (phase == 'advertise') then + call addfld_from(compwav, 'Sw_vstokes_wavenumber_6') + call addfld_to(compocn, 'Sw_vstokes_wavenumber_6') + else + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_vstokes_wavenumber_6', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_vstokes_wavenumber_6', rc=rc)) then + call addmap_from(compwav, 'Sw_vstokes_wavenumber_6', compocn, mapbilnr_nstod, 'one', wav2ocn_map) + call addmrg_to(compocn, 'Sw_vstokes_wavenumber_6', mrg_from=compwav, mrg_fld='Sw_lamult', mrg_type='copy') + end if + end if end if !----------------------------- ! to ocn: !----------------------------- - if (phase == 'advertise') then - call addfld_from(compwav, 'Sw_ustokes_wavenumber_6') - call addfld_to(compocn, 'Sw_ustokes_wavenumber_6') - else - if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_ustokes_wavenumber_6', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_ustokes_wavenumber_6', rc=rc)) then - call addmap_from(compwav, 'Sw_ustokes_wavenumber_6', compocn, mapbilnr_nstod, 'one', wav2ocn_map) - call addmrg_to(compocn, 'Sw_ustokes_wavenumber_6', mrg_from=compwav, mrg_fld='Sw_ustokes_wavenumber_6', mrg_type='copy') - end if + if (ocn_name == 'mpaso') then + if (phase == 'advertise') then + call addfld_from(compwav, 'Sw_ustokes_wavenumber_6') + call addfld_to(compocn, 'Sw_ustokes_wavenumber_6') + else + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_ustokes_wavenumber_6', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_ustokes_wavenumber_6', rc=rc)) then + call addmap_from(compwav, 'Sw_ustokes_wavenumber_6', compocn, mapbilnr_nstod, 'one', wav2ocn_map) + call addmrg_to(compocn, 'Sw_ustokes_wavenumber_6', mrg_from=compwav, mrg_fld='Sw_ustokes_wavenumber_6', mrg_type='copy') + end if + end if end if !----------------------------- ! to ocn: !----------------------------- - if (phase == 'advertise') then - call addfld_from(compwav, 'Sw_vstokes_wavenumber_6') - call addfld_to(compocn, 'Sw_vstokes_wavenumber_6') - else - if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_vstokes_wavenumber_6', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_vstokes_wavenumber_6', rc=rc)) then - call addmap_from(compwav, 'Sw_vstokes_wavenumber_6', compocn, mapbilnr_nstod, 'one', wav2ocn_map) - call addmrg_to(compocn, 'Sw_vstokes_wavenumber_6', mrg_from=compwav, mrg_fld='Sw_lamult', mrg_type='copy') - end if + if (ocn_name == 'mpaso') then + if (phase == 'advertise') then + call addfld_from(compwav, 'Sw_vstokes_wavenumber_6') + call addfld_to(compocn, 'Sw_vstokes_wavenumber_6') + else + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_vstokes_wavenumber_6', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_vstokes_wavenumber_6', rc=rc)) then + call addmap_from(compwav, 'Sw_vstokes_wavenumber_6', compocn, mapbilnr_nstod, 'one', wav2ocn_map) + call addmrg_to(compocn, 'Sw_vstokes_wavenumber_6', mrg_from=compwav, mrg_fld='Sw_lamult', mrg_type='copy') + end if + end if end if !----------------------------- ! to ocn: !----------------------------- - if (phase == 'advertise') then - call addfld_from(compwav, 'Sw_Dp') - call addfld_to(compocn, 'Sw_Dp') - else - if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_Dp', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_Dp', rc=rc)) then - call addmap_from(compwav, 'Sw_Dp', compocn, mapbilnr_nstod, 'one', wav2ocn_map) - call addmrg_to(compocn, 'Sw_Dp', mrg_from=compwav, mrg_fld='Sw_Dp', mrg_type='copy') - end if + if (ocn_name == 'mpaso') then + if (phase == 'advertise') then + call addfld_from(compwav, 'Sw_Dp') + call addfld_to(compocn, 'Sw_Dp') + else + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_Dp', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_Dp', rc=rc)) then + call addmap_from(compwav, 'Sw_Dp', compocn, mapbilnr_nstod, 'one', wav2ocn_map) + call addmrg_to(compocn, 'Sw_Dp', mrg_from=compwav, mrg_fld='Sw_Dp', mrg_type='copy') + end if + end if end if !----------------------------- ! to ocn: Stokes drift u component from wave @@ -3256,15 +3295,17 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! --------------------------------------------------------------------- ! to ice: frazil from ocn ! --------------------------------------------------------------------- - if (phase == 'advertise') then - call addfld_from(compocn, 'Fioo_frazil') - call addfld_to(compice, 'Fioo_frazil') - else - if ( fldchk(is_local%wrap%FBImp(compocn, compocn), 'Fioo_frazil', rc=rc) .and. & - fldchk(is_local%wrap%FBExp(compice) , 'Fioo_frazil', rc=rc)) then - call addmap_from(compocn, 'Fioo_frazil', compice, mapfcopy, 'unset', 'unset') - call addmrg_to(compice, 'Fioo_frazil', mrg_from=compocn, mrg_fld='Fioo_frazil', mrg_type='copy') - end if + if (ocn_name == 'mpaso' .or. ice_name == 'mpassi') then + if (phase == 'advertise') then + call addfld_from(compocn, 'Fioo_frazil') + call addfld_to(compice, 'Fioo_frazil') + else + if ( fldchk(is_local%wrap%FBImp(compocn, compocn), 'Fioo_frazil', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compice) , 'Fioo_frazil', rc=rc)) then + call addmap_from(compocn, 'Fioo_frazil', compice, mapfcopy, 'unset', 'unset') + call addmrg_to(compice, 'Fioo_frazil', mrg_from=compocn, mrg_fld='Fioo_frazil', mrg_type='copy') + end if + end if end if !----------------------------- ! to ice: Ratio of ocean surface level abund. H2_16O/H2O/Rstd from ocean From 832a08562cf5eb586b78422af425303474b0cf8c Mon Sep 17 00:00:00 2001 From: "G. Dylan Dickerson" Date: Wed, 18 Jun 2025 13:23:41 -0600 Subject: [PATCH 046/123] Reveiw req., consolidate exchange MPAS guards --- mediator/esmFldsExchange_cesm_mod.F90 | 156 ++++++++++---------------- 1 file changed, 61 insertions(+), 95 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 8e6152508..fb1f8d708 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -2547,10 +2547,10 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmrg_to(compocn, 'Sw_lamult', mrg_from=compwav, mrg_fld='Sw_lamult', mrg_type='copy') end if end if - !----------------------------- - ! to ocn: - !----------------------------- if (ocn_name == 'mpaso') then + !----------------------------- + ! to ocn: + !----------------------------- if (phase == 'advertise') then call addfld_from(compwav, 'Sw_Hs') call addfld_to(compocn, 'Sw_Hs') @@ -2561,11 +2561,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmrg_to(compocn, 'Sw_Hs', mrg_from=compwav, mrg_fld='Sw_hs', mrg_type='copy') end if end if - end if - !----------------------------- - ! to ocn: - !----------------------------- - if (ocn_name == 'mpaso') then + !----------------------------- + ! to ocn: + !----------------------------- if (phase == 'advertise') then call addfld_from(compwav, 'Sw_Fp') call addfld_to(compocn, 'Sw_Fp') @@ -2576,11 +2574,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmrg_to(compocn, 'Sw_Fp', mrg_from=compwav, mrg_fld='Sw_Fp', mrg_type='copy') end if end if - end if - !----------------------------- - ! to ocn: - !----------------------------- - if (ocn_name == 'mpaso') then + !----------------------------- + ! to ocn: + !----------------------------- if (phase == 'advertise') then call addfld_from(compwav, 'Sw_ustokes_wavenumber_1') call addfld_to(compocn, 'Sw_ustokes_wavenumber_1') @@ -2591,11 +2587,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmrg_to(compocn, 'Sw_ustokes_wavenumber_1', mrg_from=compwav, mrg_fld='Sw_ustokes_wavenumber_1', mrg_type='copy') end if end if - end if - !----------------------------- - ! to ocn: - !----------------------------- - if (ocn_name == 'mpaso') then + !----------------------------- + ! to ocn: + !----------------------------- if (phase == 'advertise') then call addfld_from(compwav, 'Sw_vstokes_wavenumber_1') call addfld_to(compocn, 'Sw_vstokes_wavenumber_1') @@ -2606,11 +2600,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmrg_to(compocn, 'Sw_vstokes_wavenumber_1', mrg_from=compwav, mrg_fld='Sw_lamult', mrg_type='copy') end if end if - end if - !----------------------------- - ! to ocn: - !----------------------------- - if (ocn_name == 'mpaso') then + !----------------------------- + ! to ocn: + !----------------------------- if (phase == 'advertise') then call addfld_from(compwav, 'Sw_ustokes_wavenumber_2') call addfld_to(compocn, 'Sw_ustokes_wavenumber_2') @@ -2621,26 +2613,22 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmrg_to(compocn, 'Sw_ustokes_wavenumber_2', mrg_from=compwav, mrg_fld='Sw_ustokes_wavenumber_2', mrg_type='copy') end if end if - end if - !----------------------------- - ! to ocn: - !----------------------------- - if (ocn_name == 'mpaso') then - if (phase == 'advertise') then - call addfld_from(compwav, 'Sw_vstokes_wavenumber_2') - call addfld_to(compocn, 'Sw_vstokes_wavenumber_2') - else - if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_vstokes_wavenumber_2', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_vstokes_wavenumber_2', rc=rc)) then - call addmap_from(compwav, 'Sw_vstokes_wavenumber_2', compocn, mapbilnr_nstod, 'one', wav2ocn_map) - call addmrg_to(compocn, 'Sw_vstokes_wavenumber_2', mrg_from=compwav, mrg_fld='Sw_lamult', mrg_type='copy') - end if - end if - end if - !----------------------------- - ! to ocn: - !----------------------------- - if (ocn_name == 'mpaso') then + !----------------------------- + ! to ocn: + !----------------------------- + if (phase == 'advertise') then + call addfld_from(compwav, 'Sw_vstokes_wavenumber_2') + call addfld_to(compocn, 'Sw_vstokes_wavenumber_2') + else + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_vstokes_wavenumber_2', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_vstokes_wavenumber_2', rc=rc)) then + call addmap_from(compwav, 'Sw_vstokes_wavenumber_2', compocn, mapbilnr_nstod, 'one', wav2ocn_map) + call addmrg_to(compocn, 'Sw_vstokes_wavenumber_2', mrg_from=compwav, mrg_fld='Sw_lamult', mrg_type='copy') + end if + end if + !----------------------------- + ! to ocn: + !----------------------------- if (phase == 'advertise') then call addfld_from(compwav, 'Sw_ustokes_wavenumber_3') call addfld_to(compocn, 'Sw_ustokes_wavenumber_3') @@ -2651,11 +2639,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmrg_to(compocn, 'Sw_ustokes_wavenumber_3', mrg_from=compwav, mrg_fld='Sw_ustokes_wavenumber_3', mrg_type='copy') end if end if - end if - !----------------------------- - ! to ocn: - !----------------------------- - if (ocn_name == 'mpaso') then + !----------------------------- + ! to ocn: + !----------------------------- if (phase == 'advertise') then call addfld_from(compwav, 'Sw_vstokes_wavenumber_3') call addfld_to(compocn, 'Sw_vstokes_wavenumber_3') @@ -2666,11 +2652,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmrg_to(compocn, 'Sw_vstokes_wavenumber_3', mrg_from=compwav, mrg_fld='Sw_lamult', mrg_type='copy') end if end if - end if - !----------------------------- - ! to ocn: - !----------------------------- - if (ocn_name == 'mpaso') then + !----------------------------- + ! to ocn: + !----------------------------- if (phase == 'advertise') then call addfld_from(compwav, 'Sw_ustokes_wavenumber_4') call addfld_to(compocn, 'Sw_ustokes_wavenumber_4') @@ -2681,11 +2665,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmrg_to(compocn, 'Sw_ustokes_wavenumber_4', mrg_from=compwav, mrg_fld='Sw_ustokes_wavenumber_4', mrg_type='copy') end if end if - end if - !----------------------------- - ! to ocn: - !----------------------------- - if (ocn_name == 'mpaso') then + !----------------------------- + ! to ocn: + !----------------------------- if (phase == 'advertise') then call addfld_from(compwav, 'Sw_vstokes_wavenumber_4') call addfld_to(compocn, 'Sw_vstokes_wavenumber_4') @@ -2696,11 +2678,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmrg_to(compocn, 'Sw_vstokes_wavenumber_4', mrg_from=compwav, mrg_fld='Sw_lamult', mrg_type='copy') end if end if - end if - !----------------------------- - ! to ocn: - !----------------------------- - if (ocn_name == 'mpaso') then + !----------------------------- + ! to ocn: + !----------------------------- if (phase == 'advertise') then call addfld_from(compwav, 'Sw_ustokes_wavenumber_5') call addfld_to(compocn, 'Sw_ustokes_wavenumber_5') @@ -2711,11 +2691,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmrg_to(compocn, 'Sw_ustokes_wavenumber_5', mrg_from=compwav, mrg_fld='Sw_ustokes_wavenumber_5', mrg_type='copy') end if end if - end if - !----------------------------- - ! to ocn: - !----------------------------- - if (ocn_name == 'mpaso') then + !----------------------------- + ! to ocn: + !----------------------------- if (phase == 'advertise') then call addfld_from(compwav, 'Sw_vstokes_wavenumber_5') call addfld_to(compocn, 'Sw_vstokes_wavenumber_5') @@ -2726,11 +2704,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmrg_to(compocn, 'Sw_vstokes_wavenumber_5', mrg_from=compwav, mrg_fld='Sw_lamult', mrg_type='copy') end if end if - end if - !----------------------------- - ! to ocn: - !----------------------------- - if (ocn_name == 'mpaso') then + !----------------------------- + ! to ocn: + !----------------------------- if (phase == 'advertise') then call addfld_from(compwav, 'Sw_ustokes_wavenumber_6') call addfld_to(compocn, 'Sw_ustokes_wavenumber_6') @@ -2741,11 +2717,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmrg_to(compocn, 'Sw_ustokes_wavenumber_6', mrg_from=compwav, mrg_fld='Sw_ustokes_wavenumber_6', mrg_type='copy') end if end if - end if - !----------------------------- - ! to ocn: - !----------------------------- - if (ocn_name == 'mpaso') then + !----------------------------- + ! to ocn: + !----------------------------- if (phase == 'advertise') then call addfld_from(compwav, 'Sw_vstokes_wavenumber_6') call addfld_to(compocn, 'Sw_vstokes_wavenumber_6') @@ -2756,11 +2730,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmrg_to(compocn, 'Sw_vstokes_wavenumber_6', mrg_from=compwav, mrg_fld='Sw_lamult', mrg_type='copy') end if end if - end if - !----------------------------- - ! to ocn: - !----------------------------- - if (ocn_name == 'mpaso') then + !----------------------------- + ! to ocn: + !----------------------------- if (phase == 'advertise') then call addfld_from(compwav, 'Sw_ustokes_wavenumber_6') call addfld_to(compocn, 'Sw_ustokes_wavenumber_6') @@ -2771,11 +2743,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmrg_to(compocn, 'Sw_ustokes_wavenumber_6', mrg_from=compwav, mrg_fld='Sw_ustokes_wavenumber_6', mrg_type='copy') end if end if - end if - !----------------------------- - ! to ocn: - !----------------------------- - if (ocn_name == 'mpaso') then + !----------------------------- + ! to ocn: + !----------------------------- if (phase == 'advertise') then call addfld_from(compwav, 'Sw_vstokes_wavenumber_6') call addfld_to(compocn, 'Sw_vstokes_wavenumber_6') @@ -2786,13 +2756,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmrg_to(compocn, 'Sw_vstokes_wavenumber_6', mrg_from=compwav, mrg_fld='Sw_lamult', mrg_type='copy') end if end if - end if - - - !----------------------------- - ! to ocn: - !----------------------------- - if (ocn_name == 'mpaso') then + !----------------------------- + ! to ocn: + !----------------------------- if (phase == 'advertise') then call addfld_from(compwav, 'Sw_Dp') call addfld_to(compocn, 'Sw_Dp') From a28d8999e88c2bfacf1d21848d2838150d766f5f Mon Sep 17 00:00:00 2001 From: adamrher Date: Wed, 18 Jun 2025 14:07:32 -0600 Subject: [PATCH 047/123] add ATM_NCPL entry for NATLx8 grid --- cime_config/config_component_cesm.xml | 1 + 1 file changed, 1 insertion(+) diff --git a/cime_config/config_component_cesm.xml b/cime_config/config_component_cesm.xml index a392f9f88..77f3afb63 100644 --- a/cime_config/config_component_cesm.xml +++ b/cime_config/config_component_cesm.xml @@ -270,6 +270,7 @@ 192 384 192 + 384 48 48 48 From 643d2d31bacf807cca2e4f023bc233a8600ea628 Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Wed, 25 Jun 2025 10:31:58 -0400 Subject: [PATCH 048/123] add unit fix for uv3d mapping --- mediator/med_map_mod.F90 | 104 ++++++++++++++++++++++----------------- 1 file changed, 59 insertions(+), 45 deletions(-) diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 363a10bb6..a3d50c5e4 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -1487,10 +1487,12 @@ end subroutine med_map_field !================================================================================ subroutine med_map_uv_cart3d(FBsrc, FBdst, routehandles, mapindex, map_stress, rc) - use ESMF , only : ESMF_Mesh, ESMF_MeshGet, ESMF_MESHLOC_ELEMENT, ESMF_TYPEKIND_R8 - use ESMF , only : ESMF_Field, ESMF_FieldCreate, ESMF_FieldGet - use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet - use ESMF , only : ESMF_RouteHandle + use ESMF , only : operator(==) + use ESMF , only : ESMF_Mesh, ESMF_MeshGet, ESMF_MESHLOC_ELEMENT, ESMF_TYPEKIND_R8 + use ESMF , only : ESMF_Field, ESMF_FieldCreate, ESMF_FieldGet + use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet + use ESMF , only : ESMF_RouteHandle + use ESMF , only : ESMF_CoordSys_Flag, ESMF_COORDSYS_SPH_DEG, ESMF_COORDSYS_SPH_RAD use med_constants_mod , only : shr_const_pi ! input/output variables @@ -1502,31 +1504,33 @@ subroutine med_map_uv_cart3d(FBsrc, FBdst, routehandles, mapindex, map_stress, r integer , intent(out) :: rc ! local variables - type(ESMF_Field) :: usrc - type(ESMF_Field) :: vsrc - type(ESMF_Field) :: udst - type(ESMF_Field) :: vdst - integer :: n - real(r8) :: lon,lat - real(r8) :: coslon,coslat - real(r8) :: sinlon,sinlat - real(r8) :: ux,uy,uz - type(ESMF_Mesh) :: lmesh_src - type(ESMF_Mesh) :: lmesh_dst - real(r8), pointer :: data_u_src(:) - real(r8), pointer :: data_u_dst(:) - real(r8), pointer :: data_v_src(:) - real(r8), pointer :: data_v_dst(:) - real(r8), pointer :: data2d_src(:,:) - real(r8), pointer :: data2d_dst(:,:) - real(r8), pointer :: ownedElemCoords_src(:) - real(r8), pointer :: ownedElemCoords_dst(:) - integer :: numOwnedElements - integer :: spatialDim - real(r8), parameter :: deg2rad = shr_const_pi/180.0_R8 ! deg to rads - logical :: first_time = .true. - logical :: lmap_stress - character(len=CS) :: uname, vname + type(ESMF_Field) :: usrc + type(ESMF_Field) :: vsrc + type(ESMF_Field) :: udst + type(ESMF_Field) :: vdst + type(ESMF_CoordSys_Flag) :: coordsys_src + type(ESMF_CoordSys_Flag) :: coordsys_dst + integer :: n + real(r8) :: lon,lat + real(r8) :: coslon,coslat + real(r8) :: sinlon,sinlat + real(r8) :: ux,uy,uz + type(ESMF_Mesh) :: lmesh_src + type(ESMF_Mesh) :: lmesh_dst + real(r8), pointer :: data_u_src(:) + real(r8), pointer :: data_u_dst(:) + real(r8), pointer :: data_v_src(:) + real(r8), pointer :: data_v_dst(:) + real(r8), pointer :: data2d_src(:,:) + real(r8), pointer :: data2d_dst(:,:) + real(r8), pointer :: ownedElemCoords_src(:) + real(r8), pointer :: ownedElemCoords_dst(:) + integer :: numOwnedElements + integer :: spatialDim + real(r8), parameter :: deg2rad = shr_const_pi/180.0_R8 ! deg to rads + logical :: first_time = .true. + logical :: lmap_stress + character(len=CS) :: uname, vname character(len=*), parameter :: subname=' (med_map_mod:med_map_uv_cart3d) ' !------------------------------------------------------------------------------- @@ -1573,19 +1577,19 @@ subroutine med_map_uv_cart3d(FBsrc, FBdst, routehandles, mapindex, map_stress, r ! Get source mesh and coordinates call ESMF_FieldGet(usrc, mesh=lmesh_src, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_MeshGet(lmesh_src, spatialDim=spatialDim, numOwnedElements=numOwnedElements, rc=rc) + call ESMF_MeshGet(lmesh_src, spatialDim=spatialDim, numOwnedElements=numOwnedElements, coordSys=coordsys_src, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return allocate(ownedElemCoords_src(spatialDim*numOwnedElements)) - call ESMF_MeshGet(lmesh_src, ownedElemCoords=ownedElemCoords_src) + call ESMF_MeshGet(lmesh_src, ownedElemCoords=ownedElemCoords_src, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! Get destination mesh and coordinates call ESMF_FieldGet(udst, mesh=lmesh_dst, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_MeshGet(lmesh_dst, spatialDim=spatialDim, numOwnedElements=numOwnedElements, rc=rc) + call ESMF_MeshGet(lmesh_dst, spatialDim=spatialDim, numOwnedElements=numOwnedElements, coordSys=coordsys_dst, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return allocate(ownedElemCoords_dst(spatialDim*numOwnedElements)) - call ESMF_MeshGet(lmesh_dst, ownedElemCoords=ownedElemCoords_dst) + call ESMF_MeshGet(lmesh_dst, ownedElemCoords=ownedElemCoords_dst, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (first_time) then @@ -1610,12 +1614,17 @@ subroutine med_map_uv_cart3d(FBsrc, FBdst, routehandles, mapindex, map_stress, r ! Rotate Source data to cart3d do n = 1,size(data_u_src) - lon = ownedElemCoords_src(2*n-1) - lat = ownedElemCoords_src(2*n) - sinlon = sin(lon*deg2rad) - coslon = cos(lon*deg2rad) - sinlat = sin(lat*deg2rad) - coslat = cos(lat*deg2rad) + if (coordsys_src == ESMF_COORDSYS_SPH_DEG) then + lon = deg2rad*ownedElemCoords_src(2*n-1) + lat = deg2rad*ownedElemCoords_src(2*n) + else + lon = ownedElemCoords_src(2*n-1) + lat = ownedElemCoords_src(2*n) + end if + sinlon = sin(lon) + coslon = cos(lon) + sinlat = sin(lat) + coslat = cos(lat) data2d_src(1,n) = -coslon*sinlat*data_v_src(n) - sinlon*data_u_src(n) ! x data2d_src(2,n) = -sinlon*sinlat*data_v_src(n) + coslon*data_u_src(n) ! y data2d_src(3,n) = coslat*data_v_src(n) ! z @@ -1628,12 +1637,17 @@ subroutine med_map_uv_cart3d(FBsrc, FBdst, routehandles, mapindex, map_stress, r ! Rotate destination data back from cart3d to original do n = 1,size(data_u_dst) - lon = ownedElemCoords_dst(2*n-1) - lat = ownedElemCoords_dst(2*n) - sinlon = sin(lon*deg2rad) - coslon = cos(lon*deg2rad) - sinlat = sin(lat*deg2rad) - coslat = cos(lat*deg2rad) + if (coordsys_dst == ESMF_COORDSYS_SPH_DEG) then + lon = deg2rad*ownedElemCoords_dst(2*n-1) + lat = deg2rad*ownedElemCoords_dst(2*n) + else + lon = ownedElemCoords_dst(2*n-1) + lat = ownedElemCoords_dst(2*n) + end if + sinlon = sin(lon) + coslon = cos(lon) + sinlat = sin(lat) + coslat = cos(lat) ux = data2d_dst(1,n) uy = data2d_dst(2,n) uz = data2d_dst(3,n) From ae6db2120e7a97429a2b2d3287e13feebe25d530 Mon Sep 17 00:00:00 2001 From: Nicholas Szapiro <149816583+NickSzapiro-NOAA@users.noreply.github.com> Date: Wed, 9 Jul 2025 09:26:19 -0400 Subject: [PATCH 049/123] if maintask call log_restart_fh (#143) --- mediator/med_phases_restart_mod.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/mediator/med_phases_restart_mod.F90 b/mediator/med_phases_restart_mod.F90 index f3a83198e..705bf7ac5 100644 --- a/mediator/med_phases_restart_mod.F90 +++ b/mediator/med_phases_restart_mod.F90 @@ -492,8 +492,10 @@ subroutine med_phases_restart_write(gcomp, rc) call med_io_close(io_file, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return #ifndef CESMCOUPLED - call log_restart_fh(nextTime, startTime, 'cmeps', rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (maintask) then + call log_restart_fh(nextTime, startTime, 'cmeps', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif #endif endif From e0ae5ad0fa84183bc249dcb34af9e7c4dc89ec8b Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 25 Jul 2025 08:59:09 -0600 Subject: [PATCH 050/123] add a testmod to test the interim restart feature, this mod requires cime PR 4827 --- .../testdefs/testmods_dirs/drv/interim_restart/shell_commands | 2 ++ 1 file changed, 2 insertions(+) create mode 100644 cime_config/testdefs/testmods_dirs/drv/interim_restart/shell_commands diff --git a/cime_config/testdefs/testmods_dirs/drv/interim_restart/shell_commands b/cime_config/testdefs/testmods_dirs/drv/interim_restart/shell_commands new file mode 100644 index 000000000..90c2d7364 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/drv/interim_restart/shell_commands @@ -0,0 +1,2 @@ +# use this with the ERR test to test the interim restart capability +./xmlchange REST_N=2 \ No newline at end of file From a4533b24feb659218749312165de448117bf4060 Mon Sep 17 00:00:00 2001 From: Jian Sun Date: Mon, 28 Jul 2025 22:07:07 -0600 Subject: [PATCH 051/123] add cirrus and casper gpu types --- cime_config/config_component.xml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index 872f45c93..5323b5df2 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -817,6 +817,8 @@ char none,a100 + none,a10,a2 + none,v100,a100,h100 none build_def env_build.xml From 40ae33c0293f7d98e033dcc3e4ca242fb173776c Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Tue, 29 Jul 2025 12:24:20 -0400 Subject: [PATCH 052/123] Switch to bilinear mapping for global DATM configurations (#142) * allow datm configs to map with patch or bilnr --- mediator/esmFldsExchange_ufs_mod.F90 | 18 +++++------------- mediator/med.F90 | 4 ++-- 2 files changed, 7 insertions(+), 15 deletions(-) diff --git a/mediator/esmFldsExchange_ufs_mod.F90 b/mediator/esmFldsExchange_ufs_mod.F90 index 42acda4d3..dd342cf07 100644 --- a/mediator/esmFldsExchange_ufs_mod.F90 +++ b/mediator/esmFldsExchange_ufs_mod.F90 @@ -159,7 +159,7 @@ subroutine esmFldsExchange_ufs(gcomp, phase, rc) call addfld_from(compatm , fldname) else if ( fldchk(is_local%wrap%FBImp(compatm,compatm), fldname, rc=rc)) then - call addmap_from(compatm, fldname, compocn, maptype, 'one', 'unset') + call addmap_from(compatm, fldname, compocn, mapbilnr, 'one', 'unset') end if end if end do @@ -656,11 +656,7 @@ subroutine esmFldsExchange_ufs(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBexp(compice) , fldname, rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), fldname, rc=rc)) then - if (med_aoflux_to_ocn) then - call addmap_from(compatm, fldname, compice, maptype, 'one', 'unset') - else - call addmap_from(compatm, fldname, compice, mapbilnr, 'one', 'unset') - end if + call addmap_from(compatm, fldname, compice, mapbilnr, 'one', 'unset') call addmrg_to(compice, fldname, mrg_from=compatm, mrg_fld=fldname, mrg_type='copy') end if end if @@ -679,14 +675,10 @@ subroutine esmFldsExchange_ufs(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBexp(compice) , fldname, rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), fldname, rc=rc)) then - if (med_aoflux_to_ocn) then - call addmap_from(compatm, fldname, compice, maptype, 'one', 'unset') + if (mapuv_with_cart3d) then + call addmap_from(compatm, fldname, compice, mappatch_uv3d, 'one', 'unset') else - if (mapuv_with_cart3d) then - call addmap_from(compatm, fldname, compice, mappatch_uv3d, 'one', 'unset') - else - call addmap_from(compatm, fldname, compice, mappatch, 'one', 'unset') - end if + call addmap_from(compatm, fldname, compice, mappatch, 'one', 'unset') end if call addmrg_to(compice, fldname, mrg_from=compatm, mrg_fld=fldname, mrg_type='copy') end if diff --git a/mediator/med.F90 b/mediator/med.F90 index 7f5151c96..067194eff 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -52,7 +52,7 @@ module MED use esmFldsExchange_hafs_mod , only : esmFldsExchange_hafs use med_phases_profile_mod , only : med_phases_profile_finalize use shr_log_mod , only : shr_log_error - + implicit none private @@ -1348,7 +1348,7 @@ subroutine realizeConnectedGrid(State,string,rc) call shr_log_error(trim(subname)//": ERROR fieldStatus not supported ", rc=rc) return - + endif ! fieldStatus enddo ! nflds From 0c0d8ff0d451e1d786fb56dd54c7bd040cf6d167 Mon Sep 17 00:00:00 2001 From: "G. Dylan Dickerson" Date: Wed, 30 Jul 2025 13:40:21 -0600 Subject: [PATCH 053/123] Put mpasa ATM_NCPL lines next to other resolution-dependent values --- cime_config/config_component_cesm.xml | 21 +++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/cime_config/config_component_cesm.xml b/cime_config/config_component_cesm.xml index 608a5fcbd..31536790a 100644 --- a/cime_config/config_component_cesm.xml +++ b/cime_config/config_component_cesm.xml @@ -279,16 +279,6 @@ 72 144 288 - - - - - 1 - - - - 24 - 48 48 48 48 @@ -297,6 +287,7 @@ 360 720 1440 + 2 2 2 @@ -305,6 +296,16 @@ 15 30 60 + + + + + 1 + + + + 24 + 48 run_coupling env_run.xml From 1b8d1d2f0c8409ab5f65a1ee58a15efe32185921 Mon Sep 17 00:00:00 2001 From: "G. Dylan Dickerson" Date: Wed, 30 Jul 2025 13:41:14 -0600 Subject: [PATCH 054/123] Adjust for _MPAS compsets using NCPL_BASE_PERIOD=hour --- cime_config/config_component_cesm.xml | 1 + 1 file changed, 1 insertion(+) diff --git a/cime_config/config_component_cesm.xml b/cime_config/config_component_cesm.xml index 31536790a..ccf994d47 100644 --- a/cime_config/config_component_cesm.xml +++ b/cime_config/config_component_cesm.xml @@ -220,6 +220,7 @@ integer 48 + 2 144 288 288 From 50b7c7596fa2c6db512b1e1976c8db302c266460 Mon Sep 17 00:00:00 2001 From: BinLi-NOAA Date: Mon, 11 Aug 2025 08:40:13 -0400 Subject: [PATCH 055/123] Update CMEPS for 2-way ocean-wave coupling in HAFS (#133) * Update esmFldsExchange_hafs_mod.F90 for ocean-wave coupling --- mediator/esmFldsExchange_hafs_mod.F90 | 64 ++++++++++++++++++++++++++- 1 file changed, 63 insertions(+), 1 deletion(-) diff --git a/mediator/esmFldsExchange_hafs_mod.F90 b/mediator/esmFldsExchange_hafs_mod.F90 index b545b9b1c..0515c8707 100644 --- a/mediator/esmFldsExchange_hafs_mod.F90 +++ b/mediator/esmFldsExchange_hafs_mod.F90 @@ -280,6 +280,18 @@ subroutine esmFldsExchange_hafs_advt(gcomp, phase, rc) end if end if + ! to ocn: partitioned stokes drift from wav + if (hafs_attr%wav_present .and. hafs_attr%ocn_present) then + allocate(S_flds(2)) + S_flds = (/'Sw_pstokes_x', 'Sw_pstokes_y'/) + do n = 1,size(S_flds) + fldname = trim(S_flds(n)) + call addfld_from(compwav , fldname) + call addfld_to(compocn , fldname) + end do + deallocate(S_flds) + end if + !===================================================================== ! FIELDS TO WAVE (compwav) !===================================================================== @@ -298,6 +310,22 @@ subroutine esmFldsExchange_hafs_advt(gcomp, phase, rc) deallocate(S_flds) end if + ! --------------------------------------------------------------------- + ! to wav: states from ocn + ! - zonal sea water velocity from ocn + ! - meridional sea water velocity from ocn + ! --------------------------------------------------------------------- + if (hafs_attr%ocn_present .and. hafs_attr%wav_present) then + allocate(S_flds(2)) + S_flds = (/'So_u', 'So_v'/) + do n = 1,size(S_flds) + fldname = trim(S_flds(n)) + call addfld_from(compocn , fldname) + call addfld_to(compwav , fldname) + end do + deallocate(S_flds) + end if + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end subroutine esmFldsExchange_hafs_advt @@ -569,6 +597,22 @@ subroutine esmFldsExchange_hafs_init(gcomp, phase, rc) end if end if + ! --------------------------------------------------------------------- + ! to ocn: partitioned stokes drift from wav + ! --------------------------------------------------------------------- + allocate(S_flds(2)) + S_flds = (/'Sw_pstokes_x', 'Sw_pstokes_y'/) + do n = 1,size(S_flds) + fldname = trim(S_flds(n)) + if ( fldchk(is_local%wrap%FBexp(compocn) , fldname, rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compwav,compwav), fldname, rc=rc)) then + call addmap_from(compwav, fldname, compocn, mapfillv_bilnr, & + hafs_attr%mapnorm, 'unset') + call addmrg_to(compocn, fldname, mrg_from=compwav, mrg_fld=fldname, mrg_type='copy') + end if + end do + deallocate(S_flds) + !===================================================================== ! FIELDS TO WAVE (compwav) !===================================================================== @@ -581,7 +625,7 @@ subroutine esmFldsExchange_hafs_init(gcomp, phase, rc) S_flds = (/'Sa_u10m', 'Sa_v10m'/) do n = 1,size(S_flds) fldname = trim(S_flds(n)) - if (fldchk(is_local%wrap%FBexp(compwav),trim(fldname),rc=rc) .and. & + if (fldchk(is_local%wrap%FBexp(compwav), trim(fldname),rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), trim(fldname),rc=rc) & ) then call addmap_from(compatm, trim(fldname), compwav, & @@ -593,6 +637,24 @@ subroutine esmFldsExchange_hafs_init(gcomp, phase, rc) deallocate(S_flds) end if + ! --------------------------------------------------------------------- + ! to wav: states from ocn + ! - zonal sea water velocity from ocn + ! - meridional sea water velocity from ocn + ! --------------------------------------------------------------------- + allocate(S_flds(2)) + S_flds = (/'So_u', 'So_v'/) + do n = 1,size(S_flds) + fldname = trim(S_flds(n)) + if ( fldchk(is_local%wrap%FBexp(compwav) , fldname, rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compocn,compocn), fldname, rc=rc)) then + call addmap_from(compocn, fldname, compwav, mapfillv_bilnr, & + hafs_attr%mapnorm, 'unset') + call addmrg_to(compwav, fldname, mrg_from=compocn, mrg_fld=fldname, mrg_type='copy') + end if + end do + deallocate(S_flds) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end subroutine esmFldsExchange_hafs_init From db0557d8e20ce4d7a48ec4f17bd2a4db92fd8059 Mon Sep 17 00:00:00 2001 From: Marit Sandstad Date: Mon, 11 Aug 2025 09:32:09 +0200 Subject: [PATCH 056/123] Adding Alok's fixed file for the fco2 land flux mediation (cherry picked from commit ae2d923dc5397a61a921fea8dd8d9dd01f614f93) --- mediator/esmFldsExchange_cesm_mod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index fb1f8d708..d86d4c771 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -1705,8 +1705,8 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) 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 + if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_fco2_lnd', rc=rc) .and. & + fldchk(is_local%wrap%FBexp(compatm) , 'Fall_fco2_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) From 1280f5e029091551da18f469ab2440951aa8c5a2 Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Tue, 12 Aug 2025 17:59:50 -0400 Subject: [PATCH 057/123] update cdeps_version --- .github/workflows/extbuild.yml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/.github/workflows/extbuild.yml b/.github/workflows/extbuild.yml index f31f46bd4..113f90885 100644 --- a/.github/workflows/extbuild.yml +++ b/.github/workflows/extbuild.yml @@ -24,7 +24,7 @@ jobs: PNETCDF_VERSION: checkpoint.1.14.0 NETCDF_FORTRAN_VERSION: v4.6.1 PIO_VERSION: pio2_6_5 - CDEPS_VERSION: cdeps1.0.72 + CDEPS_VERSION: cdeps1.0.80 steps: - uses: actions/checkout@v4 # Build the ESMF library, if the cache contains a previous build @@ -75,7 +75,7 @@ jobs: with: path: /homme/runner/work/CMEPS/CMEPS/build-cdeps key: ${{ runner.os }}-${{ env.CDEPS_VERSION }}.cdeps1 - + - name: checkout CDEPS uses: actions/checkout@v4 with: @@ -85,7 +85,7 @@ jobs: - name: get genf90 run: | cd cdeps-src - git submodule update --init + git submodule update --init - name: Build CDEPS if: steps.cache-cdeps.outputs.cache-hit != 'true' uses: ESCOMP/CDEPS/.github/actions/buildcdeps@cdeps1.0.26 @@ -95,7 +95,7 @@ jobs: src_root: ${GITHUB_WORKSPACE}/cdeps-src 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=$HOME/pio From c9790bef1bd9050b7a7f856ed83f29a409d1d0a2 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 13 Aug 2025 12:43:25 -0600 Subject: [PATCH 058/123] add the err test to those avoiding end of run restarts --- cime_config/namelist_definition_drv.xml | 1 + 1 file changed, 1 insertion(+) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 318fc8235..7eb036f34 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -2872,6 +2872,7 @@ .false. .false. .false. + .false. From 22f1dce3ff5ddf8888bdd67e8a6aef38fed7f170 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 20 Aug 2025 08:46:38 -0600 Subject: [PATCH 059/123] moves liblist to driver buildnml making cime more generic --- cime_config/buildnml | 34 +++++++++++++++++++++++++++++++- cime_config/config_component.xml | 15 +++++++++++--- 2 files changed, 45 insertions(+), 4 deletions(-) diff --git a/cime_config/buildnml b/cime_config/buildnml index 7ffc28f82..e43cf0661 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -628,6 +628,35 @@ def compare_drv_flds_in(first, second, infile1, infile2): % (infile1, infile2), ) +def cmeps_lib_list(case): + ufs_driver = os.environ.get("UFS_DRIVER") + mpilib = case.get_value("MPILIB") + if ufs_driver: + logger.info("UFS_DRIVER is set to {}".format(ufs_driver)) + if ufs_driver and ufs_driver == "nems" and not cpl_in_complist: + libs = [] + elif case.get_value("MODEL") == "cesm": + libs = ["gptl", "pio", "csm_share"] + elif case.get_value("MODEL") == "e3sm": + libs = ["gptl", "mct", "spio", "csm_share"] + else: + libs = ["gptl", "mct", "pio", "csm_share"] + + libs.append("FTorch") + + if mpilib == "mpi-serial": + libs.insert(0, mpilib) + + # Build shared code of CDEPS nuopc data models + if not ufs_driver or ufs_driver != "nems": + libs.append("CDEPS") + + ocn_model = case.get_value("COMP_OCN") + + atm_dycore = case.get_value("CAM_DYCORE") + if ocn_model == "mom" or (atm_dycore and atm_dycore == "fv3"): + libs.append("FMS") + return libs ############################################################################### def buildnml(case, caseroot, component): @@ -635,6 +664,9 @@ def buildnml(case, caseroot, component): if component != "drv": raise AttributeError + libs = cmeps_lib_list(case) + case.set_value("CASE_SUPPORT_LIBRARIES", ",".join(libs)) + esmfmkfile = os.getenv("ESMFMKFILE") expect( esmfmkfile and os.path.isfile(esmfmkfile), @@ -725,7 +757,7 @@ def buildnml(case, caseroot, component): def _main_func(): caseroot = parse_input(sys.argv) - with Case(caseroot) as case: + with Case(caseroot, read_only=False) as case: buildnml(case, caseroot, "drv") diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index 5323b5df2..4d2aa5b8f 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -2522,10 +2522,19 @@ Remote git repository used for this case - - - + + char + + build_def + env_build.xml + Support libraries required + + + + + + logical TRUE,FALSE From e4030eb391b56bdea396147aa2286aff71568716 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Thu, 21 Aug 2025 08:06:26 -0600 Subject: [PATCH 060/123] allow for other components to modify CASE_SUPPORT_LIBRARIES --- cime_config/buildnml | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/cime_config/buildnml b/cime_config/buildnml index e43cf0661..0b970cc6b 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -7,7 +7,7 @@ _CIMEROOT = os.environ.get("CIMEROOT") if _CIMEROOT is None: raise SystemExit("ERROR: must set CIMEROOT environment variable") -sys.path.append(os.path.join(_CIMEROOT, "scripts", "Tools")) +sys.path.append(os.path.join(_CIMEROOT, "CIME", "Tools")) import shutil, glob, itertools from standard_script_setup import * @@ -629,18 +629,22 @@ def compare_drv_flds_in(first, second, infile1, infile2): ) def cmeps_lib_list(case): + # provide a list of support libs that must be built for this case + # should be ordered with dependent libraries listed after those depended on ufs_driver = os.environ.get("UFS_DRIVER") mpilib = case.get_value("MPILIB") if ufs_driver: logger.info("UFS_DRIVER is set to {}".format(ufs_driver)) + # allows for some libs to have been previously set + libs = case.get_values("CASE_SUPPORT_LIBRARIES") if ufs_driver and ufs_driver == "nems" and not cpl_in_complist: - libs = [] + pass elif case.get_value("MODEL") == "cesm": - libs = ["gptl", "pio", "csm_share"] + libs.extend(["gptl", "pio", "csm_share"]) elif case.get_value("MODEL") == "e3sm": - libs = ["gptl", "mct", "spio", "csm_share"] + libs.extend(["gptl", "mct", "spio", "csm_share"]) else: - libs = ["gptl", "mct", "pio", "csm_share"] + libs.extend(["gptl", "mct", "pio", "csm_share"]) libs.append("FTorch") From 32d3d9d84800b157b8bf89f0006f9879d30a9d3f Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 22 Aug 2025 08:27:15 -0600 Subject: [PATCH 061/123] add comment --- cime_config/buildnml | 1 + 1 file changed, 1 insertion(+) diff --git a/cime_config/buildnml b/cime_config/buildnml index 0b970cc6b..b8f9e1259 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -631,6 +631,7 @@ def compare_drv_flds_in(first, second, infile1, infile2): def cmeps_lib_list(case): # provide a list of support libs that must be built for this case # should be ordered with dependent libraries listed after those depended on + # the library names should match the keys in variable BUILD_LIB_FILE from config_files.xml ufs_driver = os.environ.get("UFS_DRIVER") mpilib = case.get_value("MPILIB") if ufs_driver: From d76c10156dd3fcb42e7286a0559653cdc8f216e9 Mon Sep 17 00:00:00 2001 From: David Bailey Date: Fri, 22 Aug 2025 14:40:26 -0600 Subject: [PATCH 062/123] Make wave ice coupling default --- cime_config/buildnml | 3 ++- cime_config/namelist_definition_drv.xml | 3 +-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/cime_config/buildnml b/cime_config/buildnml index 7ffc28f82..c31fbd39b 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -137,7 +137,8 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): elif case.get_value("RUN_TYPE") == "branch": config["run_type"] = "branch" - config['wav_ice_coupling'] = 'ww3' in config['COMP_WAV'] and config['COMP_ICE'] == 'cice' + if config['COMP_WAV'] == 'ww3' and config['COMP_ICE'] == 'cice': + config["wav_ice_coupling"] = "on" if config["COMP_OCN"] == "blom": if "ecosys" in case.get_value("BLOM_TRACER_MODULES"): diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 7eb036f34..d67b84cdc 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -3836,8 +3836,7 @@ .false. - - + .true. From 5536f787159a37245e670dfacaf10721326f74c9 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Tue, 26 Aug 2025 07:50:34 -0600 Subject: [PATCH 063/123] move defaults to xml --- cime_config/buildnml | 14 -------------- cime_config/config_component.xml | 3 +++ 2 files changed, 3 insertions(+), 14 deletions(-) diff --git a/cime_config/buildnml b/cime_config/buildnml index b8f9e1259..0fac01770 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -638,23 +638,9 @@ def cmeps_lib_list(case): logger.info("UFS_DRIVER is set to {}".format(ufs_driver)) # allows for some libs to have been previously set libs = case.get_values("CASE_SUPPORT_LIBRARIES") - if ufs_driver and ufs_driver == "nems" and not cpl_in_complist: - pass - elif case.get_value("MODEL") == "cesm": - libs.extend(["gptl", "pio", "csm_share"]) - elif case.get_value("MODEL") == "e3sm": - libs.extend(["gptl", "mct", "spio", "csm_share"]) - else: - libs.extend(["gptl", "mct", "pio", "csm_share"]) - - libs.append("FTorch") if mpilib == "mpi-serial": libs.insert(0, mpilib) - - # Build shared code of CDEPS nuopc data models - if not ufs_driver or ufs_driver != "nems": - libs.append("CDEPS") ocn_model = case.get_value("COMP_OCN") diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index 4d2aa5b8f..e2023a1a8 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -2525,6 +2525,9 @@ char + + gptl,pio,csm_share,FTorch,CDEPS + build_def env_build.xml Support libraries required From dbf5588452b1c4da3415f0e3cc500f0fa95eb4cf Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Tue, 26 Aug 2025 12:46:27 -0600 Subject: [PATCH 064/123] clean up; --- .github/workflows/srt.yml | 2 +- cime_config/buildnml | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 31ee1d131..98e97978e 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -28,7 +28,7 @@ jobs: LDFLAGS: "-L/usr/lib/x86_64-linux-gnu -lnetcdf -lnetcdff -lpnetcdf" # Versions of all dependencies can be updated here ESMF_VERSION: v8.8.0 - PARALLELIO_VERSION: pio2_6_5 + PARALLELIO_VERSION: pio2_6_6 CIME_MODEL: cesm CIME_DRIVER: nuopc GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} diff --git a/cime_config/buildnml b/cime_config/buildnml index 0fac01770..763a2e5e2 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -633,12 +633,12 @@ def cmeps_lib_list(case): # should be ordered with dependent libraries listed after those depended on # the library names should match the keys in variable BUILD_LIB_FILE from config_files.xml ufs_driver = os.environ.get("UFS_DRIVER") - mpilib = case.get_value("MPILIB") if ufs_driver: logger.info("UFS_DRIVER is set to {}".format(ufs_driver)) - # allows for some libs to have been previously set + libs = case.get_values("CASE_SUPPORT_LIBRARIES") + mpilib = case.get_value("MPILIB") if mpilib == "mpi-serial": libs.insert(0, mpilib) From be5903f152af7b731c402d3ce7b4f17fd30e2cac Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Tue, 26 Aug 2025 14:12:33 -0600 Subject: [PATCH 065/123] fix for nag formatting error --- mediator/med_internalstate_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index b0caebd9a..70c95ac37 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -279,7 +279,7 @@ subroutine med_internalstate_init(gcomp, rc) end if if (maintask) then - write(logunit,'(a,l)') trim(subname)//' atm and lnd is on same grid = ', samegrid_atmlnd + write(logunit,'(a,l2)') trim(subname)//' atm and lnd is on same grid = ', samegrid_atmlnd end if ! See med_fraction_mod for the following definitions From 4161f31cf2d22c3ce8f04c2afd8cf2c2f20f5119 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Thu, 28 Aug 2025 07:47:46 -0600 Subject: [PATCH 066/123] update documentation --- cime_config/buildnml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cime_config/buildnml b/cime_config/buildnml index 763a2e5e2..c1c8573c7 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -643,9 +643,9 @@ def cmeps_lib_list(case): libs.insert(0, mpilib) ocn_model = case.get_value("COMP_OCN") - + # These will be handeled by MOM and CAM, included here for backward compatibility. atm_dycore = case.get_value("CAM_DYCORE") - if ocn_model == "mom" or (atm_dycore and atm_dycore == "fv3"): + if ocn_model == "mom" or (atm_dycore and atm_dycore == "fv3") and "FMS" not in libs: libs.append("FMS") return libs From 60a8e23437602cf89bb2abd88f16027f01fc6634 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Thu, 28 Aug 2025 07:57:53 -0600 Subject: [PATCH 067/123] reponse to copilot review --- cime_config/buildnml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cime_config/buildnml b/cime_config/buildnml index c1c8573c7..692e30e54 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -643,9 +643,9 @@ def cmeps_lib_list(case): libs.insert(0, mpilib) ocn_model = case.get_value("COMP_OCN") - # These will be handeled by MOM and CAM, included here for backward compatibility. + # These will be handled by MOM and CAM, included here for backward compatibility. atm_dycore = case.get_value("CAM_DYCORE") - if ocn_model == "mom" or (atm_dycore and atm_dycore == "fv3") and "FMS" not in libs: + if (ocn_model == "mom" or (atm_dycore and atm_dycore == "fv3")) and "FMS" not in libs: libs.append("FMS") return libs From 10bceb1c236150b8614fa722502408a933df8469 Mon Sep 17 00:00:00 2001 From: Jiang Zhu Date: Fri, 29 Aug 2025 08:46:00 -0600 Subject: [PATCH 068/123] Make qsat calculation consistent with CAM --- cesm/flux_atmocn/shr_flux_mod.F90 | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/cesm/flux_atmocn/shr_flux_mod.F90 b/cesm/flux_atmocn/shr_flux_mod.F90 index c40c4d732..d0621c94d 100644 --- a/cesm/flux_atmocn/shr_flux_mod.F90 +++ b/cesm/flux_atmocn/shr_flux_mod.F90 @@ -9,6 +9,7 @@ module shr_flux_mod use shr_const_mod, only : shr_const_latvap, shr_const_latice, shr_const_stebol, shr_const_tkfrz, shr_const_pi, shr_const_spval use shr_const_mod, only : shr_const_ocn_ref_sal, shr_const_zsrflyr, shr_const_rgas use shr_sys_mod, only : shr_sys_abort ! shared system routines + use shr_wv_sat_mod, only: shr_wv_sat_qsat_liquid ! use saturation calculation consistent with CAM implicit none private ! default private @@ -270,8 +271,6 @@ SUBROUTINE flux_atmOcn(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & real(R8) :: ugust ! function: gustiness as a function of convective rainfall. real(R8) :: gprec ! convective rainfall argument for ugust - qsat(Tk) = 640380.0_R8 / exp(5107.4_R8/Tk) - ! Large and Yeager 2009 cdn(Umps) = 0.0027_R8 / min(33.0000_R8,Umps) + 0.000142_R8 + & 0.0000764_R8 * min(33.0000_R8,Umps) - 3.14807e-13_r8 * min(33.0000_R8,Umps)**6 @@ -369,7 +368,8 @@ SUBROUTINE flux_atmOcn(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & endif endif - ssq = 0.98_R8 * qsat(ts(n)) / rbot(n) ! sea surf hum (kg/kg) + call shr_wv_sat_qsat_liquid(ts(n), pslv(n), qsat, ssq) + ssq = 0.98_R8 * ssq ! sea surf hum (kg/kg) delt = thbot(n) - ts(n) ! pot temp diff (K) delq = qbot(n) - ssq ! spec hum dif (kg/kg) alz = log(zbot(n)/zref) @@ -526,7 +526,8 @@ SUBROUTINE flux_atmOcn(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & vmag=vmag*vscl endif endif - ssq = 0.98_R8 * qsat(ts(n)) / rbot(n) ! sea surf hum (kg/kg) + call shr_wv_sat_qsat_liquid(ts(n), pslv(n), qsat, ssq) + ssq = 0.98_R8 * ssq ! sea surf hum (kg/kg) call cor30a(ubot(n),vbot(n),tbot(n),qbot(n),rbot(n) & ! in atm params & ,us(n),vs(n),ts(n),ssq & ! in surf params @@ -1413,7 +1414,6 @@ SUBROUTINE flux_atmOcn_diurnal & real(R8) :: tdiff(nMax) ! tbot - ts real(R8) :: vscl - qsat(Tk) = 640380.0_R8 / exp(5107.4_R8/Tk) cdn(Umps) = 0.0027_R8 / Umps + 0.000142_R8 + 0.0000764_R8 * Umps psimhu(xd) = log((1.0_R8+xd*(2.0_R8+xd))*(1.0_R8+xd*xd)/8.0_R8) - 2.0_R8*atan(xd) + 1.571_R8 psixhu(xd) = 2.0_R8 * log((1.0_R8 + xd*xd)/2.0_R8) @@ -1553,7 +1553,8 @@ SUBROUTINE flux_atmOcn_diurnal & speed(n) = 0.0_R8 endif - ssq = 0.98_R8 * qsat(tBulk(n)) / rbot(n) ! sea surf hum (kg/kg) + call shr_wv_sat_qsat_liquid(tBulk(n), pslv(n), qsat, ssq) + ssq = 0.98_R8 * ssq ! sea surf hum (kg/kg) delt = thbot(n) - tBulk(n) ! pot temp diff (K) delq = qbot(n) - ssq ! spec hum dif (kg/kg) cp = shr_const_cpdair*(1.0_R8 + shr_const_cpvir*ssq) @@ -1696,7 +1697,8 @@ SUBROUTINE flux_atmOcn_diurnal & !--need to update ssq,delt,delq as function of tBulk ---- - ssq = 0.98_R8 * qsat(tBulk(n)) / rbot(n) ! sea surf hum (kg/kg) + call shr_wv_sat_qsat_liquid(tBulk(n), pslv(n), qsat, ssq) + ssq = 0.98_R8 * ssq ! sea surf hum (kg/kg) delt = thbot(n) - tBulk(n) ! pot temp diff (K) delq = qbot(n) - ssq ! spec hum dif (kg/kg) From 6d83bcc7f3c190b2d33e508dba95ee5b249dac81 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 29 Aug 2025 09:20:44 -0600 Subject: [PATCH 069/123] add artifact to github testing --- .github/workflows/srt.yml | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 31ee1d131..2ac195b3e 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -171,8 +171,19 @@ jobs: - name: scripts regression tests run: | pushd $GITHUB_WORKSPACE/cesm/cime/CIME/tests - ./scripts_regression_tests.py --no-fortran-run --compiler gnu --mpilib openmpi --machine ubuntu-latest + ./scripts_regression_tests.py --no-fortran-run --compiler gnu --mpilib openmpi --machine ubuntu-latest --no-teardown popd + + # How to download artifacts: + # https://docs.github.com/en/actions/managing-workflow-runs/downloading-workflow-artifacts + + - name: Upload test logs + if: ${{ failure() }} + uses: actions/upload-artifact@v4 + with: + name: test-logs-${{ matrix.python-version }} + path: test-logs-${{ matrix.python-version }}.tar.gz + retention-days: 4 # the following can be used by developers to login to the github server in case of errors # see https://github.com/marketplace/actions/debugging-with-tmate for further details # - name: Setup tmate session From f9e9dc111767db4e1c006f51385b3a85b055d2ff Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 29 Aug 2025 09:31:28 -0600 Subject: [PATCH 070/123] correct path to artifacts --- .github/workflows/srt.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 2ac195b3e..865cde039 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -182,7 +182,7 @@ jobs: uses: actions/upload-artifact@v4 with: name: test-logs-${{ matrix.python-version }} - path: test-logs-${{ matrix.python-version }}.tar.gz + path: $GITHUB_WORKSPACE/cesm/cime/CIME/tests retention-days: 4 # the following can be used by developers to login to the github server in case of errors # see https://github.com/marketplace/actions/debugging-with-tmate for further details From 1ccf4fac0fd6734b000226443c7b66af313b635a Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 29 Aug 2025 09:41:12 -0600 Subject: [PATCH 071/123] correct path to artifacts --- .github/workflows/srt.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 865cde039..7ff3bc2fe 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -182,7 +182,7 @@ jobs: uses: actions/upload-artifact@v4 with: name: test-logs-${{ matrix.python-version }} - path: $GITHUB_WORKSPACE/cesm/cime/CIME/tests + path: $HOME/cesm/scratch retention-days: 4 # the following can be used by developers to login to the github server in case of errors # see https://github.com/marketplace/actions/debugging-with-tmate for further details From 2118e8b0850dada1506da9d7cc1e431af522c5c3 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 29 Aug 2025 10:03:03 -0600 Subject: [PATCH 072/123] correct path to artifacts --- .github/workflows/srt.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 7ff3bc2fe..3aa45aaf1 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -182,7 +182,7 @@ jobs: uses: actions/upload-artifact@v4 with: name: test-logs-${{ matrix.python-version }} - path: $HOME/cesm/scratch + path: /home/runner/cesm/scratch retention-days: 4 # the following can be used by developers to login to the github server in case of errors # see https://github.com/marketplace/actions/debugging-with-tmate for further details From fac1d081615f723435355be7664a115bbd85a2f0 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 29 Aug 2025 10:39:48 -0600 Subject: [PATCH 073/123] correct path to artifacts --- .github/workflows/srt.yml | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 3aa45aaf1..b33da405d 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -179,10 +179,13 @@ jobs: - name: Upload test logs if: ${{ failure() }} + steps: + - name: Tar test logs + run: tar zcf scratch-${{ matrix.python-version }}.tar.gz /home/runner/cesm/scratch uses: actions/upload-artifact@v4 with: name: test-logs-${{ matrix.python-version }} - path: /home/runner/cesm/scratch + path: scratch-${{ matric.python-version }}.tar.gz retention-days: 4 # the following can be used by developers to login to the github server in case of errors # see https://github.com/marketplace/actions/debugging-with-tmate for further details From 90e73f59baeb9ab7d4c08125dec17ec964fa8f47 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 29 Aug 2025 10:44:21 -0600 Subject: [PATCH 074/123] correct path to artifacts --- .github/workflows/srt.yml | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index b33da405d..2f11e0e43 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -182,11 +182,12 @@ jobs: steps: - name: Tar test logs run: tar zcf scratch-${{ matrix.python-version }}.tar.gz /home/runner/cesm/scratch - uses: actions/upload-artifact@v4 - with: - name: test-logs-${{ matrix.python-version }} - path: scratch-${{ matric.python-version }}.tar.gz - retention-days: 4 + - name: save artifact + uses: actions/upload-artifact@v4 + with: + name: test-logs-${{ matrix.python-version }} + path: scratch-${{ matrix.python-version }}.tar.gz + retention-days: 4 # the following can be used by developers to login to the github server in case of errors # see https://github.com/marketplace/actions/debugging-with-tmate for further details # - name: Setup tmate session From fd90f95a0b6f4af743e2e926b979d41d7f243d84 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 29 Aug 2025 10:46:24 -0600 Subject: [PATCH 075/123] correct path to artifacts --- .github/workflows/srt.yml | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 2f11e0e43..72a742235 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -180,14 +180,14 @@ jobs: - name: Upload test logs if: ${{ failure() }} steps: - - name: Tar test logs - run: tar zcf scratch-${{ matrix.python-version }}.tar.gz /home/runner/cesm/scratch - - name: save artifact - uses: actions/upload-artifact@v4 - with: - name: test-logs-${{ matrix.python-version }} - path: scratch-${{ matrix.python-version }}.tar.gz - retention-days: 4 + - name: Tar test logs + run: tar zcf scratch-${{ matrix.python-version }}.tar.gz /home/runner/cesm/scratch + - name: save artifact + uses: actions/upload-artifact@v4 + with: + name: test-logs-${{ matrix.python-version }} + path: scratch-${{ matrix.python-version }}.tar.gz + retention-days: 4 # the following can be used by developers to login to the github server in case of errors # see https://github.com/marketplace/actions/debugging-with-tmate for further details # - name: Setup tmate session From 926f244d11e477ac578d488f886c4dd74c3ff989 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 29 Aug 2025 10:49:36 -0600 Subject: [PATCH 076/123] correct path to artifacts --- .github/workflows/srt.yml | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 72a742235..dc2a51c89 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -177,19 +177,19 @@ jobs: # How to download artifacts: # https://docs.github.com/en/actions/managing-workflow-runs/downloading-workflow-artifacts - - name: Upload test logs - if: ${{ failure() }} - steps: - - name: Tar test logs - run: tar zcf scratch-${{ matrix.python-version }}.tar.gz /home/runner/cesm/scratch - - name: save artifact - uses: actions/upload-artifact@v4 - with: - name: test-logs-${{ matrix.python-version }} - path: scratch-${{ matrix.python-version }}.tar.gz - retention-days: 4 +# - name: Upload test logs +# if: ${{ failure() }} +# steps: +# - name: Tar test logs +# run: tar zcf scratch-${{ matrix.python-version }}.tar.gz /home/runner/cesm/scratch +# - name: save artifact +# uses: actions/upload-artifact@v4 +# with: +# name: test-logs-${{ matrix.python-version }} +# path: scratch-${{ matrix.python-version }}.tar.gz +# retention-days: 4 # the following can be used by developers to login to the github server in case of errors # see https://github.com/marketplace/actions/debugging-with-tmate for further details -# - name: Setup tmate session -# if: ${{ failure() }} -# uses: mxschmitt/action-tmate@v3 + - name: Setup tmate session + if: ${{ failure() }} + uses: mxschmitt/action-tmate@v3 From 2f469b073f7133fa467785a38ee208fd67363cf7 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 29 Aug 2025 11:30:07 -0600 Subject: [PATCH 077/123] remove share calculation from unused diurnal subroutine --- .github/workflows/srt.yml | 6 +++--- cesm/flux_atmocn/shr_flux_mod.F90 | 16 ++++++++++------ 2 files changed, 13 insertions(+), 9 deletions(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index dc2a51c89..249ab9c26 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -190,6 +190,6 @@ jobs: # retention-days: 4 # the following can be used by developers to login to the github server in case of errors # see https://github.com/marketplace/actions/debugging-with-tmate for further details - - name: Setup tmate session - if: ${{ failure() }} - uses: mxschmitt/action-tmate@v3 +# - name: Setup tmate session +# if: ${{ failure() }} +# uses: mxschmitt/action-tmate@v3 diff --git a/cesm/flux_atmocn/shr_flux_mod.F90 b/cesm/flux_atmocn/shr_flux_mod.F90 index d0621c94d..18d6feb2c 100644 --- a/cesm/flux_atmocn/shr_flux_mod.F90 +++ b/cesm/flux_atmocn/shr_flux_mod.F90 @@ -1414,6 +1414,8 @@ SUBROUTINE flux_atmOcn_diurnal & real(R8) :: tdiff(nMax) ! tbot - ts real(R8) :: vscl + ! note: this should use the shr_wv_sat_qsat_liquid as above if this routine is ever used in production + qsat(Tk) = 640380.0_R8 / exp(5107.4_R8/Tk) cdn(Umps) = 0.0027_R8 / Umps + 0.000142_R8 + 0.0000764_R8 * Umps psimhu(xd) = log((1.0_R8+xd*(2.0_R8+xd))*(1.0_R8+xd*xd)/8.0_R8) - 2.0_R8*atan(xd) + 1.571_R8 psixhu(xd) = 2.0_R8 * log((1.0_R8 + xd*xd)/2.0_R8) @@ -1552,9 +1554,10 @@ SUBROUTINE flux_atmOcn_diurnal & salt(n) = 0.0_R8 speed(n) = 0.0_R8 endif - - call shr_wv_sat_qsat_liquid(tBulk(n), pslv(n), qsat, ssq) - ssq = 0.98_R8 * ssq ! sea surf hum (kg/kg) +! This should be changed to use the subroutine below + ssq = 0.98_R8 * qsat(tBulk(n)) / rbot(n) ! sea surf hum (kg/kg) +! call shr_wv_sat_qsat_liquid(tBulk(n), pslv(n), qsat, ssq) +! ssq = 0.98_R8 * ssq ! sea surf hum (kg/kg) delt = thbot(n) - tBulk(n) ! pot temp diff (K) delq = qbot(n) - ssq ! spec hum dif (kg/kg) cp = shr_const_cpdair*(1.0_R8 + shr_const_cpvir*ssq) @@ -1696,9 +1699,10 @@ SUBROUTINE flux_atmOcn_diurnal & tSkin(n) = tBulk(n) + cskin(n) !--need to update ssq,delt,delq as function of tBulk ---- - - call shr_wv_sat_qsat_liquid(tBulk(n), pslv(n), qsat, ssq) - ssq = 0.98_R8 * ssq ! sea surf hum (kg/kg) + ! qsat should be calculated in share code + ssq = 0.98_R8 * qsat(tBulk(n)) / rbot(n) +! call shr_wv_sat_qsat_liquid(tBulk(n), pslv(n), qsat, ssq) +! ssq = 0.98_R8 * ssq ! sea surf hum (kg/kg) delt = thbot(n) - tBulk(n) ! pot temp diff (K) delq = qbot(n) - ssq ! spec hum dif (kg/kg) From 80ed8c895366c8fc725ea48f12205662baf0339d Mon Sep 17 00:00:00 2001 From: Chris Fischer Date: Wed, 3 Sep 2025 13:14:08 -0600 Subject: [PATCH 078/123] Fix mpi-serial restart tests. --- cime_config/buildnml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/buildnml b/cime_config/buildnml index 0d81892ff..1f0f4043b 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -640,7 +640,7 @@ def cmeps_lib_list(case): libs = case.get_values("CASE_SUPPORT_LIBRARIES") mpilib = case.get_value("MPILIB") - if mpilib == "mpi-serial": + if mpilib == "mpi-serial" and "mpi-serial" not in libs: libs.insert(0, mpilib) ocn_model = case.get_value("COMP_OCN") From 99156eabb7e1fb9e32cef543b43e9fb949402c0c Mon Sep 17 00:00:00 2001 From: Jian Sun Date: Fri, 5 Sep 2025 12:53:16 -0600 Subject: [PATCH 079/123] update AMD GPUs on Casper --- cime_config/config_component.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index e2023a1a8..22925f3db 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -818,7 +818,7 @@ char none,a100 none,a10,a2 - none,v100,a100,h100 + none,v100,a100,h100,mi300a none build_def env_build.xml From ef94e201eb4a88fea33530ae391812769416c3cd Mon Sep 17 00:00:00 2001 From: Chris Fischer Date: Mon, 8 Sep 2025 12:01:26 -0600 Subject: [PATCH 080/123] Rename B compsets. --- cime_config/testdefs/testlist_drv.xml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/cime_config/testdefs/testlist_drv.xml b/cime_config/testdefs/testlist_drv.xml index fd1ad7ac6..fa14f1355 100644 --- a/cime_config/testdefs/testlist_drv.xml +++ b/cime_config/testdefs/testlist_drv.xml @@ -46,7 +46,7 @@ - + @@ -55,7 +55,7 @@ - + @@ -292,7 +292,7 @@ - + From 7a24e2cdcabdbac05307278cf89b45acb99bd3cc Mon Sep 17 00:00:00 2001 From: Chris Fischer Date: Mon, 8 Sep 2025 12:20:03 -0600 Subject: [PATCH 081/123] Change so to t4s chemistry --- cime_config/testdefs/testlist_drv.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/testdefs/testlist_drv.xml b/cime_config/testdefs/testlist_drv.xml index fa14f1355..b57b7ba12 100644 --- a/cime_config/testdefs/testlist_drv.xml +++ b/cime_config/testdefs/testlist_drv.xml @@ -46,7 +46,7 @@ - + From 1f93647d8778530f1dd229e50881eead2b70c70b Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Sat, 27 Sep 2025 11:11:50 -0600 Subject: [PATCH 082/123] changes to gust factor --- cesm/flux_atmocn/shr_flux_mod.F90 | 56 +++++++----- cime_config/namelist_definition_drv.xml | 112 +++++++++++++++++++----- 2 files changed, 122 insertions(+), 46 deletions(-) diff --git a/cesm/flux_atmocn/shr_flux_mod.F90 b/cesm/flux_atmocn/shr_flux_mod.F90 index 18d6feb2c..e53500bec 100644 --- a/cesm/flux_atmocn/shr_flux_mod.F90 +++ b/cesm/flux_atmocn/shr_flux_mod.F90 @@ -9,7 +9,6 @@ module shr_flux_mod use shr_const_mod, only : shr_const_latvap, shr_const_latice, shr_const_stebol, shr_const_tkfrz, shr_const_pi, shr_const_spval use shr_const_mod, only : shr_const_ocn_ref_sal, shr_const_zsrflyr, shr_const_rgas use shr_sys_mod, only : shr_sys_abort ! shared system routines - use shr_wv_sat_mod, only: shr_wv_sat_qsat_liquid ! use saturation calculation consistent with CAM implicit none private ! default private @@ -143,10 +142,10 @@ SUBROUTINE flux_atmOcn(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & & evap ,evap_16O, evap_HDO, evap_18O, & & taux ,tauy ,tref ,qref , & & ocn_surface_flux_scheme, & - & add_gusts, & - & duu10n, & + & add_gusts, & + & duu10n, & & ugust_out, & - & u10res, & + & u10res, & & ustar_sv ,re_sv ,ssq_sv, & & missval) @@ -268,9 +267,11 @@ SUBROUTINE flux_atmOcn(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & real(R8) :: tdiff(nMax) ! tbot - ts real(R8) :: vscl - real(R8) :: ugust ! function: gustiness as a function of convective rainfall. + real(R8) :: ugust ! function: gustiness as a function of convective rainfall. real(R8) :: gprec ! convective rainfall argument for ugust + qsat(Tk) = 640380.0_R8 / exp(5107.4_R8/Tk) + ! Large and Yeager 2009 cdn(Umps) = 0.0027_R8 / min(33.0000_R8,Umps) + 0.000142_R8 + & 0.0000764_R8 * min(33.0000_R8,Umps) - 3.14807e-13_r8 * min(33.0000_R8,Umps)**6 @@ -345,10 +346,10 @@ SUBROUTINE flux_atmOcn(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & if (mask(n) /= 0) then !--- compute some needed quantities --- - if (add_gusts) then + if (add_gusts) then vmag = max(seq_flux_atmocn_minwind, sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2 + (1.0_R8*ugust(min(rainc(n),6.94444e-4_r8))**2)) ) ugust_out(n) = ugust(min(rainc(n),6.94444e-4_r8)) - else + else vmag = max(seq_flux_atmocn_minwind, sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2) ) ugust_out(n) = 0.0_r8 end if @@ -368,8 +369,7 @@ SUBROUTINE flux_atmOcn(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & endif endif - call shr_wv_sat_qsat_liquid(ts(n), pslv(n), qsat, ssq) - ssq = 0.98_R8 * ssq ! sea surf hum (kg/kg) + ssq = 0.98_R8 * qsat(ts(n)) / rbot(n) ! sea surf hum (kg/kg) delt = thbot(n) - ts(n) ! pot temp diff (K) delq = qbot(n) - ssq ! spec hum dif (kg/kg) alz = log(zbot(n)/zref) @@ -496,7 +496,7 @@ SUBROUTINE flux_atmOcn(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & qref (n) = spval ! 2m reference height humidity (kg/kg) duu10n(n) = spval ! 10m wind speed squared (m/s)^2 ugust_out(n) = spval ! gustiness addition (m/s) - u10res(n) = spval ! 10m resolved wind (no gusts) (m/s) + u10res(n) = spval ! 10m resolved wind (no gusts) (m/s) if (present(ustar_sv)) ustar_sv(n) = spval if (present(re_sv )) re_sv (n) = spval @@ -526,8 +526,7 @@ SUBROUTINE flux_atmOcn(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & vmag=vmag*vscl endif endif - call shr_wv_sat_qsat_liquid(ts(n), pslv(n), qsat, ssq) - ssq = 0.98_R8 * ssq ! sea surf hum (kg/kg) + ssq = 0.98_R8 * qsat(ts(n)) / rbot(n) ! sea surf hum (kg/kg) call cor30a(ubot(n),vbot(n),tbot(n),qbot(n),rbot(n) & ! in atm params & ,us(n),vs(n),ts(n),ssq & ! in surf params @@ -577,6 +576,9 @@ SUBROUTINE flux_atmOcn(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & if (present(re_sv )) re_sv(n) = re if (present(ssq_sv )) ssq_sv(n) = ssq + u10res(n) = sqrt(duu10n(n)) + ugust_out(n) = 0._r8 + else !------------------------------------------------------------ ! no valid data here -- out of domain @@ -594,6 +596,9 @@ SUBROUTINE flux_atmOcn(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & qref (n) = spval ! 2m reference height humidity (kg/kg) duu10n (n) = spval ! 10m wind speed squared (m/s)^2 + u10res (n) = spval + ugust_out(n) = spval + if (present(ustar_sv)) ustar_sv(n) = spval if (present(re_sv )) re_sv (n) = spval if (present(ssq_sv )) ssq_sv (n) = spval @@ -612,7 +617,15 @@ SUBROUTINE flux_atmOcn(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & taux, tauy, tref, qref, & duu10n, ustar_sv, re_sv, ssq_sv, & missval) - + do n=1,nMax + if (mask(n) /= 0) then + u10res(n) = sqrt(duu10n(n)) + ugust_out(n) = 0._r8 + else + u10res (n) = spval + ugust_out(n) = spval + end if + end do else call shr_sys_abort(subName//" subroutine flux_atmOcn requires ocn_surface_flux_scheme = 0, 1 or 2") @@ -1052,7 +1065,6 @@ SUBROUTINE flux_atmOcn_UA(logunit, & if (present(ssq_sv )) ssq_sv(n) = ssq if (present(re_sv )) re_sv(n) = re - else !------------------------------------------------------------ @@ -1070,6 +1082,7 @@ SUBROUTINE flux_atmOcn_UA(logunit, & tref (n) = spval ! 2m reference height temperature (K) qref (n) = spval ! 2m reference height humidity (kg/kg) duu10n(n) = spval ! 10m wind speed squared (m/s)^2 + ! Optional diagnostics too: if (present(ustar_sv)) ustar_sv(n) = spval if (present(re_sv )) re_sv (n) = spval @@ -1414,8 +1427,7 @@ SUBROUTINE flux_atmOcn_diurnal & real(R8) :: tdiff(nMax) ! tbot - ts real(R8) :: vscl - ! note: this should use the shr_wv_sat_qsat_liquid as above if this routine is ever used in production - qsat(Tk) = 640380.0_R8 / exp(5107.4_R8/Tk) + qsat(Tk) = 640380.0_R8 / exp(5107.4_R8/Tk) cdn(Umps) = 0.0027_R8 / Umps + 0.000142_R8 + 0.0000764_R8 * Umps psimhu(xd) = log((1.0_R8+xd*(2.0_R8+xd))*(1.0_R8+xd*xd)/8.0_R8) - 2.0_R8*atan(xd) + 1.571_R8 psixhu(xd) = 2.0_R8 * log((1.0_R8 + xd*xd)/2.0_R8) @@ -1554,10 +1566,8 @@ SUBROUTINE flux_atmOcn_diurnal & salt(n) = 0.0_R8 speed(n) = 0.0_R8 endif -! This should be changed to use the subroutine below - ssq = 0.98_R8 * qsat(tBulk(n)) / rbot(n) ! sea surf hum (kg/kg) -! call shr_wv_sat_qsat_liquid(tBulk(n), pslv(n), qsat, ssq) -! ssq = 0.98_R8 * ssq ! sea surf hum (kg/kg) + + ssq = 0.98_R8 * qsat(tBulk(n)) / rbot(n) ! sea surf hum (kg/kg) delt = thbot(n) - tBulk(n) ! pot temp diff (K) delq = qbot(n) - ssq ! spec hum dif (kg/kg) cp = shr_const_cpdair*(1.0_R8 + shr_const_cpvir*ssq) @@ -1699,10 +1709,8 @@ SUBROUTINE flux_atmOcn_diurnal & tSkin(n) = tBulk(n) + cskin(n) !--need to update ssq,delt,delq as function of tBulk ---- - ! qsat should be calculated in share code - ssq = 0.98_R8 * qsat(tBulk(n)) / rbot(n) -! call shr_wv_sat_qsat_liquid(tBulk(n), pslv(n), qsat, ssq) -! ssq = 0.98_R8 * ssq ! sea surf hum (kg/kg) + + ssq = 0.98_R8 * qsat(tBulk(n)) / rbot(n) ! sea surf hum (kg/kg) delt = thbot(n) - tBulk(n) ! pot temp diff (K) delq = qbot(n) - ssq ! spec hum dif (kg/kg) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index d67b84cdc..b980a2f47 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -431,7 +431,7 @@ if true, mediator is present in run - + char expdef ALLCOMP_attributes @@ -439,7 +439,7 @@ Model version - $MODEL_VERSION + unknown @@ -606,7 +606,8 @@ .true. if ocean sends fields at multiple ocean levels to the land-ice component - .false. + .false. + .true. @@ -931,24 +932,13 @@ 0 - - real - control - MED_attributes - - wind gustiness factor - - - 0.0D0 - - - logical control MED_attributes - add a wind gustiness factor + Add a wind gustiness factor. This should be false for + ocn_surface_flux_scheme settings of 1 or 2. .true. @@ -1787,6 +1777,71 @@ + + + logical + aux_hist + MED_attributes + Auxiliary mediator l2x fields every lnd coupling interval + + .false. + + + + char + aux_hist + MED_attributes + Auxiliary mediator lnd2med output every lnd coupling interval + + 'Flrl_rofsur:Flrl_rofi:Flrl_rofgwl:Flrl_rofsub' + + + + char + aux_hist + MED_attributes + history option type + + ndays + + + + integer + aux_hist + MED_attributes + history option type + + 1 + + + + logical + aux_hist + MED_attributes + If true, use time average for aux file output. + + .true. + + + + integer + aux_hist + MED_attributes + Number of time samples per file. + + 365 + + + + char + aux_hist + MED_attributes + Auxiliary name identifier in history name + + lnd2rof.24hr.avg + + + @@ -1794,9 +1849,10 @@ logical aux_hist ALLCOMP_attributes - Turns on history stream for annual lnd to mediator glc forcing fields + Auxiliary mediator lnd2med fields every year - .false. + .true. + .false. @@ -2318,7 +2374,7 @@ $WAV2OCN_SMAPNAME - + @@ -2872,7 +2928,6 @@ .false. .false. .false. - .false. @@ -3727,7 +3782,7 @@ components that need to look at the same data. - Buildconf/camconf/drv_flds_in,Buildconf/clmconf/drv_flds_in,Buildconf/datmconf/drv_flds_in + Buildconf/camconf/drv_flds_in,Buildconf/clmconf/drv_flds_in,Buildconf/datmconf/drv_flds_in,Buildconf/dlndconf/drv_flds_in @@ -3836,7 +3891,8 @@ .false. - .true. + + @@ -3924,6 +3980,18 @@ $ICE_DOMAIN_MESH + + real + mapping + ICE_attributes + + Maximum allowed mesh error + + + 0.1 + 0.15 + + From 579b4339af3072bdac3c900bcf65ffe04ff0eaba Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Sat, 27 Sep 2025 11:18:28 -0600 Subject: [PATCH 083/123] replace qsat calculation --- cesm/flux_atmocn/shr_flux_mod.F90 | 20 +++++++++++++++----- 1 file changed, 15 insertions(+), 5 deletions(-) diff --git a/cesm/flux_atmocn/shr_flux_mod.F90 b/cesm/flux_atmocn/shr_flux_mod.F90 index e53500bec..d7bec1709 100644 --- a/cesm/flux_atmocn/shr_flux_mod.F90 +++ b/cesm/flux_atmocn/shr_flux_mod.F90 @@ -9,6 +9,7 @@ module shr_flux_mod use shr_const_mod, only : shr_const_latvap, shr_const_latice, shr_const_stebol, shr_const_tkfrz, shr_const_pi, shr_const_spval use shr_const_mod, only : shr_const_ocn_ref_sal, shr_const_zsrflyr, shr_const_rgas use shr_sys_mod, only : shr_sys_abort ! shared system routines + use shr_wv_sat_mod, only: shr_wv_sat_qsat_liquid ! use saturation calculation consistent with CAM implicit none private ! default private @@ -368,8 +369,8 @@ SUBROUTINE flux_atmOcn(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & wind0=wind0*vscl endif endif - - ssq = 0.98_R8 * qsat(ts(n)) / rbot(n) ! sea surf hum (kg/kg) + call shr_wv_sat_qsat_liquid(ts(n), pslv(n), qsat, ssq) + ssq = 0.98_R8 * ssq ! sea surf hum (kg/kg) delt = thbot(n) - ts(n) ! pot temp diff (K) delq = qbot(n) - ssq ! spec hum dif (kg/kg) alz = log(zbot(n)/zref) @@ -526,7 +527,8 @@ SUBROUTINE flux_atmOcn(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & vmag=vmag*vscl endif endif - ssq = 0.98_R8 * qsat(ts(n)) / rbot(n) ! sea surf hum (kg/kg) + call shr_wv_sat_qsat_liquid(ts(n), pslv(n), qsat, ssq) + ssq = 0.98_R8 * ssq ! sea surf hum (kg/kg) call cor30a(ubot(n),vbot(n),tbot(n),qbot(n),rbot(n) & ! in atm params & ,us(n),vs(n),ts(n),ssq & ! in surf params @@ -1427,6 +1429,7 @@ SUBROUTINE flux_atmOcn_diurnal & real(R8) :: tdiff(nMax) ! tbot - ts real(R8) :: vscl + ! note: this should use the shr_wv_sat_qsat_liquid as above if this routine is ever used in production qsat(Tk) = 640380.0_R8 / exp(5107.4_R8/Tk) cdn(Umps) = 0.0027_R8 / Umps + 0.000142_R8 + 0.0000764_R8 * Umps psimhu(xd) = log((1.0_R8+xd*(2.0_R8+xd))*(1.0_R8+xd*xd)/8.0_R8) - 2.0_R8*atan(xd) + 1.571_R8 @@ -1566,8 +1569,11 @@ SUBROUTINE flux_atmOcn_diurnal & salt(n) = 0.0_R8 speed(n) = 0.0_R8 endif + ! This should be changed to use the subroutine below + ssq = 0.98_R8 * qsat(tBulk(n)) / rbot(n) ! sea surf hum (kg/kg) + ! call shr_wv_sat_qsat_liquid(tBulk(n), pslv(n), qsat, ssq) + ! ssq = 0.98_R8 * ssq ! sea surf hum (kg/kg) - ssq = 0.98_R8 * qsat(tBulk(n)) / rbot(n) ! sea surf hum (kg/kg) delt = thbot(n) - tBulk(n) ! pot temp diff (K) delq = qbot(n) - ssq ! spec hum dif (kg/kg) cp = shr_const_cpdair*(1.0_R8 + shr_const_cpvir*ssq) @@ -1710,7 +1716,11 @@ SUBROUTINE flux_atmOcn_diurnal & !--need to update ssq,delt,delq as function of tBulk ---- - ssq = 0.98_R8 * qsat(tBulk(n)) / rbot(n) ! sea surf hum (kg/kg) + ! This should be changed to use the subroutine below + ssq = 0.98_R8 * qsat(tBulk(n)) / rbot(n) ! sea surf hum (kg/kg) + ! call shr_wv_sat_qsat_liquid(tBulk(n), pslv(n), qsat, ssq) + ! ssq = 0.98_R8 * ssq ! sea surf hum (kg/kg) + delt = thbot(n) - tBulk(n) ! pot temp diff (K) delq = qbot(n) - ssq ! spec hum dif (kg/kg) From 1778ed0eb5559446857d7df1ed4dbeb41cb49608 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Sat, 27 Sep 2025 11:27:14 -0600 Subject: [PATCH 084/123] fix merge errors --- cesm/flux_atmocn/shr_flux_mod.F90 | 2 -- cime_config/namelist_definition_drv.xml | 22 ++++------------------ 2 files changed, 4 insertions(+), 20 deletions(-) diff --git a/cesm/flux_atmocn/shr_flux_mod.F90 b/cesm/flux_atmocn/shr_flux_mod.F90 index d7bec1709..537beaf4c 100644 --- a/cesm/flux_atmocn/shr_flux_mod.F90 +++ b/cesm/flux_atmocn/shr_flux_mod.F90 @@ -271,8 +271,6 @@ SUBROUTINE flux_atmOcn(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & real(R8) :: ugust ! function: gustiness as a function of convective rainfall. real(R8) :: gprec ! convective rainfall argument for ugust - qsat(Tk) = 640380.0_R8 / exp(5107.4_R8/Tk) - ! Large and Yeager 2009 cdn(Umps) = 0.0027_R8 / min(33.0000_R8,Umps) + 0.000142_R8 + & 0.0000764_R8 * min(33.0000_R8,Umps) - 3.14807e-13_r8 * min(33.0000_R8,Umps)**6 diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index b980a2f47..40a4ffec1 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -431,7 +431,7 @@ if true, mediator is present in run - + char expdef ALLCOMP_attributes @@ -439,7 +439,7 @@ Model version - unknown + $MODEL_VERSION @@ -606,8 +606,7 @@ .true. if ocean sends fields at multiple ocean levels to the land-ice component - .false. - .true. + .false. @@ -3891,8 +3890,7 @@ .false. - - + .true. @@ -3980,18 +3978,6 @@ $ICE_DOMAIN_MESH - - real - mapping - ICE_attributes - - Maximum allowed mesh error - - - 0.1 - 0.15 - - From e7f5cdfdd8c811ca35904545dcc307d0c7caba36 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Sat, 27 Sep 2025 19:06:43 -0400 Subject: [PATCH 085/123] Update namelist_definition_drv.xml --- cime_config/namelist_definition_drv.xml | 66 +------------------------ 1 file changed, 1 insertion(+), 65 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 40a4ffec1..6fd289300 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -1776,71 +1776,7 @@ - - - logical - aux_hist - MED_attributes - Auxiliary mediator l2x fields every lnd coupling interval - - .false. - - - - char - aux_hist - MED_attributes - Auxiliary mediator lnd2med output every lnd coupling interval - - 'Flrl_rofsur:Flrl_rofi:Flrl_rofgwl:Flrl_rofsub' - - - - char - aux_hist - MED_attributes - history option type - - ndays - - - - integer - aux_hist - MED_attributes - history option type - - 1 - - - - logical - aux_hist - MED_attributes - If true, use time average for aux file output. - - .true. - - - - integer - aux_hist - MED_attributes - Number of time samples per file. - - 365 - - - - char - aux_hist - MED_attributes - Auxiliary name identifier in history name - - lnd2rof.24hr.avg - - - + From 13457345a71ce61c242799b99df49461e18bd3ee Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Mon, 29 Sep 2025 06:12:34 -0600 Subject: [PATCH 086/123] remove unintended change --- cime_config/namelist_definition_drv.xml | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 6fd289300..06e9a08e0 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -1786,8 +1786,7 @@ ALLCOMP_attributes Auxiliary mediator lnd2med fields every year - .true. - .false. + .false. From 08fee479e30b89102032495cca414e18073e54b5 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 26 Sep 2025 17:39:50 +0200 Subject: [PATCH 087/123] change of CPL_ALBAV for MOM6, removal of POP variables (including CPL_EPBAL) and removal of pause/resume settings and other removal of variables that are not used by CESM --- cime_config/config_component.xml | 88 +-------------------------- cime_config/config_component_cesm.xml | 54 ++-------------- 2 files changed, 8 insertions(+), 134 deletions(-) diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index 22925f3db..dc2318bef 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -413,65 +413,6 @@ - - char - none,never,nsteps,nseconds,nminutes,nhours,ndays,nmonths,nyears - never - run_begin_stop_restart - env_run.xml - - Sets the pause frequency along with PAUSE_N - - - - - integer - 0 - run_begin_stop_restart - env_run.xml - - Provides a numerical count for $PAUSE_OPTION. - - - - - logical - TRUE,FALSE - run_begin_stop_restart - env_run.xml - - Pause the model at times specified by PAUSE_OPTION and PAUSE_N. - Components 'pause' by writing a restart file. - - - FALSE - FALSE - FALSE - FALSE - FALSE - FALSE - FALSE - FALSE - - - - - logical - TRUE,FALSE - FALSE - run_begin_stop_restart - env_run.xml - - ESP component runs after driver 'pause cycle' If any component - 'pauses' (see PAUSE_OPTION, - PAUSE_N and PAUSE_ACTIVE_XXX XML variables), - the ESP component (if present) will be run to process the - component 'pause' (restart) files and set any required 'resume' - signals. If true, esp_cpl_dt and esp_cpl_offset settings are - ignored. default: false - - - logical TRUE,FALSE @@ -489,16 +430,6 @@ - - logical - TRUE,FALSE - FALSE - run_begin_stop_restart - env_run.xml - - A setting of TRUE implies a continuation run for mediator only - - integer @@ -917,21 +848,6 @@ machines. - - logical - TRUE,FALSE - FALSE - build_component_clm - env_build.xml - TRUE implies CLM is built with support for the PETSc - library. The Variably Saturated Flow Model (VSFM) solver in CLM - uses the PETSc library. In order to use the VSFM solver, CLM - must be built with PETSc support and linking to PETSc must occur - when building the ACME executable. This occurs if this variable - is set to TRUE. Note that is only available on a limited set of - machines/compilers. - - logical TRUE,FALSE @@ -2533,11 +2449,11 @@ Support libraries required - + - + logical TRUE,FALSE diff --git a/cime_config/config_component_cesm.xml b/cime_config/config_component_cesm.xml index ccf994d47..96b0b6b15 100644 --- a/cime_config/config_component_cesm.xml +++ b/cime_config/config_component_cesm.xml @@ -107,7 +107,6 @@ CO2A none - CO2A CO2A CO2A CO2A @@ -232,8 +231,6 @@ 48 24 24 - - 72 @@ -249,8 +246,6 @@ - 24 - 48 48 48 @@ -405,7 +400,6 @@ $ATM_NCPL $ATM_NCPL 1 - 8 8 8 $ATM_NCPL @@ -431,56 +425,23 @@ - logical TRUE,FALSE FALSE - TRUE - TRUE - TRUE - TRUE - TRUE - FALSE + TRUE + TRUE run_component_cpl env_run.xml - 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 + If FALSE (default), albedos are computed with the assumption that downward solar radiation from the atm component has a diurnal cycle and zenith-angle - dependence. This is normally the case when using an active atm component - If true, albedos are computed with the assumption that downward + dependence. + If TRUE, albedos are computed with the assumption that downward solar radiation from the atm component is a daily average quantity and - does not have a zenith-angle dependence. This is often the case when - using a data atm component. Only used for compsets with DATM and POP (currently C, G and J). - NOTE: This should really depend on the datm forcing and not the compset per se. - So, for example, whether it is set in a J compset should depend on - what datm forcing is used. - - - - - char - off,ocn - off - - ocn - off - - run_component_cpl - env_run.xml - - Only used for compsets with DATM and POP (currently C, G and J): - If ocn, ocn provides EP balance factor for precipitation. - Provides EP balance factor for precip for POP. A factor computed by - POP is applied to precipitation so that precipitation balances - evaporation and ocn global salinity does not drift. This is intended - for use when coupling POP to a DATM. Only used for C, G and J compsets. - Default is off + does not have a zenith-angle dependence. @@ -548,12 +509,10 @@ TRUE,FALSE FALSE - TRUE TRUE TRUE TRUE TRUE - TRUE TRUE run_budgets @@ -574,7 +533,6 @@ Mechanism for setting the CO2 value in ppmv for CLM if CLM_CO2_TYPE is constant or for - POP if OCN_CO2_TYPE is constant. From 96d50c3210ba09386ca4cb70960c70641ea5d93d Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 26 Sep 2025 20:45:58 +0200 Subject: [PATCH 088/123] reintroduced PAUSE xml variables for now --- cime_config/config_component.xml | 60 +++++++++++++++++++++++++++++++- 1 file changed, 59 insertions(+), 1 deletion(-) diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index dc2318bef..34ca37536 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -413,6 +413,65 @@ + + char + none,never,nsteps,nseconds,nminutes,nhours,ndays,nmonths,nyears + never + run_begin_stop_restart + env_run.xml + + Sets the pause frequency along with PAUSE_N + + + + + integer + 0 + run_begin_stop_restart + env_run.xml + + Provides a numerical count for $PAUSE_OPTION. + + + + + logical + TRUE,FALSE + run_begin_stop_restart + env_run.xml + + Pause the model at times specified by PAUSE_OPTION and PAUSE_N. + Components 'pause' by writing a restart file. + + + FALSE + FALSE + FALSE + FALSE + FALSE + FALSE + FALSE + FALSE + + + + + logical + TRUE,FALSE + FALSE + run_begin_stop_restart + env_run.xml + + ESP component runs after driver 'pause cycle' If any component + 'pauses' (see PAUSE_OPTION, + PAUSE_N and PAUSE_ACTIVE_XXX XML variables), + the ESP component (if present) will be run to process the + component 'pause' (restart) files and set any required 'resume' + signals. If true, esp_cpl_dt and esp_cpl_offset settings are + ignored. default: false + + + logical TRUE,FALSE @@ -430,7 +489,6 @@ - integer 0 From 913811d2aa13c862921250e2fc97c9a2a0df4487 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 29 Sep 2025 13:38:25 +0200 Subject: [PATCH 089/123] removed references for CPL_EPBAL from buildnml --- cime_config/buildnml | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/cime_config/buildnml b/cime_config/buildnml index 1f0f4043b..424ed4177 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -37,7 +37,6 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): config["CPL_I2O_PER_CAT"] = case.get_value("CPL_I2O_PER_CAT") config["DRV_THREADING"] = case.get_value("DRV_THREADING") config["CPL_ALBAV"] = case.get_value("CPL_ALBAV") - config["CPL_EPBAL"] = case.get_value("CPL_EPBAL") config["FLDS_WISO"] = case.get_value("FLDS_WISO") config["BUDGETS"] = case.get_value("BUDGETS") config["MACH"] = case.get_value("MACH") @@ -51,7 +50,6 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): ) config["timer_level"] = "pos" if case.get_value("TIMER_LEVEL") >= 1 else "neg" config["continue_run"] = ".true." if case.get_value("CONTINUE_RUN") else ".false." - config["flux_epbal"] = "ocn" if case.get_value("CPL_EPBAL") == "ocn" else "off" config["mask_grid"] = case.get_value("MASK_GRID") for val in ("HIST", "REST", "STOP"): config[val.lower()+"_option"] = case.get_value(val+"_OPTION") @@ -642,9 +640,9 @@ def cmeps_lib_list(case): mpilib = case.get_value("MPILIB") if mpilib == "mpi-serial" and "mpi-serial" not in libs: libs.insert(0, mpilib) - + ocn_model = case.get_value("COMP_OCN") - # These will be handled by MOM and CAM, included here for backward compatibility. + # These will be handled by MOM and CAM, included here for backward compatibility. atm_dycore = case.get_value("CAM_DYCORE") if (ocn_model == "mom" or (atm_dycore and atm_dycore == "fv3")) and "FMS" not in libs: libs.append("FMS") @@ -658,7 +656,7 @@ def buildnml(case, caseroot, component): libs = cmeps_lib_list(case) case.set_value("CASE_SUPPORT_LIBRARIES", ",".join(libs)) - + esmfmkfile = os.getenv("ESMFMKFILE") expect( esmfmkfile and os.path.isfile(esmfmkfile), From 9bc366979fd2a273d407c9c8d9bcd78d683ee0f9 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 30 Sep 2025 09:06:43 +0200 Subject: [PATCH 090/123] fixed comment for CCSM_CO2_PPMV --- cime_config/config_component_cesm.xml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/cime_config/config_component_cesm.xml b/cime_config/config_component_cesm.xml index 96b0b6b15..5d5d1d43d 100644 --- a/cime_config/config_component_cesm.xml +++ b/cime_config/config_component_cesm.xml @@ -532,7 +532,8 @@ env_run.xml Mechanism for setting the CO2 value in ppmv for - CLM if CLM_CO2_TYPE is constant or for + CLM if CLM_CO2_TYPE is constant or + MOM6 if OCN_CO2_TYPE is constant. From 599dad1d5dc8a14d9af53120c2ad0a62f0260022 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 30 Sep 2025 09:25:18 +0200 Subject: [PATCH 091/123] fixed comment --- cime_config/config_component.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index 34ca37536..6e933b041 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -2307,7 +2307,7 @@ FALSE run_coupling env_run.xml - determine if per ice thickness category fields are passed from ice to ocean - DO NOT EDIT (set by POP build-namelist) + determine if per ice thickness category fields are passed from ice to ocean - DO NOT EDIT (set by MOM6) From d74bc4509859cee61f8a5eef83151c2d8d6b7e21 Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Mon, 6 Oct 2025 11:46:03 -0600 Subject: [PATCH 092/123] Wrap buildnml call of Case.set_value() in non-readonly context. --- cime_config/buildnml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/cime_config/buildnml b/cime_config/buildnml index 1f0f4043b..ce2b35b0e 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -657,7 +657,8 @@ def buildnml(case, caseroot, component): raise AttributeError libs = cmeps_lib_list(case) - case.set_value("CASE_SUPPORT_LIBRARIES", ",".join(libs)) + with Case(case.get_value("CASEROOT"), read_only=False) as case_tmp: + case_tmp.set_value("CASE_SUPPORT_LIBRARIES", ",".join(libs)) esmfmkfile = os.getenv("ESMFMKFILE") expect( From d8e15933159d18dfca598fbaf62b6d0ba751d02e Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 16 Oct 2025 19:41:19 +0200 Subject: [PATCH 093/123] compile with intel is now successful --- cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 | 738 +++++++++++++++++++ cesm/flux_atmocn/flux_atmocn_Large.F90 | 361 +++++++++ mediator/med_phases_aofluxes_mod.F90 | 2 +- 3 files changed, 1100 insertions(+), 1 deletion(-) create mode 100644 cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 create mode 100644 cesm/flux_atmocn/flux_atmocn_Large.F90 diff --git a/cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 b/cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 new file mode 100644 index 000000000..edb2b8127 --- /dev/null +++ b/cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 @@ -0,0 +1,738 @@ +module flux_atmocn_diurnal_mod + + !------------------------------------------------------------------------------- + ! PURPOSE: + ! computes atm/ocn surface fluxes + ! + ! NOTES: + ! o all fluxes are positive downward + ! o net heat flux = net sw + lw up + lw down + sen + lat + ! o here, tstar = /U*, and qstar = /U*. + ! o wind speeds should all be above a minimum speed (eg. 1.0 m/s) + ! + ! ASSUMPTIONS: + ! o Neutral 10m drag coeff: cdn = .0027/U10 + .000142 + .0000764 U10 + ! o Neutral 10m stanton number: ctn = .0327 sqrt(cdn), unstable + ! ctn = .0180 sqrt(cdn), stable + ! o Neutral 10m dalton number: cen = .0346 sqrt(cdn) + ! o The saturation humidity of air at T(K): qsat(T) (kg/m^3) + !------------------------------------------------------------------------------- + + use shr_kind_mod, only : R8=>SHR_KIND_R8, IN=>SHR_KIND_IN ! shared kinds + use shr_flux_mod, only : td0, maxscl, alpha, use_coldair_outbreak_mod + use shr_const_mod, only : shr_const_zvir, shr_const_cpdair, shr_const_karman, shr_const_g + use shr_const_mod, only : shr_const_latvap, shr_const_latice, shr_const_stebol, shr_const_tkfrz + use shr_const_mod, only : shr_const_pi, shr_const_spval, shr_const_cpvir + use shr_const_mod, only : shr_const_ocn_ref_sal, shr_const_zsrflyr, shr_const_rgas + use shr_sys_mod, only : shr_sys_abort + use flux_atmocn_COARE_mod, only : cor30a + use water_isotopes, only : wiso_flxoce !subroutine used to calculate water isotope fluxes. + + implicit none + private + + public :: flux_atmOcn_Diurnal + + private :: cuberoot + + integer :: flux_con_max_iter = 2 + real(r8) :: flux_con_tol = 0.0_R8 + integer :: debug = 0 + +contains + + subroutine flux_atmOcn_diurnal( & + logunit, spval, ocn_surface_flux_scheme, & + nMax ,zbot ,ubot ,vbot ,thbot , & + qbot ,s16O ,sHDO ,s18O ,rbot , & + tbot ,us ,vs , & + ts ,mask , seq_flux_atmocn_minwind, & + sen ,lat ,lwup , & + r16O ,rhdo ,r18O ,evap ,evap_16O, & + evap_HDO ,evap_18O, & + taux ,tauy ,tref ,qref , & + uGust, lwdn , swdn , swup, prec , & + swpen, ocnsal, ocn_prognostic, & + latt, long , warm , salt , speed, regime, & + warmMax, windMax, qSolAvg, windAvg, & + warmMaxInc, windMaxInc, qSolInc, windInc, nInc, & + tBulk, tSkin, tSkin_day, tSkin_night, & + cSkin, cSkin_night, secs ,dt, & + duu10n, ustar_sv ,re_sv ,ssq_sv, & + cold_start) + + + !--- input arguments -------------------------------- + integer ,intent(in) :: logunit + real(r8) ,intent(in) :: spval + integer(IN) ,intent(in) :: ocn_surface_flux_scheme + integer(IN),intent(in) :: nMax ! data vector length + integer(IN),intent(in) :: mask (nMax) ! ocn domain mask 0 <=> out of domain + real(R8) ,intent(in) :: zbot (nMax) ! atm level height(m) + real(R8) ,intent(in) :: ubot (nMax) ! atm u wind(m/s) + real(R8) ,intent(in) :: vbot (nMax) ! atm v wind(m/s) + real(R8) ,intent(in) :: thbot(nMax) ! atm potential T (K) + real(R8) ,intent(in) :: qbot (nMax) ! atm specific humidity(kg/kg) + real(R8) ,intent(in) :: s16O (nMax) ! atm H216O tracer conc.(kg/kg) + real(R8) ,intent(in) :: sHDO (nMax) ! atm HDO tracer conc.(kg/kg) + real(R8) ,intent(in) :: s18O (nMax) ! atm H218O tracer conc.(kg/kg) + real(R8) ,intent(in) :: r16O (nMax) ! ocn H216O tracer ratio/Rstd + real(R8) ,intent(in) :: rHDO (nMax) ! ocn HDO tracer ratio/Rstd + real(R8) ,intent(in) :: r18O (nMax) ! ocn H218O tracer ratio/Rstd + real(R8) ,intent(in) :: rbot (nMax) ! atm air density(kg/m^3) + real(R8) ,intent(in) :: tbot (nMax) ! atm T(K) + real(R8) ,intent(in) :: us (nMax) ! ocn u-velocity (m/s) + real(R8) ,intent(in) :: vs (nMax) ! ocn v-velocity (m/s) + real(R8) ,intent(in) :: ts (nMax) ! ocn temperature(K) + + !--- new arguments ------------------------------- + real(R8),intent(inout) :: swpen (nMax) ! NEW + real(R8),intent(inout) :: ocnsal(nMax) ! NEW (kg/kg) + logical ,intent(in) :: ocn_prognostic ! NEW + real(R8),intent(in) :: uGust (nMax) ! NEW not used + real(R8),intent(in) :: lwdn (nMax) ! NEW + real(R8),intent(in) :: swdn (nMax) ! NEW + real(R8),intent(in) :: swup (nMax) ! NEW + real(R8),intent(in) :: prec (nMax) ! NEW + real(R8),intent(in) :: latt (nMax) ! NEW + real(R8),intent(in) :: long (nMax) ! NEW + real(R8),intent(inout) :: warm (nMax) ! NEW + real(R8),intent(inout) :: salt (nMax) ! NEW + real(R8),intent(inout) :: speed (nMax) ! NEW + real(R8),intent(inout) :: regime(nMax) ! NEW + real(R8),intent(out) :: warmMax(nMax) ! NEW + real(R8),intent(out) :: windMax(nMax) ! NEW + real(R8),intent(inout) :: qSolAvg(nMax) ! NEW + real(R8),intent(inout) :: windAvg(nMax) ! NEW + real(R8),intent(inout) :: warmMaxInc(nMax) ! NEW + real(R8),intent(inout) :: windMaxInc(nMax) ! NEW + real(R8),intent(inout) :: qSolInc(nMax) ! NEW + real(R8),intent(inout) :: windInc(nMax) ! NEW + real(R8),intent(inout) :: nInc(nMax) ! NEW + + real(R8),intent(out) :: tBulk (nMax) ! NEW + real(R8),intent(out) :: tSkin (nMax) ! NEW + real(R8),intent(out) :: tSkin_day (nMax) ! NEW + real(R8),intent(out) :: tSkin_night (nMax) ! NEW + real(R8),intent(out) :: cSkin (nMax) ! NEW + real(R8),intent(out) :: cSkin_night (nMax) ! NEW + integer(IN),intent(in) :: secs ! NEW elsapsed seconds in day (GMT) + integer(IN),intent(in) :: dt ! NEW + logical ,intent(in) :: cold_start ! cold start flag + real(R8),intent(in) :: seq_flux_atmocn_minwind ! minimum wind speed for atmocn (m/s) + + !--- output arguments ------------------------------- + real(R8),intent(out) :: sen (nMax) ! heat flux: sensible (W/m^2) + real(R8),intent(out) :: lat (nMax) ! heat flux: latent (W/m^2) + real(R8),intent(out) :: lwup (nMax) ! heat flux: lw upward (W/m^2) + real(R8),intent(out) :: evap (nMax) ! water flux: evap ((kg/s)/m^2) + real(R8),intent(out) :: evap_16O (nMax) ! water flux: evap ((kg/s/m^2) + real(R8),intent(out) :: evap_HDO (nMax) ! water flux: evap ((kg/s)/m^2) + real(R8),intent(out) :: evap_18O (nMax) ! water flux: evap ((kg/s/m^2) + real(R8),intent(out) :: taux (nMax) ! surface stress, zonal (N) + real(R8),intent(out) :: tauy (nMax) ! surface stress, maridional (N) + real(R8),intent(out) :: tref (nMax) ! diag: 2m ref height T (K) + real(R8),intent(out) :: qref (nMax) ! diag: 2m ref humidity (kg/kg) + real(R8),intent(out) :: duu10n(nMax) ! diag: 10m wind speed squared (m/s)^2 + + real(R8),intent(out),optional :: ustar_sv(nMax) ! diag: ustar + real(R8),intent(out),optional :: re_sv (nMax) ! diag: sqrt of exchange coefficient (water) + real(R8),intent(out),optional :: ssq_sv (nMax) ! diag: sea surface humidity (kg/kg) + + + !--- local constants -------------------------------- + real(R8),parameter :: zref = 10.0_R8 ! reference height (m) + real(R8),parameter :: ztref = 2.0_R8 ! reference height for air T (m) + + real(R8),parameter :: lambdaC = 6.0_R8 + real(R8),parameter :: lambdaL = 0.0_R8 + real(R8),parameter :: doLMax = 1.0_R8 + real(R8),parameter :: pwr = 0.2_R8 + real(R8),parameter :: Rizero = 1.0_R8 + real(R8),parameter :: NUzero = 40.0e-4_R8 + real(R8),parameter :: Prandtl = 1.0_R8 + real(R8),parameter :: kappa0 = 0.2e-4_R8 + + real(R8),parameter :: F0 = 0.5_R8 + real(R8),parameter :: F1 = 0.15_R8 + real(R8),parameter :: R1 = 10.0_R8 + + real(R8),parameter :: Ricr = 0.30_R8 + real(R8),parameter :: tiny = 1.0e-12_R8 + real(R8),parameter :: tiny2 = 1.0e-6_R8 + real(R8),parameter :: pi = SHR_CONST_PI + + !!++ COARE only + real(R8),parameter :: zpbl =700.0_R8 ! PBL depth [m] for gustiness parametriz. + + !--- local variables -------------------------------- + integer(IN) :: n ! vector loop index + integer(IN) :: iter ! iteration loop index + integer(IN) :: lsecs ! local seconds elapsed + integer(IN) :: lonsecs ! incrememnt due to lon offset + real(R8) :: vmag ! surface wind magnitude (m/s) + real(R8) :: ssq ! sea surface humidity (kg/kg) + real(R8) :: delt ! potential T difference (K) + real(R8) :: delq ! humidity difference (kg/kg) + real(R8) :: stable ! stability factor + real(R8) :: rdn ! sqrt of neutral exchange coeff (momentum) + real(R8) :: rhn ! sqrt of neutral exchange coeff (heat) + real(R8) :: ren ! sqrt of neutral exchange coeff (water) + real(R8) :: rd ! sqrt of exchange coefficient (momentum) + real(R8) :: rh ! sqrt of exchange coefficient (heat) + real(R8) :: re ! sqrt of exchange coefficient (water) + real(R8) :: ustar ! ustar + real(R8) :: ustar_prev ! ustar + real(R8) :: qstar ! qstar + real(R8) :: tstar ! tstar + real(R8) :: hol ! H (at zbot) over L + real(R8) :: xsq ! ? + real(R8) :: xqq ! ? + real(R8) :: psimh ! stability function at zbot (momentum) + real(R8) :: psixh ! stability function at zbot (heat and water) + real(R8) :: psix2 ! stability function at ztref reference height + real(R8) :: alz ! ln(zbot/zref) + real(R8) :: al2 ! ln(zref/ztref) + real(R8) :: u10n ! 10m neutral wind + real(R8) :: tau ! stress at zbot + real(R8) :: cp ! specific heat of moist air + real(R8) :: fac ! vertical interpolation factor + real(R8) :: DTiter ! + real(R8) :: DSiter ! + real(R8) :: DViter ! + + real(R8) :: Dcool ! + real(R8) :: Qdel ! net cool skin heating + real(R8) :: Hd ! net heating above -z=d + real(R8) :: Hb ! net kinematic heating above -z = delta + real(R8) :: lambdaV ! + real(R8) :: Fd ! net fresh water forcing above -z=d + real(R8) :: ustarw ! surface wind forcing of layer above -z=d + + real(R8) :: Qsol ! solar heat flux (W/m2) + real(R8) :: Qnsol ! non-solar heat flux (W/m2) + + real(R8) :: SSS ! sea surface salinity + real(R8) :: alphaT ! + real(R8) :: betaS ! + + real(R8) :: doL ! ocean forcing stablity parameter + real(R8) :: Rid ! Richardson number at depth d + real(R8) :: Ribulk ! Bulk Richardson number at depth d + real(R8) :: FofRi ! Richardon number dependent diffusivity + real(R8) :: Smult ! multiplicative term based on regime + real(R8) :: Sfact ! multiplicative term based on regime + real(R8) :: Kdiff ! diffusive term based on regime + real(R8) :: Kvisc ! viscosity term based on regime + real(R8) :: rhocn ! + real(R8) :: rcpocn ! + real(R8) :: Nreset ! value for multiplicative reset factor + logical :: lmidnight + logical :: ltwopm + logical :: ltwoam + logical :: lfullday + integer :: nsum + real(R8) :: pexp ! eqn 19 + real(R8) :: AMP ! eqn 18 + real(R8) :: dif3 + real(R8) :: phid + + !!++ COARE only + real(R8) :: zo,zot,zoq ! roughness lengths + real(R8) :: hsb,hlb ! sens & lat heat flxs at zbot + real(R8) :: trf,qrf,urf,vrf ! reference-height quantities + + !--- local functions -------------------------------- + real(R8) :: qsat ! function: the saturation humididty of air (kg/m^3) + real(R8) :: cdn ! function: neutral drag coeff at 10m + real(R8) :: psimhu ! function: unstable part of psimh + real(R8) :: psixhu ! function: unstable part of psimx + real(R8) :: Umps ! dummy arg ~ wind velocity (m/s) + real(R8) :: Tk ! dummy arg ~ temperature (K) + real(R8) :: xd ! dummy arg ~ ? + real(R8) :: molvisc ! molecular viscosity + real(R8) :: molPr ! molecular Prandtl number + + !--- for cold air outbreak calc -------------------------------- + real(R8) :: tdiff(nMax) ! tbot - ts + real(R8) :: vscl + + qsat(Tk) = 640380.0_R8 / exp(5107.4_R8/Tk) + cdn(Umps) = 0.0027_R8 / Umps + 0.000142_R8 + 0.0000764_R8 * Umps + psimhu(xd) = log((1.0_R8+xd*(2.0_R8+xd))*(1.0_R8+xd*xd)/8.0_R8) - 2.0_R8*atan(xd) + 1.571_R8 + psixhu(xd) = 2.0_R8 * log((1.0_R8 + xd*xd)/2.0_R8) + molvisc(Tk) = 1.623e-6_R8 * exp((-1.0_R8*(Tk-273.15_R8))/45.2_R8) + molPr(Tk) = 11.64_R8 * exp((-1.0_R8*(Tk-273.15_R8))/40.7_R8) + + !--- formats ---------------------------------------- + character(*),parameter :: subName = '(flux_atmOcn_diurnal) ' + character(*),parameter :: F00 = "('(flux_atmOcn_diurnal) ',4a)" + + if (debug > 0) write(logunit,F00) "enter" + + rh = spval + dviter = spval + dtiter = spval + dsiter = spval + al2 = log(zref/ztref) + + !--- for cold air outbreak calc -------------------------------- + tdiff= tbot - ts + + ! equations 18 and 19 + AMP = 1.0_R8/F0-1.0_R8 + pexp = log( (1.0_R8/F1-F0) / (1.0_R8-F0) ) / log(R1) + + if (.not. ocn_prognostic) then + ! Set swpen and ocean salinity from following analytic expressions + swpen(:) = 0.67_R8*(exp((-1._R8*shr_const_zsrflyr)/1.0_R8)) + & + 0.33_R8*exp((-1._R8*shr_const_zsrflyr)/17.0_R8) + ocnsal(:) = shr_const_ocn_ref_sal/1000.0_R8 + else + ! use swpen and ocnsal from input argument + endif + + if (cold_start) then + write(logunit,F00) "Initialize diurnal cycle fields" + warm (:) = 0.0_R8 + salt (:) = 0.0_R8 + speed (:) = 0.0_R8 + regime (:) = 0.0_R8 + qSolAvg (:) = 0.0_R8 + windAvg (:) = 0.0_R8 + warmMax (:) = 0.0_R8 + windMax (:) = 0.0_R8 + warmMaxInc (:) = 0.0_R8 + windMaxInc (:) = 0.0_R8 + qSolInc (:) = 0.0_R8 + windInc (:) = 0.0_R8 + nInc (:) = 0.0_R8 + tSkin_day (:) = ts(:) + tSkin_night(:) = ts(:) + cSkin_night(:) = 0.0_R8 + endif + u10n = 0.0_r8 + stable = 0.0_r8 + DO n=1,nMax + + if (mask(n) /= 0) then + + !--- compute some initial and useful flux quantities --- + + vmag = max(seq_flux_atmocn_minwind, sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2) ) + if (use_coldair_outbreak_mod) then + ! Cold Air Outbreak Modification: + ! Increase windspeed for negative tbot-ts + ! based on Mahrt & Sun 1995,MWR + + if (tdiff(n).lt.td0) then + vscl=min((1._R8+alpha*(abs(tdiff(n)-td0)**0.5_R8/abs(vmag))),maxscl) + vmag=vmag*vscl + endif + endif + alz = log(zbot(n)/zref) + hol = 0.0 + psimh = 0.0 + psixh = 0.0 + rdn = sqrt(cdn(vmag)) + + tBulk(n) = ts(n)+warm(n) ! first guess for tBulk from read in ts,warm + tSkin(n) = tBulk(n) + Qsol = swdn(n) + swup(n) + SSS = 1000.0_R8*ocnsal(n)+salt(n) + lambdaV = lambdaC + + alphaT = 0.000297_R8*(1.0_R8+0.0256_R8*(ts(n)-298.15_R8)+0.003_R8*(SSS - 35.0_R8)) + betaS = 0.000756_R8*(1.0_R8-0.0016_R8*(ts(n)-298.15_R8)) + rhocn = 1023.342_R8*(1.0_R8-0.000297_R8*(ts(n)-298.15_R8)+0.000756_R8 * (SSS - 35.0_R8)) + rcpocn = rhocn * 3990.0_R8*(1.0_R8-0.0012_R8*(SSS - 35.0_R8)) + + Rid = shr_const_g * (alphaT*warm(n) - betaS*salt(n)) *pwr*shr_const_zsrflyr / & + ( pwr*MAX(tiny,speed(n)) )**2 + + Ribulk = 0.0 + + !---------------------------------------------------------- + ! convert elapsed time from GMT to local & + ! check elapsed time. reset warm if near lsecs = reset_sec + !---------------------------------------------------------- + Nreset = 1.0_R8 + + lonsecs = ceiling(long(n)/360.0_R8*86400.0) + lsecs = mod(secs + lonsecs,86400) + + lmidnight = (lsecs >= 0 .and. lsecs < dt) ! 0 = midnight + ltwopm = (lsecs >= 48600 .and. lsecs < 48600+dt) ! 48600 = 1:30pm + ltwoam = (lsecs >= 5400 .and. lsecs < 5400 +dt) ! 5400 = 1:30am + lfullday = (lsecs > 86400-dt .and. lsecs <= 86400) + nsum = nint(nInc(n)) + + if ( lmidnight ) then + Regime(n) = 1.0_R8 ! RESET DIURNAL + warm(n) = 0.0_R8 + salt(n) = 0.0_R8 + speed(n) = 0.0_R8 + endif + + ssq = 0.98_R8 * qsat(tBulk(n)) / rbot(n) ! sea surf hum (kg/kg) + delt = thbot(n) - tBulk(n) ! pot temp diff (K) + delq = qbot(n) - ssq ! spec hum dif (kg/kg) + cp = shr_const_cpdair*(1.0_R8 + shr_const_cpvir*ssq) + + !!................................................................. + !! ocn_surface_flux_scheme = 0 : Default E3SMv1 + !! = 1 : COARE algorithm + !!................................................................. + if (ocn_surface_flux_scheme .eq. 0) then! use Large algorithm + stable = 0.5_R8 + sign(0.5_R8 , delt) + + + !--- shift wind speed using old coefficient and stability function + + rd = rdn / (1.0_R8 + rdn/shr_const_karman*(alz-psimh)) + u10n = vmag * rd / rdn + + !--- initial neutral transfer coeffs at 10m + rdn = sqrt(cdn(u10n)) + rhn = (1.0_R8-stable) * 0.0327_R8 + stable * 0.018_R8 + ren = 0.0346_R8 + + !--- initial ustar, tstar, qstar --- + ustar = rdn * vmag + tstar = rhn * delt + qstar = ren * delq + + else if (ocn_surface_flux_scheme .eq. 1) then! use COARE algorithm + + call cor30a(ubot(n),vbot(n),tbot(n),qbot(n),rbot(n) & ! in atm params + & ,us(n),vs(n),tBulk(n),ssq & ! in surf params (NB ts -> tBulk) + & ,zpbl,zbot(n),zbot(n),zref,ztref,ztref & ! in heights + & ,tau,hsb,hlb & ! out: fluxes + & ,zo,zot,zoq,hol,ustar,tstar,qstar & ! out: ss scales + & ,rd,rh,re & ! out: exch. coeffs + & ,trf,qrf,urf,vrf) ! out: reference-height params + ! for the sake of maintaining same defs + hol=zbot(n)/hol + rd=sqrt(rd) + rh=sqrt(rh) + re=sqrt(re) + + ELSE ! N.B.: *no* valid ocn_surface_flux_scheme=2 option if diurnal=.true. + + call shr_sys_abort(subName//" flux_atmOcn_diurnal requires ocn_surface_flux_scheme = 0 or 1") + + ENDIF + + ustar_prev = ustar * 2.0_R8 + iter = 0 + ! --- iterate --- + ! Originally this code did three iterations while the non-diurnal version did two + ! So in the new loop this is <= flux_con_max_iter instead of < so that the same defaults + ! will give the same answers in both cases. + do while( abs((ustar - ustar_prev)/ustar) > flux_con_tol .and. iter <= flux_con_max_iter) + iter = iter + 1 + ustar_prev = ustar + !------------------------------------------------------------ + ! iterate to converge on FLUXES Z/L, ustar, tstar and qstar + ! and on Rid in the DIURNAL CYCLE + !------------------------------------------------------------ + Smult = 0.0_R8 + Sfact = 0.0_R8 + Kdiff = 0.0_R8 + Kvisc = 0.0_R8 + dif3 = 0.0_R8 + + ustarw = ustar*sqrt(max(tiny,rbot(n)/rhocn)) + Qnsol = lwdn(n) - shr_const_stebol*(tSkin(n))**4 + & + rbot(n)*ustar*(cp*tstar + shr_const_latvap*qstar) + Hd = (Qnsol + Qsol*(1.0_R8-swpen(n)) ) / rcpocn + Fd = (prec(n) + rbot(n)*ustar*qstar ) * SSS / rhocn + + !--- COOL SKIN EFFECT --- + Dcool = lambdaV*molvisc(tBulk(n)) / ustarw + Qdel = Qnsol + Qsol * & + (0.137_R8 + 11.0_R8*Dcool - 6.6e-5/Dcool *(1.0_R8 - exp((-1.0_R8*Dcool)/8.0e-4))) + Hb = (Qdel/rcpocn)+(Fd*betaS/alphaT) + Hb = min(Hb , 0.0_R8) + + ! lambdaV = lambdaC*(1.0_R8 + ( (0.0_R8-Hb)*16.0_R8*molvisc(tBulk(n))* & + ! shr_const_g*alphaT*molPr(tBulk(n))**2/ustarw**4)**0.75)**(-1._R8/3._R8) + lambdaV = 6.5_R8 + cSkin(n) = MIN(0.0_R8, lambdaV * molPr(tBulk(n)) * Qdel / ustarw / rcpocn ) + + !--- REGIME --- + doL = shr_const_zsrflyr*shr_const_karman*shr_const_g* & + (alphaT*Hd + betaS*Fd ) / ustarw**3 + Rid = MAX(0.0_R8,Rid) + Smult = dt * (pwr+1.0_R8) / (shr_const_zsrflyr*pwr) + Sfact = dt * (pwr+1.0_R8) / (shr_const_zsrflyr)**2 + FofRi = 1.0_R8/(1.0_R8 + AMP*(Rid/Rizero)**pexp) + + if ( (doL.gt.0.0_R8) .and. (Qsol.gt.0.0) ) then + phid = MIN(1.0_R8 + 5.0_R8 * doL, 5.0_R8 + doL) + FofRi = 1.0_R8/(1.0_R8 + AMP*(Rid/Rizero)**pexp) + dif3 = (kappa0 + NUzero *FofRi) + + if ((doL.le.lambdaL).and.(NINT(regime(n)).le.2)) then + regime(n) = 2.0_R8 + Kdiff = shr_const_karman * ustarw * shr_const_zsrflyr / phid + Kvisc = Kdiff * (1.0_R8 - doL/lambdaL)**2 + & + dif3 * (doL/lambdaL)**2 * (3.0_R8 - 2.0_R8 * doL/lambdaL) + Kdiff = Kvisc + else + regime(n) = 3.0_R8 + Kdiff = kappa0 + NUzero * FofRi + Kvisc = Prandtl* kappa0 + NUzero * FofRi + endif + else + if (regime(n).eq.1.0_R8) then + Smult = 0.0_R8 + else + if (Ribulk .gt. Ricr) then + regime(n) = 3.0_R8 + Kdiff = kappa0 + NUzero * FofRi + Kvisc = Prandtl* kappa0 + NUzero * FofRi + else + regime(n) = 4.0_R8 + Kdiff = shr_const_karman*ustarw*shr_const_zsrflyr *cuberoot(1.0_R8-7.0_R8*doL) + Kvisc = Kdiff + endif + endif + + endif + + !--- IMPLICIT INTEGRATION --- + + DTiter = (warm(n) +(Smult*Hd)) /(1.+ Sfact*Kdiff) + DSiter = (salt(n) -(Smult*Fd)) /(1.+ Sfact*Kdiff) + DViter = (speed(n) +(Smult*ustarw*ustarw)) /(1.+ Sfact*Kvisc) + DTiter = MAX( 0.0_R8, DTiter) + DViter = MAX( 0.0_R8, DViter) + + Rid =(shr_const_g*(alphaT*DTiter-betaS*DSiter)*pwr*shr_const_zsrflyr) / & + (pwr*MAX(tiny,DViter))**2 + Ribulk = Rid * pwr + Ribulk = 0.0_R8 + tBulk(n) = ts(n) + DTiter + tSkin(n) = tBulk(n) + cskin(n) + + !--need to update ssq,delt,delq as function of tBulk ---- + + ssq = 0.98_R8 * qsat(tBulk(n)) / rbot(n) ! sea surf hum (kg/kg) + delt = thbot(n) - tBulk(n) ! pot temp diff (K) + delq = qbot(n) - ssq ! spec hum dif (kg/kg) + + !--- UPDATE FLUX ITERATION --- + + !!................................................................. + !! ocn_surface_flux_scheme = 0 : Default CESM1.2 + !! = 1 : COARE algorithm + !!................................................................. + if (ocn_surface_flux_scheme .eq. 0) then! use Large algorithm + + !--- compute stability & evaluate all stability functions --- + hol = shr_const_karman*shr_const_g*zbot(n)* & + (tstar/thbot(n)+qstar/(1.0_R8/shr_const_zvir+qbot(n)))/ustar**2 + hol = sign( min(abs(hol),10.0_R8), hol ) + stable = 0.5_R8 + sign(0.5_R8 , hol) + xsq = max(sqrt(abs(1.0_R8 - 16.0_R8*hol)) , 1.0_R8) + xqq = sqrt(xsq) + psimh = -5.0_R8*hol*stable + (1.0_R8-stable)*psimhu(xqq) + psixh = -5.0_R8*hol*stable + (1.0_R8-stable)*psixhu(xqq) + + !--- shift wind speed using old coefficient and stability function --- + rd = rdn / (1.0_R8 + rdn/shr_const_karman*(alz-psimh)) + u10n = vmag * rd / rdn + + !--- update neutral transfer coeffs at 10m + rdn = sqrt(cdn(u10n)) + rhn = (1.0_R8-stable) * 0.0327_R8 + stable * 0.018_R8 + ren = 0.0346_R8 + + !--- shift all coeffs to measurement height and stability --- + rd = rdn / (1.0_R8 + rdn/shr_const_karman*(alz-psimh)) + rh = rhn / (1.0_R8 + rhn/shr_const_karman*(alz-psixh)) + re = ren / (1.0_R8 + ren/shr_const_karman*(alz-psixh)) + + ustar = rd * vmag + tstar = rh * delt + qstar = re * delq + + !--- heat flux --- + + tau = rbot(n) * ustar * ustar + sen (n) = cp * tau * tstar / ustar + lat (n) = shr_const_latvap * tau * qstar / ustar + + else if (ocn_surface_flux_scheme .eq. 1) then! use COARE algorithm + + call cor30a(ubot(n),vbot(n),tbot(n),qbot(n),rbot(n) & ! in atm params + & ,us(n),vs(n),tBulk(n),ssq & ! in surf params (NB ts -> tBulk) + & ,zpbl,zbot(n),zbot(n),zref,ztref,ztref & ! in heights + & ,tau,hsb,hlb & ! out: fluxes + & ,zo,zot,zoq,hol,ustar,tstar,qstar & ! out: ss scales + & ,rd,rh,re & ! out: exch. coeffs + & ,trf,qrf,urf,vrf) ! out: reference-height params + + ! for the sake of maintaining same defs + hol=zbot(n)/hol + rd=sqrt(rd) + rh=sqrt(rh) + re=sqrt(re) + + !--- heat flux --- + sen (n) = hsb + lat (n) = hlb + + else ! N.B.: NO ocn_surface_flux_scheme=2 option + call shr_sys_abort(subName//", flux_diurnal requires ocn_surface_flux_scheme = 0 or 1") + endif + + enddo ! end iteration loop + if (iter < 1) then + call shr_sys_abort('No iterations performed ') + end if + + !--- COMPUTE FLUXES TO ATMOSPHERE AND OCEAN --- + + !--- momentum flux --- + taux(n) = tau * (ubot(n)-us(n)) / vmag + tauy(n) = tau * (vbot(n)-vs(n)) / vmag + + !--- LW radiation --- + lwup(n) = -shr_const_stebol * Tskin(n)**4 + + !--- water flux --- + evap(n) = lat(n)/shr_const_latvap + + !---water isotope flux --- + !!ZZZ bugfix to be done + call wiso_flxoce(2,rbot(n),zbot(n),s16O(n),ts(n),r16O(n),ustar,re,ssq, evap_16O(n),& + qbot(n),evap(n)) + call wiso_flxoce(3,rbot(n),zbot(n),sHDO(n),ts(n),rHDO(n),ustar,re,ssq, evap_HDO(n),& + qbot(n),evap(n)) + call wiso_flxoce(4,rbot(n),zbot(n),s18O(n),ts(n),r18O(n),ustar,re,ssq, evap_18O(n),& + qbot(n),evap(n)) + + !------------------------------------------------------------ + ! compute diagnostics: 2m ref T & Q, 10m wind speed squared + !------------------------------------------------------------ + + if (ocn_surface_flux_scheme .eq. 0) then ! use Large algorithm + + hol = hol*ztref/zbot(n) + xsq = max( 1.0_R8, sqrt(abs(1.0_R8-16.0_R8*hol)) ) + xqq = sqrt(xsq) + psix2 = -5.0_R8*hol*stable + (1.0_R8-stable)*psixhu(xqq) + fac = (rh/shr_const_karman) * (alz + al2 - psixh + psix2 ) + tref(n) = thbot(n) - delt*fac + tref(n) = tref(n) - 0.01_R8*ztref ! pot temp to temp correction + fac = (re/shr_const_karman) * (alz + al2 - psixh + psix2 ) + qref(n) = qbot(n) - delq*fac + + duu10n(n) = u10n*u10n ! 10m wind speed squared + + else if (ocn_surface_flux_scheme .eq. 1) then! use COARE algorithm + + tref(n) = trf + qref(n) = qrf + duu10n(n) = urf**2+vrf**2 + u10n = sqrt(duu10n(n)) + endif + + !------------------------------------------------------------ + ! update new prognostic variables + !------------------------------------------------------------ + + warm (n) = DTiter + salt (n) = DSiter + speed (n) = DViter + + if (ltwopm) then + tSkin_day(n) = tSkin(n) + warmmax(n) = max(DTiter,0.0_R8) + endif + + if (ltwoam) then + tSkin_night(n) = tSkin(n) + cSkin_night(n) = cSkin(n) + endif + + if ((lmidnight).and.(lfullday)) then + qSolAvg(n) = qSolInc(n)/real(nsum+1,R8) + windAvg(n) = windInc(n)/real(nsum+1,R8) + ! warmMax(n) = max(DTiter,warmMaxInc(n)) + windMax(n) = max(u10n,windMaxInc(n)) + + nsum = 0 + + qSolInc(n) = Qsol + windInc(n) = u10n + + ! warmMaxInc(n) = 0.0_R8 + windMaxInc(n) = 0.0_R8 + endif + + nInc(n) = real(nsum,R8) ! set nInc to incremented or reset nsum + + if (present(ustar_sv)) ustar_sv(n) = ustar + if (present(re_sv )) re_sv (n) = re + if (present(ssq_sv )) ssq_sv (n) = ssq + + else ! mask = 0 + + !------------------------------------------------------------ + ! no valid data here -- out of domain + !------------------------------------------------------------ + warm (n) = spval + salt (n) = spval + speed (n) = spval + regime (n) = spval + tBulk (n) = spval + tSkin (n) = spval + tSkin_night(n) = spval + tSkin_day (n) = spval + cSkin (n) = spval + cSkin_night(n) = spval + warmMax (n) = spval + windMax (n) = spval + qSolAvg (n) = spval + windAvg (n) = spval + warmMaxInc (n) = spval + windMaxInc (n) = spval + qSolInc (n) = spval + windInc (n) = spval + nInc (n) = 0.0_R8 + + sen (n) = spval ! sensible heat flux (W/m^2) + lat (n) = spval ! latent heat flux (W/m^2) + lwup (n) = spval ! long-wave upward heat flux (W/m^2) + evap (n) = spval ! evaporative water flux ((kg/s)/m^2) + evap_16O (n) = spval ! water tracer flux (kg/s)/m^2) + evap_HDO (n) = spval ! HDO tracer flux (kg/s)/m^2) + evap_18O (n) = spval ! H218O tracer flux (kg/s)/m^2) + taux (n) = spval ! x surface stress (N) + tauy (n) = spval ! y surface stress (N) + tref (n) = spval ! 2m reference height temperature (K) + qref (n) = spval ! 2m reference height humidity (kg/kg) + duu10n(n) = spval ! 10m wind speed squared (m/s)^2 + + if (present(ustar_sv)) ustar_sv(n) = spval + if (present(re_sv )) re_sv (n) = spval + if (present(ssq_sv )) ssq_sv (n) = spval + + endif ! mask + end DO ! loop over n + + end subroutine flux_atmOcn_diurnal + + ! =================================================================== + + real(R8) elemental function cuberoot(a) + real(R8), intent(in) :: a + real(R8), parameter :: one_third = 1._R8/3._R8 + cuberoot = sign(abs(a)**one_third, a) + end function cuberoot + + +end module flux_atmocn_diurnal_mod diff --git a/cesm/flux_atmocn/flux_atmocn_Large.F90 b/cesm/flux_atmocn/flux_atmocn_Large.F90 new file mode 100644 index 000000000..c3403d564 --- /dev/null +++ b/cesm/flux_atmocn/flux_atmocn_Large.F90 @@ -0,0 +1,361 @@ +module flux_atmOcn_large_mod + + !------------------------------------------------------------------------------- + ! PURPOSE: + ! computes atm/ocn surface fluxes using Large and Pond + ! + ! NOTES: + ! o all fluxes are positive downward + ! o net heat flux = net sw + lw up + lw down + sen + lat + ! o here, tstar = /U*, and qstar = /U*. + ! o wind speeds should all be above a minimum speed (eg. 1.0 m/s) + ! + ! ASSUMPTIONS: + ! Large: + ! o Neutral 10m drag coeff: cdn = .0027/U10 + .000142 + .0000764 U10 + ! o Neutral 10m stanton number: ctn = .0327 sqrt(cdn), unstable + ! ctn = .0180 sqrt(cdn), stable + ! o Neutral 10m dalton number: cen = .0346 sqrt(cdn) + ! o The saturation humidity of air at T(K): qsat(T) (kg/m^3) + !------------------------------------------------------------------------------- + + use shr_kind_mod, only: R8=>SHR_KIND_R8, IN=>SHR_KIND_IN ! shared kinds + use shr_flux_mod, only: loc_cpdair, loc_cpvir, loc_karman, loc_g, loc_zvir + use shr_flux_mod, only: loc_latvap, loc_stebol, use_coldair_outbreak_mod + use shr_flux_mod, only: flux_con_tol, flux_con_max_iter + use shr_flux_mod, only: alpha, maxscl, td0 + use shr_sys_mod, only: shr_sys_abort + use water_isotopes, only: wiso_flxoce !subroutine used to calculate water isotope fluxes. + + implicit none + public + + integer, private :: debug = 0 + +contains + + subroutine flux_atmOcn_large( & + logunit, spval, nMax, & + zbot, ubot, vbot, thbot, & + qbot, rainc, s16O, sHDO, s18O, rbot, & + tbot, us, vs, pslv, & + ts, mask, seq_flux_atmocn_minwind, & + sen, lat, lwup, & + r16O, rhdo, r18O, & + evap, evap_16O, evap_HDO, evap_18O, & + taux, tauy, tref, qref, & + add_gusts, duu10n, ugust_out, u10res, & + ustar_sv, re_sv, ssq_sv) + + !--- input arguments -------------------------------- + integer ,intent(in) :: logunit + real(R8) ,intent(in) :: spval ! local missing value + integer ,intent(in) :: nMax ! data vector length + integer ,intent(in) :: mask (nMax) ! ocn domain mask 0 <=> out of domain + logical ,intent(in) :: add_gusts + real(R8) ,intent(in) :: zbot (nMax) ! atm level height (m) + real(R8) ,intent(in) :: ubot (nMax) ! atm u wind (m/s) + real(R8) ,intent(in) :: vbot (nMax) ! atm v wind (m/s) + real(R8) ,intent(in) :: thbot(nMax) ! atm potential T (K) + real(R8) ,intent(in) :: qbot (nMax) ! atm specific humidity (kg/kg) + real(R8) ,intent(in) :: rainc(nMax) ! atm precip for convective gustiness (kg/m^3) - RBN 24Nov2008/MDF 31Jan2022 + real(R8) ,intent(in) :: s16O (nMax) ! atm H216O tracer conc. (kg/kg) + real(R8) ,intent(in) :: sHDO (nMax) ! atm HDO tracer conc. (kg/kg) + real(R8) ,intent(in) :: s18O (nMax) ! atm H218O tracer conc. (kg/kg) + real(R8) ,intent(in) :: r16O (nMax) ! ocn H216O tracer ratio/Rstd + real(R8) ,intent(in) :: rHDO (nMax) ! ocn HDO tracer ratio/Rstd + real(R8) ,intent(in) :: r18O (nMax) ! ocn H218O tracer ratio/Rstd + real(R8) ,intent(in) :: rbot (nMax) ! atm air density (kg/m^3) + real(R8) ,intent(in) :: tbot (nMax) ! atm T (K) + real(R8) ,intent(in) :: pslv (nMax) ! atm sea level pressure(Pa) + real(R8) ,intent(in) :: us (nMax) ! ocn u-velocity (m/s) + real(R8) ,intent(in) :: vs (nMax) ! ocn v-velocity (m/s) + real(R8) ,intent(in) :: ts (nMax) ! ocn temperature (K) + real(R8) ,intent(in) :: seq_flux_atmocn_minwind ! minimum wind speed for atmocn (m/s) + + !--- output arguments ------------------------------- + real(R8),intent(out) :: sen (nMax) ! heat flux: sensible (W/m^2) + real(R8),intent(out) :: lat (nMax) ! heat flux: latent (W/m^2) + real(R8),intent(out) :: lwup (nMax) ! heat flux: lw upward (W/m^2) + real(R8),intent(out) :: evap (nMax) ! water flux: evap ((kg/s)/m^2) + real(R8),intent(out) :: evap_16O (nMax) ! water flux: evap ((kg/s/m^2) + real(R8),intent(out) :: evap_HDO (nMax) ! water flux: evap ((kg/s)/m^2) + real(R8),intent(out) :: evap_18O (nMax) ! water flux: evap ((kg/s/m^2) + real(R8),intent(out) :: taux (nMax) ! surface stress, zonal (N) + real(R8),intent(out) :: tauy (nMax) ! surface stress, maridional (N) + real(R8),intent(out) :: tref (nMax) ! diag: 2m ref height T (K) + real(R8),intent(out) :: qref (nMax) ! diag: 2m ref humidity (kg/kg) + real(R8),intent(out) :: duu10n(nMax) ! diag: 10m wind speed squared (m/s)^2 + real(R8),intent(out) :: ugust_out(nMax) ! diag: gustiness addition to U10 (m/s) + real(R8),intent(out) :: u10res(nMax) ! diag: gustiness addition to U10 (m/s) + + real(R8),intent(out),optional :: ustar_sv(nMax) ! diag: ustar + real(R8),intent(out),optional :: re_sv (nMax) ! diag: sqrt of exchange coefficient (water) + real(R8),intent(out),optional :: ssq_sv (nMax) ! diag: sea surface humidity (kg/kg) + + !--- local constants -------------------------------- + real(R8),parameter :: zref = 10.0_R8 ! reference height (m) + real(R8),parameter :: ztref = 2.0_R8 ! reference height for air T (m) + + !real(R8),parameter :: cexcd = 0.0346_R8 ! ratio Ch(water)/CD + !real(R8),parameter :: chxcds = 0.018_R8 ! ratio Ch(heat)/CD for stable case + !real(R8),parameter :: chxcdu = 0.0327_R8 ! ratio Ch(heat)/CD for unstable case + + !--- local variables -------------------------------- + integer :: n ! vector loop index + integer :: iter + real(R8) :: vmag ! surface wind magnitude (m/s) + real(R8) :: ssq ! sea surface humidity (kg/kg) + real(R8) :: delt ! potential T difference (K) + real(R8) :: delq ! humidity difference (kg/kg) + real(R8) :: stable ! stability factor + real(R8) :: rdn ! sqrt of neutral exchange coeff (momentum) + real(R8) :: rhn ! sqrt of neutral exchange coeff (heat) + real(R8) :: ren ! sqrt of neutral exchange coeff (water) + real(R8) :: rd ! sqrt of exchange coefficient (momentum) + real(R8) :: rh ! sqrt of exchange coefficient (heat) + real(R8) :: re ! sqrt of exchange coefficient (water) + real(R8) :: ustar ! ustar + real(r8) :: ustar_prev + real(R8) :: qstar ! qstar + real(R8) :: tstar ! tstar + real(R8) :: hol ! H (at zbot) over L + real(R8) :: xsq ! ? + real(R8) :: xqq ! ? + real(R8) :: psimh ! stability function at zbot (momentum) + real(R8) :: psixh ! stability function at zbot (heat and water) + real(R8) :: psix2 ! stability function at ztref reference height + real(R8) :: alz ! ln(zbot/zref) + real(R8) :: al2 ! ln(zref/ztref) + real(R8) :: u10n ! 10m neutral wind + real(R8) :: tau ! stress at zbot + real(R8) :: cp ! specific heat of moist air + real(R8) :: fac ! vertical interpolation factor + real(R8) :: wind0 ! resolved large-scale 10m wind (no gust added) + + !--- local functions -------------------------------- + real(R8) :: qsat ! function: the saturation humididty of air (kg/m^3) + + ! (formula v*=[c4/U10+c5+c6*U10]*U10 in Large et al. 1994) + real(R8) :: cdn ! function: neutral drag coeff at 10m + + ! Large only (stability functions) + real(R8) :: psimhu ! function: unstable part of psimh + real(R8) :: psixhu ! function: unstable part of psimx + real(R8) :: Umps ! dummy arg ~ wind velocity (m/s) + real(R8) :: Tk ! dummy arg ~ temperature (K) + real(R8) :: xd ! dummy arg ~ ? + + !--- for cold air outbreak calc -------------------------------- + real(R8) :: tdiff(nMax) ! tbot - ts + real(R8) :: vscl + + real(R8) :: ugust ! function: gustiness as a function of convective rainfall. + real(R8) :: gprec ! convective rainfall argument for ugust + ! ------------------------------------------------------------------------- + + qsat(Tk) = 640380.0_R8 / exp(5107.4_R8/Tk) + + ! Large and Yeager 2009 + cdn(Umps) = 0.0027_R8 / min(33.0000_R8,Umps) + 0.000142_R8 + & + 0.0000764_R8 * min(33.0000_R8,Umps) - 3.14807e-13_r8 * min(33.0000_R8,Umps)**6 + + ! Capped Large and Pond by wind + ! cdn(Umps) = 0.0027_R8 / min(30.0_R8,Umps) + 0.000142_R8 + 0.0000764_R8 * min(30.0_R8,Umps) + ! Capped Large and Pond by Cd + ! cdn(Umps) = min(0.0025_R8, (0.0027_R8 / Umps + 0.000142_R8 + 0.0000764_R8 * Umps )) + ! Large and Pond + ! cdn(Umps) = 0.0027_R8 / Umps + 0.000142_R8 + 0.0000764_R8 * Umps + + psimhu(xd) = log((1.0_R8+xd*(2.0_R8+xd))*(1.0_R8+xd*xd)/8.0_R8) - 2.0_R8*atan(xd) + 1.571_R8 + psixhu(xd) = 2.0_R8 * log((1.0_R8 + xd*xd)/2.0_R8) + + ! Convective gustiness appropriate for input precipitation. + ! Following Regelsperger et al. (2000, J. Clim) + ! Ug = log(1.0+6.69R-0.476R^2) + ! Coefficients X by 8640 for mm/s (from cam) -> cm/day (for above forumla) + ugust(gprec) = log(1._R8+57801.6_r8*gprec-3.55332096e7_r8*(gprec**2)) + + !--- formats ---------------------------------------- + character(*),parameter :: subName = '(flux_atmOcn) ' + character(*),parameter :: F00 = "('(flux_atmOcn) ',4a)" + ! -------------------------------------------------------------------------- + + if (debug > 0) write(logunit,F00) "enter" + + u10n = spval + rh = spval + psixh = spval + hol = spval + + !--- for cold air outbreak calc -------------------------------- + tdiff= tbot - ts + + al2 = log(zref/ztref) + + DO n=1,nMax + if (mask(n) /= 0) then + + !--- compute some needed quantities --- + if (add_gusts) then + vmag = max(seq_flux_atmocn_minwind, & + sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2 + (1.0_R8*ugust(min(rainc(n),6.94444e-4_r8))**2)) ) + ugust_out(n) = ugust(min(rainc(n),6.94444e-4_r8)) + else + vmag = max(seq_flux_atmocn_minwind, sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2) ) + ugust_out(n) = 0.0_r8 + end if + wind0 = max(seq_flux_atmocn_minwind, sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2) ) + + if (use_coldair_outbreak_mod) then + ! Cold Air Outbreak Modification: + ! Increase windspeed for negative tbot-ts + ! based on Mahrt & Sun 1995,MWR + + if (tdiff(n).lt.td0) then + ! if add_gusts wind0 and vmag are different, both need this factor. + vscl=min((1._R8+alpha*(abs(tdiff(n)-td0)**0.5_R8/abs(vmag))),maxscl) + vmag=vmag*vscl + vscl=min((1._R8+alpha*(abs(tdiff(n)-td0)**0.5_R8/abs(wind0))),maxscl) + wind0=wind0*vscl + endif + endif + + ssq = 0.98_R8 * qsat(ts(n)) / rbot(n) ! sea surf hum (kg/kg) + delt = thbot(n) - ts(n) ! pot temp diff (K) + delq = qbot(n) - ssq ! spec hum dif (kg/kg) + alz = log(zbot(n)/zref) + cp = loc_cpdair*(1.0_R8 + loc_cpvir*ssq) + + !------------------------------------------------------------ + ! first estimate of Z/L and ustar, tstar and qstar + !------------------------------------------------------------ + + !--- neutral coefficients, z/L = 0.0 --- + stable = 0.5_R8 + sign(0.5_R8 , delt) + rdn = sqrt(cdn(vmag)) + rhn = (1.0_R8-stable) * 0.0327_R8 + stable * 0.018_R8 + !(1.0_R8-stable) * chxcdu + stable * chxcds + ren = 0.0346_R8 !cexcd + + !--- ustar, tstar, qstar --- + ustar = rdn * vmag + tstar = rhn * delt + qstar = ren * delq + ustar_prev = ustar*2.0_R8 + iter = 0 + do while( abs((ustar - ustar_prev)/ustar) > flux_con_tol .and. iter < flux_con_max_iter) + iter = iter + 1 + ustar_prev = ustar + !--- compute stability & evaluate all stability functions --- + hol = loc_karman*loc_g*zbot(n)* & + (tstar/thbot(n)+qstar/(1.0_R8/loc_zvir+qbot(n)))/ustar**2 + hol = sign( min(abs(hol),10.0_R8), hol ) + stable = 0.5_R8 + sign(0.5_R8 , hol) + xsq = max(sqrt(abs(1.0_R8 - 16.0_R8*hol)) , 1.0_R8) + xqq = sqrt(xsq) + psimh = -5.0_R8*hol*stable + (1.0_R8-stable)*psimhu(xqq) + psixh = -5.0_R8*hol*stable + (1.0_R8-stable)*psixhu(xqq) + + !--- shift wind speed using old coefficient --- + rd = rdn / (1.0_R8 + max(rdn/loc_karman*(alz-psimh), -0.5_r8)) + u10n = vmag * rd / rdn + + !--- update transfer coeffs at 10m and neutral stability --- + rdn = sqrt(cdn(u10n)) + ren = 0.0346_R8 !cexcd + rhn = (1.0_R8-stable)*0.0327_R8 + stable * 0.018_R8 + !(1.0_R8-stable) * chxcdu + stable * chxcds + + !--- shift all coeffs to measurement height and stability --- + rd = rdn / (1.0_R8 + rdn/loc_karman*(alz-psimh)) + rh = rhn / (1.0_R8 + rhn/loc_karman*(alz-psixh)) + re = ren / (1.0_R8 + ren/loc_karman*(alz-psixh)) + + !--- update ustar, tstar, qstar using updated, shifted coeffs -- + ustar = rd * vmag + tstar = rh * delt + qstar = re * delq + enddo + if (iter < 1) then + write(logunit,*) ustar,ustar_prev,flux_con_tol,flux_con_max_iter + call shr_sys_abort('No iterations performed in flux_atmocn_mod') + end if + !------------------------------------------------------------ + ! compute the fluxes + !------------------------------------------------------------ + + tau = rbot(n) * ustar * ustar + + !--- momentum flux --- + taux(n) = tau * (ubot(n)-us(n)) / vmag + tauy(n) = tau * (vbot(n)-vs(n)) / vmag + + !--- heat flux --- + sen (n) = cp * tau * tstar / ustar + lat (n) = loc_latvap * tau * qstar / ustar + lwup(n) = -loc_stebol * ts(n)**4 + + !--- water flux --- + evap(n) = lat(n)/loc_latvap + + !---water isotope flux --- + call wiso_flxoce(2,rbot(n),zbot(n),s16O(n),ts(n),r16O(n),ustar,re,ssq,evap_16O(n), & + qbot(n),evap(n)) + call wiso_flxoce(3,rbot(n),zbot(n),sHDO(n),ts(n),rHDO(n),ustar,re,ssq, evap_HDO(n),& + qbot(n),evap(n)) + call wiso_flxoce(4,rbot(n),zbot(n),s18O(n),ts(n),r18O(n),ustar,re,ssq, evap_18O(n), & + qbot(n),evap(n)) + + !------------------------------------------------------------ + ! compute diagnositcs: 2m ref T & Q, 10m wind speed squared + !------------------------------------------------------------ + hol = hol*ztref/zbot(n) + xsq = max( 1.0_R8, sqrt(abs(1.0_R8-16.0_R8*hol)) ) + xqq = sqrt(xsq) + psix2 = -5.0_R8*hol*stable + (1.0_R8-stable)*psixhu(xqq) + fac = (rh/loc_karman) * (alz + al2 - psixh + psix2 ) + tref(n) = thbot(n) - delt*fac + tref(n) = tref(n) - 0.01_R8*ztref ! pot temp to temp correction + fac = (re/loc_karman) * (alz + al2 - psixh + psix2 ) + qref(n) = qbot(n) - delq*fac + + duu10n(n) = u10n*u10n ! 10m wind speed squared + u10res(n) = u10n * (wind0/vmag) ! resolved 10m wind + + !------------------------------------------------------------ + ! optional diagnostics, needed for water tracer fluxes (dcn) + !------------------------------------------------------------ + if (present(ustar_sv)) ustar_sv(n) = ustar + if (present(re_sv )) re_sv(n) = re + if (present(ssq_sv )) ssq_sv(n) = ssq + + else + !------------------------------------------------------------ + ! no valid data here -- out of domain + !------------------------------------------------------------ + + sen (n) = spval ! sensible heat flux (W/m^2) + lat (n) = spval ! latent heat flux (W/m^2) + lwup (n) = spval ! long-wave upward heat flux (W/m^2) + evap (n) = spval ! evaporative water flux ((kg/s)/m^2) + evap_16O (n) = spval ! water tracer flux (kg/s)/m^2) + evap_HDO (n) = spval ! HDO tracer flux (kg/s)/m^2) + evap_18O (n) = spval ! H218O tracer flux (kg/s)/m^2) + taux (n) = spval ! x surface stress (N) + tauy (n) = spval ! y surface stress (N) + tref (n) = spval ! 2m reference height temperature (K) + qref (n) = spval ! 2m reference height humidity (kg/kg) + duu10n(n) = spval ! 10m wind speed squared (m/s)^2 + ugust_out(n) = spval ! gustiness addition (m/s) + u10res(n) = spval ! 10m resolved wind (no gusts) (m/s) + + if (present(ustar_sv)) ustar_sv(n) = spval + if (present(re_sv )) re_sv (n) = spval + if (present(ssq_sv )) ssq_sv (n) = spval + endif + enddo + + end subroutine flux_atmOcn_large + +end module flux_atmOcn_large_mod diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index b3618c1ba..7e246b610 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -972,7 +972,7 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) use med_methods_mod, only : FB_fldchk => med_methods_FB_fldchk use med_methods_mod, only : FB_diagnose => med_methods_FB_diagnose #ifdef CESMCOUPLED - use shr_flux_mod , only : flux_atmocn + use flux_atmocn_driver_mod, only : flux_atmocn_driver #else use flux_atmocn_mod, only : flux_atmocn #endif From 47a6c78f091905289eb9bcbc87cb78fc60ecccff Mon Sep 17 00:00:00 2001 From: mvertens Date: Thu, 16 Oct 2025 21:14:34 +0200 Subject: [PATCH 094/123] removed all references to water isotopes - since this will be heavily refactored in upcoming work --- cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 | 489 +++++++ cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 | 1337 +++++++++--------- cesm/flux_atmocn/flux_atmocn_Large.F90 | 25 +- cesm/flux_atmocn/flux_atmocn_UA_mod.F90 | 525 +++++++ cesm/flux_atmocn/flux_atmocn_driver_mod.F90 | 140 ++ cime_config/buildnml | 4 +- cime_config/config_component_cesm.xml | 13 - cime_config/namelist_definition_drv.xml | 3 +- doc/source/addendum/fieldnames.rst | 3 - mediator/esmFldsExchange_cesm_mod.F90 | 335 +---- mediator/fd_cesm.yaml | 140 -- mediator/med_diag_mod.F90 | 621 +------- mediator/med_phases_aofluxes_mod.F90 | 85 +- mediator/med_phases_post_rof_mod.F90 | 15 - 14 files changed, 1840 insertions(+), 1895 deletions(-) create mode 100644 cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 create mode 100644 cesm/flux_atmocn/flux_atmocn_UA_mod.F90 create mode 100644 cesm/flux_atmocn/flux_atmocn_driver_mod.F90 diff --git a/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 b/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 new file mode 100644 index 000000000..4b0efdf2f --- /dev/null +++ b/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 @@ -0,0 +1,489 @@ +module flux_atmocn_COARE_mod + + !------------------------------------------------------------------------------- + ! PURPOSE: + ! computes atm/ocn surface fluxes using COARE v3.0 parametrisation + ! + ! NOTES: + ! o all fluxes are positive downward + ! o net heat flux = net sw + lw up + lw down + sen + lat + ! o here, tstar = /U*, and qstar = /U*. + ! o wind speeds should all be above a minimum speed (eg. 1.0 m/s) + ! + ! !REVISION HISTORY: + ! 2013-Nov-22: Thomas Toniazzo's adaptation of Chris Fairall's code, + ! downloaded from + ! ftp://ftp1.esrl.noaa.gov/users/cfairall/wcrp_wgsf/computer_programs/cor3_0/ + ! * no wave, standard coare 2.6 charnock + ! * skin parametrisation also off (would require radiative fluxes and + ! rainrate in input) + ! * added diagnostics, comments and references + !------------------------------------------------------------------------------- + + use shr_kind_mod, only : R8=>SHR_KIND_R8, IN=>SHR_KIND_IN ! shared kinds + use shr_const_mod, only : shr_const_stebol, shr_const_latvap, shr_const_g + use shr_const_mod, only : shr_const_rgas, shr_const_cpdair + use shr_flux_mod, only : td0, maxscl, alpha + use shr_flux_mod, only : use_coldair_outbreak_mod + + implicit none + private + + public :: flux_atmOcn_COARE + public :: cor30a + + private :: psiuo + private :: psit_30 + + integer :: debug = 0 ! internal debug level + +contains + + subroutine flux_atmOcn_COARE( & + logunit, spval, nMax, zbot, ubot, vbot, thbot, & + qbot, rainc, rbot, tbot ,us ,vs, pslv, & + ts, mask, seq_flux_atmocn_minwind, & + sen, lat, lwup, evap, & + taux ,tauy, tref, qref, & + duu10n, ugust_out, u10res, & + ustar_sv, re_sv, ssq_sv) + + !--- input arguments -------------------------------- + integer , intent(in) :: logunit + real(R8) , intent(in) :: spval + integer , intent(in) :: nMax ! data vector length + integer , intent(in) :: mask (nMax) ! ocn domain mask 0 <=> out of domain + real(R8) , intent(in) :: zbot (nMax) ! atm level height (m) + real(R8) , intent(in) :: ubot (nMax) ! atm u wind (m/s) + real(R8) , intent(in) :: vbot (nMax) ! atm v wind (m/s) + real(R8) , intent(in) :: thbot(nMax) ! atm potential T (K) + real(R8) , intent(in) :: qbot (nMax) ! atm specific humidity (kg/kg) + real(R8) , intent(in) :: rainc(nMax) ! atm precip for convective gustiness (kg/m^3) - RBN 24Nov2008/MDF 31Jan2022 + real(R8) , intent(in) :: rbot (nMax) ! atm air density (kg/m^3) + real(R8) , intent(in) :: tbot (nMax) ! atm T (K) + real(R8) , intent(in) :: pslv (nMax) ! atm sea level pressure(Pa) + real(R8) , intent(in) :: us (nMax) ! ocn u-velocity (m/s) + real(R8) , intent(in) :: vs (nMax) ! ocn v-velocity (m/s) + real(R8) , intent(in) :: ts (nMax) ! ocn temperature (K) + real(R8) , intent(in) :: seq_flux_atmocn_minwind ! minimum wind speed for atmocn (m/s) + + !--- output arguments ------------------------------- + real(R8),intent(out) :: sen (nMax) ! heat flux: sensible (W/m^2) + real(R8),intent(out) :: lat (nMax) ! heat flux: latent (W/m^2) + real(R8),intent(out) :: lwup (nMax) ! heat flux: lw upward (W/m^2) + real(R8),intent(out) :: evap (nMax) ! water flux: evap ((kg/s)/m^2) + real(R8),intent(out) :: taux (nMax) ! surface stress, zonal (N) + real(R8),intent(out) :: tauy (nMax) ! surface stress, maridional (N) + real(R8),intent(out) :: tref (nMax) ! diag: 2m ref height T (K) + real(R8),intent(out) :: qref (nMax) ! diag: 2m ref humidity (kg/kg) + real(R8),intent(out) :: duu10n(nMax) ! diag: 10m wind speed squared (m/s)^2 + real(R8),intent(out) :: ugust_out(nMax) ! diag: gustiness addition to U10 (m/s) + real(R8),intent(out) :: u10res(nMax) ! diag: gustiness addition to U10 (m/s) + + real(R8),intent(out),optional :: ustar_sv(nMax) ! diag: ustar + real(R8),intent(out),optional :: re_sv (nMax) ! diag: sqrt of exchange coefficient (water) + real(R8),intent(out),optional :: ssq_sv (nMax) ! diag: sea surface humidity (kg/kg) + + !--- local constants -------------------------------- + real(R8),parameter :: zref = 10.0_R8 ! reference height (m) + real(R8),parameter :: ztref = 2.0_R8 ! reference height for air T (m) + real(R8),parameter :: zpbl =700.0_R8 ! PBL depth [m] for gustiness parametriz. + + !--- local variables -------------------------------- + integer(IN) :: n ! vector loop index + real(R8) :: vmag ! surface wind magnitude (m/s) + real(R8) :: ssq ! sea surface humidity (kg/kg) + real(R8) :: delt ! potential T difference (K) + real(R8) :: delq ! humidity difference (kg/kg) + real(R8) :: stable ! stability factor + real(R8) :: rd ! sqrt of exchange coefficient (momentum) + real(R8) :: rh ! sqrt of exchange coefficient (heat) + real(R8) :: re ! sqrt of exchange coefficient (water) + real(R8) :: ustar ! ustar + real(R8) :: qstar ! qstar + real(R8) :: tstar ! tstar + real(R8) :: hol ! H (at zbot) over L + real(R8) :: zo,zot,zoq ! roughness lengths + real(R8) :: hsb,hlb ! sens & lat heat flxs at zbot + real(R8) :: tau ! stress at zbot + real(R8) :: trf,qrf,urf,vrf ! reference-height quantities + + !--- local functions -------------------------------- + real(R8) :: qsat ! function: the saturation humididty of air (kg/m^3) + real(R8) :: Tk ! dummy arg ~ temperature (K) + + !--- for cold air outbreak calc -------------------------------- + real(R8) :: tdiff(nMax) ! tbot - ts + real(R8) :: vscl + + !--- functions --- + qsat(Tk) = 640380.0_R8 / exp(5107.4_R8/Tk) + + !--- formats ---------------------------------------- + character(*),parameter :: subName = '(flux_atmOcn_COARE) ' + character(*),parameter :: F00 = "('(flux_atmOcn_COARE) ',4a)" + + if (debug > 0) write(logunit,F00) "enter" + + rh = spval + hol= spval + + !--- for cold air outbreak calc -------------------------------- + tdiff= tbot - ts + + DO n=1,nMax + if (mask(n) /= 0) then + + !--- compute some needed quantities --- + vmag = max(seq_flux_atmocn_minwind, sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2) ) + + if (use_coldair_outbreak_mod) then + ! Cold Air Outbreak Modification: + ! Increase windspeed for negative tbot-ts + ! based on Mahrt & Sun 1995,MWR + + if (tdiff(n).lt.td0) then + vscl=min((1._R8+alpha*(abs(tdiff(n)-td0)**0.5_R8/abs(vmag))),maxscl) + vmag=vmag*vscl + endif + endif + ssq = 0.98_R8 * qsat(ts(n)) / rbot(n) ! sea surf hum (kg/kg) + + call cor30a(ubot(n),vbot(n),tbot(n),qbot(n),rbot(n), & ! in atm params + us(n),vs(n),ts(n),ssq, & ! in surf params + zpbl,zbot(n),zbot(n),zref,ztref,ztref, & ! in heights + tau,hsb,hlb, & ! out: fluxes + zo,zot,zoq,hol,ustar,tstar,qstar, & ! out: ss scales + rd,rh,re, & ! out: exch. coeffs + trf,qrf,urf,vrf) ! out: reference-height params + + ! for the sake of maintaining same defs + hol = zbot(n)/hol + rd = sqrt(rd) + rh = sqrt(rh) + re = sqrt(re) + + !--- momentum flux --- + taux(n) = tau * (ubot(n)-us(n)) / vmag + tauy(n) = tau * (vbot(n)-vs(n)) / vmag + + !--- heat flux --- + sen (n) = hsb + lat (n) = hlb + lwup(n) = -shr_const_stebol * ts(n)**4 + + !--- water flux --- + evap(n) = lat(n)/shr_const_latvap + + !------------------------------------------------------------ + ! compute diagnositcs: 2m ref T & Q, 10m wind speed squared + !------------------------------------------------------------ + tref(n) = trf + qref(n) = qrf + duu10n(n) = urf**2+vrf**2 + + !------------------------------------------------------------ + ! optional diagnostics, needed for water tracer fluxes (dcn) + !------------------------------------------------------------ + if (present(ustar_sv)) ustar_sv(n) = ustar + if (present(re_sv )) re_sv(n) = re + if (present(ssq_sv )) ssq_sv(n) = ssq + + u10res(n) = sqrt(duu10n(n)) + ugust_out(n) = 0._r8 + + else + + !------------------------------------------------------------ + ! no valid data here -- out of domain + !------------------------------------------------------------ + sen (n) = spval ! sensible heat flux (W/m^2) + lat (n) = spval ! latent heat flux (W/m^2) + lwup (n) = spval ! long-wave upward heat flux (W/m^2) + evap (n) = spval ! evaporative water flux ((kg/s)/m^2) + taux (n) = spval ! x surface stress (N) + tauy (n) = spval ! y surface stress (N) + tref (n) = spval ! 2m reference height temperature (K) + qref (n) = spval ! 2m reference height humidity (kg/kg) + duu10n (n) = spval ! 10m wind speed squared (m/s)^2 + + u10res (n) = spval + ugust_out(n) = spval + + if (present(ustar_sv)) ustar_sv(n) = spval + if (present(re_sv )) re_sv (n) = spval + if (present(ssq_sv )) ssq_sv (n) = spval + endif + enddo + + end subroutine flux_atmOcn_COARE + + !================================================================= + + subroutine cor30a(ubt,vbt,tbt,qbt,rbt, & ! in atm params + uss,vss,tss,qss, & ! in surf params + zbl,zbu,zbt,zrfu,zrfq,zrft, & ! in heights + tau,hsb,hlb, & ! out: fluxes + zo,zot,zoq,L,usr,tsr,qsr, & ! out: ss scales + Cd,Ch,Ce, & ! out: exch. coeffs + trf,qrf,urf,vrf) ! out: reference-height params + + ! Arguments + real(R8), intent(in) :: ubt,vbt,tbt,qbt,rbt + real(R8), intent(in) :: uss,vss,tss,qss + real(R8), intent(in) :: zbl,zbu,zbt,zrfu,zrfq,zrft + real(R8), intent(out) :: tau,hsb,hlb + real(R8), intent(out) :: zo,zot,zoq,L,usr,tsr,qsr + real(R8), intent(out) :: Cd,Ch,Ce + real(R8), intent(out) :: trf,qrf,urf,vrf + + ! Local variables + real(R8):: ua,va,ta,q,rb,us,vs,ts,qs,zi,zu,zt,zq,zru,zrq,zrt ! internal vars + + real(R8):: cpa,rgas,grav,pi,von,beta ! phys. params + real(R8):: le,rhoa,cpv ! derived phys. params + real(R8):: t,visa,du,dq,dt ! params of problem + + real(R8):: u10,zo10,zot10,cd10,ch10,ct10,ct,cc,ribu,zetu,l10,charn ! init vars + real(R8):: zet,rr,bf,ug,ut ! loop iter vars + real(R8):: cdn_10,chn_10,cen_10 ! aux. output vars + + integer(IN):: i,nits ! iter loop counters + + integer(IN):: jcool ! aux. cool-skin vars + real(R8) :: dter,wetc,dqer + !---------------------------------------------------------------- + + ua = ubt !wind components (m/s) at height zu (m) + va = vbt + ta = tbt !bulk air temperature (K), height zt + Q = qbt !bulk air spec hum (kg/kg), height zq + rb = rbt !air density + us = uss !surface current components (m/s) + vs = vss + ts = tss !bulk water temperature (K) if jcool= 1, interface water T if jcool= 0 + qs = qss !bulk water spec hum (kg/kg) if jcool= 1 etc + zi = zbl !PBL depth (m) + zu = zbu !wind speed measurement height (m) + zt = zbt !air T measurement height (m) + zq = zbt !air q measurement height (m) + zru = zrfu !reference height for st.diagn.U + zrq = zrfq !reference height for st.diagn.T,q + zrt = zrft !reference height for st.diagn.T,q + + !**** constants + Beta= 1.2_R8 + von = 0.4_R8 + pi = 3.141593_R8 + grav= SHR_CONST_G + Rgas= SHR_CONST_RGAS + cpa = SHR_CONST_CPDAIR + + !*** physical parameters + Le = SHR_CONST_LATVAP -.00237e6_R8*(ts-273.16_R8) + + ! cpv = shr_const_cpdair*(1.0_R8 + shr_const_cpvir*Qs) ! form in NCAR code + cpv = cpa*(1.0_R8+0.84_R8*Q) + + ! rhoa= P/(Rgas*ta*(1+0.61*Q)) ! if input were pressure + rhoa= rb + + ! parametrisation for air kinematic viscosity (Andreas 1989,p.31) + t = ta-273.16_R8 + visa= 1.326e-5_R8*(1.0_R8+6.542e-3_R8*t+8.301e-6_R8*t*t-4.84e-9_R8*t*t*t) + + du = sqrt((ua-us)**2+(va-vs)**2) + dt = ts-ta -.0098_R8*zt + dq = Qs-Q + + !*** don't use cool-skin params for now, but assign values to Ter and Qer + jcool=0_IN + dter=0.3_R8 + wetc=0.622_R8*Le*Qs/(Rgas*ts**2) + dqer=wetc*dter + + !***************** Begin bulk-model calculations *************** + + !*************** first guess + ug=0.5_R8 + + ut = sqrt(du*du+ug*ug) + u10 = ut*log(10.0_R8/1.0e-4_R8)/log(zu/1.0e-4_R8) + usr = .035_R8*u10 + zo10 = 0.011_R8*usr*usr/grav+0.11_R8*visa/usr + Cd10 = (von/log(10.0_R8/zo10))**2 + Ch10 = 0.00115_R8 + Ct10 = Ch10/sqrt(Cd10) + zot10= 10.0_R8/exp(von/Ct10) + Cd =(von/log(zu/zo10))**2 + Ct = von/log(zt/zot10) + CC = von*Ct/Cd + + ! Bulk Richardson number + Ribu=-grav*zu/ta*((dt-dter*jcool)+.61_R8*ta*dq)/ut**2 + + ! initial guess for stability parameter... + if (Ribu .LT. 0.0_R8) then + ! pbl-height dependent + zetu=CC*Ribu/( 1.0_R8 - (.004_R8*Beta**3*zi/zu) * Ribu ) + else + zetu=CC*Ribu*(1.0_R8 + 27.0_R8/9.0_R8*Ribu/CC) + endif + + ! ...and MO length + L10=zu/zetu + + if (zetu .GT. 50.0_R8) then + nits=1_IN + else + nits=3_IN + endif + + usr = ut*von/(log(zu/zo10)-psiuo(zu/L10)) + tsr = (dt-dter*jcool)*von/(log(zt/zot10)-psit_30(zt/L10)) + qsr = (dq-dqer*jcool)*von/(log(zq/zot10)-psit_30(zq/L10)) + + ! parametrisation for Charney parameter (section 3c of Fairall et al. 2003) + charn=0.011_R8 + if (ut .GT. 10.0_R8) then + charn=0.011_R8+(ut-10.0_R8)/(18.0_R8-10.0_R8)*(0.018_R8-0.011_R8) + endif + if (ut .GT. 18.0_R8) then + charn=0.018_R8 + endif + !*************** end first guess ************ + + !*************** iteration loop ************ + do i=1, nits + + ! stability parameter + zet=-von*grav*zu/ta*(tsr*(1.0_R8+0.61_R8*Q)+.61_R8*ta*qsr)/(usr*usr)/(1.0_R8+0.61_R8*Q) + + ! momentum roughness length... + zo = charn*usr*usr/grav+0.11_R8*visa/usr + + ! ...& MO length + L = zu/zet + + ! tracer roughness length + rr = zo*usr/visa + zoq= min(1.15e-4_R8,5.5e-5_R8/rr**.6_R8) + zot= zoq ! N.B. same for vapour and heat + + ! new surface-layer scales + usr = ut *von/(log(zu/zo )-psiuo(zu/L)) + tsr = (dt-dter*jcool)*von/(log(zt/zot)-psit_30(zt/L)) + qsr = (dq-dqer*jcool)*von/(log(zq/zoq)-psit_30(zq/L)) + + ! gustiness parametrisation + Bf=-grav/ta*usr*(tsr+.61_R8*ta*qsr) + if (Bf .GT. 0.0_R8) then + ug=Beta*(Bf*zi)**.333_R8 + else + ug=.2_R8 + endif + ut=sqrt(du*du+ug*ug) + + enddo + !*************** end loop ************ + + !******** fluxes @ measurement heights zu,zt,zq ******** + tau= rhoa*usr*usr*du/ut !stress magnitude + hsb=-rhoa*cpa*usr*tsr !heat downwards + hlb=-rhoa*Le*usr*qsr !wv downwards + + !****** transfer coeffs relative to ut @meas. hts ****** + Cd= tau/rhoa/ut/max(.1_R8,du) + if (tsr.ne.0._r8) then + Ch= usr/ut*tsr/(dt-dter*jcool) + else + Ch= usr/ut* von/(log(zt/zot)-psit_30(zt/L)) + endif + if (qsr.ne.0.0_R8) then + Ce= usr/ut*qsr/(dq-dqer*jcool) + else + Ce= usr/ut* von/(log(zq/zoq)-psit_30(zq/L)) + endif + + !********** 10-m neutral coeff relative to ut ********* + Cdn_10=von*von/log(10.0_R8/zo)/log(10.0_R8/zo) + Chn_10=von*von/log(10.0_R8/zo)/log(10.0_R8/zot) + Cen_10=von*von/log(10.0_R8/zo)/log(10.0_R8/zoq) + + !********** reference-height values for u,q,T ********* + urf=us+(ua-us)*(log(zru/zo)-psiuo(zru/L))/(log(zu/zo)-psiuo(zu/L)) + vrf=vs+(va-vs)*(log(zru/zo)-psiuo(zru/L))/(log(zu/zo)-psiuo(zu/L)) + qrf=qs-dq*(log(zrq/zoq)-psit_30(zrq/L))/(log(zq/zoq)-psit_30(zq/L)) + trf=ts-dt*(log(zrt/zot)-psit_30(zrt/L))/(log(zt/zot)-psit_30(zt/L)) + trf=trf+.0098_R8*zrt + + end subroutine cor30a + + !=============================================================================== + + real (R8) function psiuo(zet) + !====================================================================== + ! momentum stability functions adopted in COARE v3.0 parametrisation. + ! Chris Fairall's code (see cor30a) + ! + ! !REVISION HISTORY: + ! 22/11/2013: Thomas Toniazzo: comments added + !====================================================================== + + ! !INPUT/OUTPUT PARAMETERS: + real(R8),intent(in) :: zet + real(R8) ::c,x,psik,psic,f + !----------------------------------------------------------------- + ! N.B.: z0/L always neglected compared to z/L and to 1 + !----------------------------------------------------------------- + if(zet>0.0_R8)then + ! Beljaars & Holtslag (1991) + c=min(50._R8,.35_R8*zet) + psiuo=-((1.0_R8+1.0_R8*zet)**1.0_R8+.667_R8*(zet-14.28_R8)/exp(c)+8.525_R8) + else + ! Dyer & Hicks (1974) for weak instability + x=(1.0_R8-15.0_R8*zet)**.25_R8 ! 15 instead of 16 + psik=2.0_R8*log((1.0_R8+x)/2.0_R8)+log((1.0_R8+x*x)/2.0_R8)-2.0_R8*atan(x)+2.0_R8*atan(1.0_R8) + ! Fairall et al. (1996) for strong instability (Eq.(13)) + x=(1.0_R8-10.15_R8*zet)**.3333_R8 + psic= 1.5_R8*log((1.0_R8+x+x*x)/3.0_R8)-sqrt(3.0_R8)*atan((1.0_R8+2.0_R8*x)/sqrt(3.0_R8)) & + & +4.0_R8*atan(1.0_R8)/sqrt(3.0_R8) + f=zet*zet/(1.0_R8+zet*zet) + psiuo=(1.0_R8-f)*psik+f*psic + endif + END FUNCTION psiuo + + real (R8) function psit_30(zet) + !=============================================================================== + ! momentum stability functions adopted in COARE v3.0 parametrisation. + ! Chris Fairall's code (see cor30a) + ! + ! !REVISION HISTORY: + ! 22/11/2013: Thomas Toniazzo: comments added + !=============================================================================== + + ! !INPUT/OUTPUT PARAMETERS: + real(R8),intent(in) :: zet + ! !EOP + real(R8) ::c,x,psik,psic,f + !----------------------------------------------------------------- + ! N.B.: z0/L always neglected compared to z/L and to 1 + !----------------------------------------------------------------- + if(zet>0.0_R8)then + ! Beljaars & Holtslag (1991) + c=min(50._R8,.35_R8*zet) + psit_30=-((1.0_R8+2.0_R8/3.0_R8*zet)**1.5_R8+.667_R8*(zet-14.28_R8)/exp(c)+8.525_R8) + else + ! Dyer & Hicks (1974) for weak instability + x=(1.0_R8-15.0_R8*zet)**.5_R8 ! 15 instead of 16 + psik=2.0_R8*log((1.0_R8+x)/2.0_R8) + ! Fairall et al. (1996) for strong instability + x=(1.0_R8-(34.15_R8*zet))**.3333_R8 + psic= 1.5_R8*log((1.0_R8+x+x*x)/3.0_R8)-sqrt(3.0_R8)*atan((1.0_R8+2.0_R8*x)/sqrt(3.0_R8)) & + & +4.0_R8*atan(1.0_R8)/sqrt(3.0_R8) + f=zet*zet/(1.0_R8+zet*zet) + psit_30=(1.0_R8-f)*psik+f*psic + endif + end FUNCTION psit_30 + +end module flux_atmocn_COARE_mod diff --git a/cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 b/cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 index edb2b8127..9a2beef71 100644 --- a/cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 +++ b/cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 @@ -26,7 +26,6 @@ module flux_atmocn_diurnal_mod use shr_const_mod, only : shr_const_ocn_ref_sal, shr_const_zsrflyr, shr_const_rgas use shr_sys_mod, only : shr_sys_abort use flux_atmocn_COARE_mod, only : cor30a - use water_isotopes, only : wiso_flxoce !subroutine used to calculate water isotope fluxes. implicit none private @@ -41,690 +40,658 @@ module flux_atmocn_diurnal_mod contains - subroutine flux_atmOcn_diurnal( & - logunit, spval, ocn_surface_flux_scheme, & - nMax ,zbot ,ubot ,vbot ,thbot , & - qbot ,s16O ,sHDO ,s18O ,rbot , & - tbot ,us ,vs , & - ts ,mask , seq_flux_atmocn_minwind, & - sen ,lat ,lwup , & - r16O ,rhdo ,r18O ,evap ,evap_16O, & - evap_HDO ,evap_18O, & - taux ,tauy ,tref ,qref , & - uGust, lwdn , swdn , swup, prec , & - swpen, ocnsal, ocn_prognostic, & - latt, long , warm , salt , speed, regime, & - warmMax, windMax, qSolAvg, windAvg, & - warmMaxInc, windMaxInc, qSolInc, windInc, nInc, & - tBulk, tSkin, tSkin_day, tSkin_night, & - cSkin, cSkin_night, secs ,dt, & - duu10n, ustar_sv ,re_sv ,ssq_sv, & - cold_start) - - - !--- input arguments -------------------------------- - integer ,intent(in) :: logunit - real(r8) ,intent(in) :: spval - integer(IN) ,intent(in) :: ocn_surface_flux_scheme - integer(IN),intent(in) :: nMax ! data vector length - integer(IN),intent(in) :: mask (nMax) ! ocn domain mask 0 <=> out of domain - real(R8) ,intent(in) :: zbot (nMax) ! atm level height(m) - real(R8) ,intent(in) :: ubot (nMax) ! atm u wind(m/s) - real(R8) ,intent(in) :: vbot (nMax) ! atm v wind(m/s) - real(R8) ,intent(in) :: thbot(nMax) ! atm potential T (K) - real(R8) ,intent(in) :: qbot (nMax) ! atm specific humidity(kg/kg) - real(R8) ,intent(in) :: s16O (nMax) ! atm H216O tracer conc.(kg/kg) - real(R8) ,intent(in) :: sHDO (nMax) ! atm HDO tracer conc.(kg/kg) - real(R8) ,intent(in) :: s18O (nMax) ! atm H218O tracer conc.(kg/kg) - real(R8) ,intent(in) :: r16O (nMax) ! ocn H216O tracer ratio/Rstd - real(R8) ,intent(in) :: rHDO (nMax) ! ocn HDO tracer ratio/Rstd - real(R8) ,intent(in) :: r18O (nMax) ! ocn H218O tracer ratio/Rstd - real(R8) ,intent(in) :: rbot (nMax) ! atm air density(kg/m^3) - real(R8) ,intent(in) :: tbot (nMax) ! atm T(K) - real(R8) ,intent(in) :: us (nMax) ! ocn u-velocity (m/s) - real(R8) ,intent(in) :: vs (nMax) ! ocn v-velocity (m/s) - real(R8) ,intent(in) :: ts (nMax) ! ocn temperature(K) - - !--- new arguments ------------------------------- - real(R8),intent(inout) :: swpen (nMax) ! NEW - real(R8),intent(inout) :: ocnsal(nMax) ! NEW (kg/kg) - logical ,intent(in) :: ocn_prognostic ! NEW - real(R8),intent(in) :: uGust (nMax) ! NEW not used - real(R8),intent(in) :: lwdn (nMax) ! NEW - real(R8),intent(in) :: swdn (nMax) ! NEW - real(R8),intent(in) :: swup (nMax) ! NEW - real(R8),intent(in) :: prec (nMax) ! NEW - real(R8),intent(in) :: latt (nMax) ! NEW - real(R8),intent(in) :: long (nMax) ! NEW - real(R8),intent(inout) :: warm (nMax) ! NEW - real(R8),intent(inout) :: salt (nMax) ! NEW - real(R8),intent(inout) :: speed (nMax) ! NEW - real(R8),intent(inout) :: regime(nMax) ! NEW - real(R8),intent(out) :: warmMax(nMax) ! NEW - real(R8),intent(out) :: windMax(nMax) ! NEW - real(R8),intent(inout) :: qSolAvg(nMax) ! NEW - real(R8),intent(inout) :: windAvg(nMax) ! NEW - real(R8),intent(inout) :: warmMaxInc(nMax) ! NEW - real(R8),intent(inout) :: windMaxInc(nMax) ! NEW - real(R8),intent(inout) :: qSolInc(nMax) ! NEW - real(R8),intent(inout) :: windInc(nMax) ! NEW - real(R8),intent(inout) :: nInc(nMax) ! NEW - - real(R8),intent(out) :: tBulk (nMax) ! NEW - real(R8),intent(out) :: tSkin (nMax) ! NEW - real(R8),intent(out) :: tSkin_day (nMax) ! NEW - real(R8),intent(out) :: tSkin_night (nMax) ! NEW - real(R8),intent(out) :: cSkin (nMax) ! NEW - real(R8),intent(out) :: cSkin_night (nMax) ! NEW - integer(IN),intent(in) :: secs ! NEW elsapsed seconds in day (GMT) - integer(IN),intent(in) :: dt ! NEW - logical ,intent(in) :: cold_start ! cold start flag - real(R8),intent(in) :: seq_flux_atmocn_minwind ! minimum wind speed for atmocn (m/s) - - !--- output arguments ------------------------------- - real(R8),intent(out) :: sen (nMax) ! heat flux: sensible (W/m^2) - real(R8),intent(out) :: lat (nMax) ! heat flux: latent (W/m^2) - real(R8),intent(out) :: lwup (nMax) ! heat flux: lw upward (W/m^2) - real(R8),intent(out) :: evap (nMax) ! water flux: evap ((kg/s)/m^2) - real(R8),intent(out) :: evap_16O (nMax) ! water flux: evap ((kg/s/m^2) - real(R8),intent(out) :: evap_HDO (nMax) ! water flux: evap ((kg/s)/m^2) - real(R8),intent(out) :: evap_18O (nMax) ! water flux: evap ((kg/s/m^2) - real(R8),intent(out) :: taux (nMax) ! surface stress, zonal (N) - real(R8),intent(out) :: tauy (nMax) ! surface stress, maridional (N) - real(R8),intent(out) :: tref (nMax) ! diag: 2m ref height T (K) - real(R8),intent(out) :: qref (nMax) ! diag: 2m ref humidity (kg/kg) - real(R8),intent(out) :: duu10n(nMax) ! diag: 10m wind speed squared (m/s)^2 - - real(R8),intent(out),optional :: ustar_sv(nMax) ! diag: ustar - real(R8),intent(out),optional :: re_sv (nMax) ! diag: sqrt of exchange coefficient (water) - real(R8),intent(out),optional :: ssq_sv (nMax) ! diag: sea surface humidity (kg/kg) - - - !--- local constants -------------------------------- - real(R8),parameter :: zref = 10.0_R8 ! reference height (m) - real(R8),parameter :: ztref = 2.0_R8 ! reference height for air T (m) - - real(R8),parameter :: lambdaC = 6.0_R8 - real(R8),parameter :: lambdaL = 0.0_R8 - real(R8),parameter :: doLMax = 1.0_R8 - real(R8),parameter :: pwr = 0.2_R8 - real(R8),parameter :: Rizero = 1.0_R8 - real(R8),parameter :: NUzero = 40.0e-4_R8 - real(R8),parameter :: Prandtl = 1.0_R8 - real(R8),parameter :: kappa0 = 0.2e-4_R8 - - real(R8),parameter :: F0 = 0.5_R8 - real(R8),parameter :: F1 = 0.15_R8 - real(R8),parameter :: R1 = 10.0_R8 - - real(R8),parameter :: Ricr = 0.30_R8 - real(R8),parameter :: tiny = 1.0e-12_R8 - real(R8),parameter :: tiny2 = 1.0e-6_R8 - real(R8),parameter :: pi = SHR_CONST_PI - - !!++ COARE only - real(R8),parameter :: zpbl =700.0_R8 ! PBL depth [m] for gustiness parametriz. - - !--- local variables -------------------------------- - integer(IN) :: n ! vector loop index - integer(IN) :: iter ! iteration loop index - integer(IN) :: lsecs ! local seconds elapsed - integer(IN) :: lonsecs ! incrememnt due to lon offset - real(R8) :: vmag ! surface wind magnitude (m/s) - real(R8) :: ssq ! sea surface humidity (kg/kg) - real(R8) :: delt ! potential T difference (K) - real(R8) :: delq ! humidity difference (kg/kg) - real(R8) :: stable ! stability factor - real(R8) :: rdn ! sqrt of neutral exchange coeff (momentum) - real(R8) :: rhn ! sqrt of neutral exchange coeff (heat) - real(R8) :: ren ! sqrt of neutral exchange coeff (water) - real(R8) :: rd ! sqrt of exchange coefficient (momentum) - real(R8) :: rh ! sqrt of exchange coefficient (heat) - real(R8) :: re ! sqrt of exchange coefficient (water) - real(R8) :: ustar ! ustar - real(R8) :: ustar_prev ! ustar - real(R8) :: qstar ! qstar - real(R8) :: tstar ! tstar - real(R8) :: hol ! H (at zbot) over L - real(R8) :: xsq ! ? - real(R8) :: xqq ! ? - real(R8) :: psimh ! stability function at zbot (momentum) - real(R8) :: psixh ! stability function at zbot (heat and water) - real(R8) :: psix2 ! stability function at ztref reference height - real(R8) :: alz ! ln(zbot/zref) - real(R8) :: al2 ! ln(zref/ztref) - real(R8) :: u10n ! 10m neutral wind - real(R8) :: tau ! stress at zbot - real(R8) :: cp ! specific heat of moist air - real(R8) :: fac ! vertical interpolation factor - real(R8) :: DTiter ! - real(R8) :: DSiter ! - real(R8) :: DViter ! - - real(R8) :: Dcool ! - real(R8) :: Qdel ! net cool skin heating - real(R8) :: Hd ! net heating above -z=d - real(R8) :: Hb ! net kinematic heating above -z = delta - real(R8) :: lambdaV ! - real(R8) :: Fd ! net fresh water forcing above -z=d - real(R8) :: ustarw ! surface wind forcing of layer above -z=d - - real(R8) :: Qsol ! solar heat flux (W/m2) - real(R8) :: Qnsol ! non-solar heat flux (W/m2) - - real(R8) :: SSS ! sea surface salinity - real(R8) :: alphaT ! - real(R8) :: betaS ! - - real(R8) :: doL ! ocean forcing stablity parameter - real(R8) :: Rid ! Richardson number at depth d - real(R8) :: Ribulk ! Bulk Richardson number at depth d - real(R8) :: FofRi ! Richardon number dependent diffusivity - real(R8) :: Smult ! multiplicative term based on regime - real(R8) :: Sfact ! multiplicative term based on regime - real(R8) :: Kdiff ! diffusive term based on regime - real(R8) :: Kvisc ! viscosity term based on regime - real(R8) :: rhocn ! - real(R8) :: rcpocn ! - real(R8) :: Nreset ! value for multiplicative reset factor - logical :: lmidnight - logical :: ltwopm - logical :: ltwoam - logical :: lfullday - integer :: nsum - real(R8) :: pexp ! eqn 19 - real(R8) :: AMP ! eqn 18 - real(R8) :: dif3 - real(R8) :: phid - - !!++ COARE only - real(R8) :: zo,zot,zoq ! roughness lengths - real(R8) :: hsb,hlb ! sens & lat heat flxs at zbot - real(R8) :: trf,qrf,urf,vrf ! reference-height quantities - - !--- local functions -------------------------------- - real(R8) :: qsat ! function: the saturation humididty of air (kg/m^3) - real(R8) :: cdn ! function: neutral drag coeff at 10m - real(R8) :: psimhu ! function: unstable part of psimh - real(R8) :: psixhu ! function: unstable part of psimx - real(R8) :: Umps ! dummy arg ~ wind velocity (m/s) - real(R8) :: Tk ! dummy arg ~ temperature (K) - real(R8) :: xd ! dummy arg ~ ? - real(R8) :: molvisc ! molecular viscosity - real(R8) :: molPr ! molecular Prandtl number - - !--- for cold air outbreak calc -------------------------------- - real(R8) :: tdiff(nMax) ! tbot - ts - real(R8) :: vscl - - qsat(Tk) = 640380.0_R8 / exp(5107.4_R8/Tk) - cdn(Umps) = 0.0027_R8 / Umps + 0.000142_R8 + 0.0000764_R8 * Umps - psimhu(xd) = log((1.0_R8+xd*(2.0_R8+xd))*(1.0_R8+xd*xd)/8.0_R8) - 2.0_R8*atan(xd) + 1.571_R8 - psixhu(xd) = 2.0_R8 * log((1.0_R8 + xd*xd)/2.0_R8) - molvisc(Tk) = 1.623e-6_R8 * exp((-1.0_R8*(Tk-273.15_R8))/45.2_R8) - molPr(Tk) = 11.64_R8 * exp((-1.0_R8*(Tk-273.15_R8))/40.7_R8) - - !--- formats ---------------------------------------- - character(*),parameter :: subName = '(flux_atmOcn_diurnal) ' - character(*),parameter :: F00 = "('(flux_atmOcn_diurnal) ',4a)" - - if (debug > 0) write(logunit,F00) "enter" - - rh = spval - dviter = spval - dtiter = spval - dsiter = spval - al2 = log(zref/ztref) - - !--- for cold air outbreak calc -------------------------------- - tdiff= tbot - ts - - ! equations 18 and 19 - AMP = 1.0_R8/F0-1.0_R8 - pexp = log( (1.0_R8/F1-F0) / (1.0_R8-F0) ) / log(R1) - - if (.not. ocn_prognostic) then - ! Set swpen and ocean salinity from following analytic expressions - swpen(:) = 0.67_R8*(exp((-1._R8*shr_const_zsrflyr)/1.0_R8)) + & - 0.33_R8*exp((-1._R8*shr_const_zsrflyr)/17.0_R8) - ocnsal(:) = shr_const_ocn_ref_sal/1000.0_R8 - else - ! use swpen and ocnsal from input argument - endif - - if (cold_start) then - write(logunit,F00) "Initialize diurnal cycle fields" - warm (:) = 0.0_R8 - salt (:) = 0.0_R8 - speed (:) = 0.0_R8 - regime (:) = 0.0_R8 - qSolAvg (:) = 0.0_R8 - windAvg (:) = 0.0_R8 - warmMax (:) = 0.0_R8 - windMax (:) = 0.0_R8 - warmMaxInc (:) = 0.0_R8 - windMaxInc (:) = 0.0_R8 - qSolInc (:) = 0.0_R8 - windInc (:) = 0.0_R8 - nInc (:) = 0.0_R8 - tSkin_day (:) = ts(:) - tSkin_night(:) = ts(:) - cSkin_night(:) = 0.0_R8 - endif - u10n = 0.0_r8 - stable = 0.0_r8 - DO n=1,nMax - - if (mask(n) /= 0) then - - !--- compute some initial and useful flux quantities --- - - vmag = max(seq_flux_atmocn_minwind, sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2) ) - if (use_coldair_outbreak_mod) then - ! Cold Air Outbreak Modification: - ! Increase windspeed for negative tbot-ts - ! based on Mahrt & Sun 1995,MWR - - if (tdiff(n).lt.td0) then - vscl=min((1._R8+alpha*(abs(tdiff(n)-td0)**0.5_R8/abs(vmag))),maxscl) - vmag=vmag*vscl - endif - endif - alz = log(zbot(n)/zref) - hol = 0.0 - psimh = 0.0 - psixh = 0.0 - rdn = sqrt(cdn(vmag)) - - tBulk(n) = ts(n)+warm(n) ! first guess for tBulk from read in ts,warm - tSkin(n) = tBulk(n) - Qsol = swdn(n) + swup(n) - SSS = 1000.0_R8*ocnsal(n)+salt(n) - lambdaV = lambdaC - - alphaT = 0.000297_R8*(1.0_R8+0.0256_R8*(ts(n)-298.15_R8)+0.003_R8*(SSS - 35.0_R8)) - betaS = 0.000756_R8*(1.0_R8-0.0016_R8*(ts(n)-298.15_R8)) - rhocn = 1023.342_R8*(1.0_R8-0.000297_R8*(ts(n)-298.15_R8)+0.000756_R8 * (SSS - 35.0_R8)) - rcpocn = rhocn * 3990.0_R8*(1.0_R8-0.0012_R8*(SSS - 35.0_R8)) - - Rid = shr_const_g * (alphaT*warm(n) - betaS*salt(n)) *pwr*shr_const_zsrflyr / & - ( pwr*MAX(tiny,speed(n)) )**2 - - Ribulk = 0.0 - - !---------------------------------------------------------- - ! convert elapsed time from GMT to local & - ! check elapsed time. reset warm if near lsecs = reset_sec - !---------------------------------------------------------- - Nreset = 1.0_R8 - - lonsecs = ceiling(long(n)/360.0_R8*86400.0) - lsecs = mod(secs + lonsecs,86400) - - lmidnight = (lsecs >= 0 .and. lsecs < dt) ! 0 = midnight - ltwopm = (lsecs >= 48600 .and. lsecs < 48600+dt) ! 48600 = 1:30pm - ltwoam = (lsecs >= 5400 .and. lsecs < 5400 +dt) ! 5400 = 1:30am - lfullday = (lsecs > 86400-dt .and. lsecs <= 86400) - nsum = nint(nInc(n)) - - if ( lmidnight ) then - Regime(n) = 1.0_R8 ! RESET DIURNAL - warm(n) = 0.0_R8 - salt(n) = 0.0_R8 - speed(n) = 0.0_R8 - endif - - ssq = 0.98_R8 * qsat(tBulk(n)) / rbot(n) ! sea surf hum (kg/kg) - delt = thbot(n) - tBulk(n) ! pot temp diff (K) - delq = qbot(n) - ssq ! spec hum dif (kg/kg) - cp = shr_const_cpdair*(1.0_R8 + shr_const_cpvir*ssq) - - !!................................................................. - !! ocn_surface_flux_scheme = 0 : Default E3SMv1 - !! = 1 : COARE algorithm - !!................................................................. - if (ocn_surface_flux_scheme .eq. 0) then! use Large algorithm - stable = 0.5_R8 + sign(0.5_R8 , delt) - - - !--- shift wind speed using old coefficient and stability function - - rd = rdn / (1.0_R8 + rdn/shr_const_karman*(alz-psimh)) - u10n = vmag * rd / rdn - - !--- initial neutral transfer coeffs at 10m - rdn = sqrt(cdn(u10n)) - rhn = (1.0_R8-stable) * 0.0327_R8 + stable * 0.018_R8 - ren = 0.0346_R8 - - !--- initial ustar, tstar, qstar --- - ustar = rdn * vmag - tstar = rhn * delt - qstar = ren * delq - - else if (ocn_surface_flux_scheme .eq. 1) then! use COARE algorithm - - call cor30a(ubot(n),vbot(n),tbot(n),qbot(n),rbot(n) & ! in atm params - & ,us(n),vs(n),tBulk(n),ssq & ! in surf params (NB ts -> tBulk) - & ,zpbl,zbot(n),zbot(n),zref,ztref,ztref & ! in heights - & ,tau,hsb,hlb & ! out: fluxes - & ,zo,zot,zoq,hol,ustar,tstar,qstar & ! out: ss scales - & ,rd,rh,re & ! out: exch. coeffs - & ,trf,qrf,urf,vrf) ! out: reference-height params - ! for the sake of maintaining same defs - hol=zbot(n)/hol - rd=sqrt(rd) - rh=sqrt(rh) - re=sqrt(re) - - ELSE ! N.B.: *no* valid ocn_surface_flux_scheme=2 option if diurnal=.true. - - call shr_sys_abort(subName//" flux_atmOcn_diurnal requires ocn_surface_flux_scheme = 0 or 1") - - ENDIF - - ustar_prev = ustar * 2.0_R8 - iter = 0 - ! --- iterate --- - ! Originally this code did three iterations while the non-diurnal version did two - ! So in the new loop this is <= flux_con_max_iter instead of < so that the same defaults - ! will give the same answers in both cases. - do while( abs((ustar - ustar_prev)/ustar) > flux_con_tol .and. iter <= flux_con_max_iter) - iter = iter + 1 - ustar_prev = ustar - !------------------------------------------------------------ - ! iterate to converge on FLUXES Z/L, ustar, tstar and qstar - ! and on Rid in the DIURNAL CYCLE - !------------------------------------------------------------ - Smult = 0.0_R8 - Sfact = 0.0_R8 - Kdiff = 0.0_R8 - Kvisc = 0.0_R8 - dif3 = 0.0_R8 - - ustarw = ustar*sqrt(max(tiny,rbot(n)/rhocn)) - Qnsol = lwdn(n) - shr_const_stebol*(tSkin(n))**4 + & - rbot(n)*ustar*(cp*tstar + shr_const_latvap*qstar) - Hd = (Qnsol + Qsol*(1.0_R8-swpen(n)) ) / rcpocn - Fd = (prec(n) + rbot(n)*ustar*qstar ) * SSS / rhocn - - !--- COOL SKIN EFFECT --- - Dcool = lambdaV*molvisc(tBulk(n)) / ustarw - Qdel = Qnsol + Qsol * & - (0.137_R8 + 11.0_R8*Dcool - 6.6e-5/Dcool *(1.0_R8 - exp((-1.0_R8*Dcool)/8.0e-4))) - Hb = (Qdel/rcpocn)+(Fd*betaS/alphaT) - Hb = min(Hb , 0.0_R8) - - ! lambdaV = lambdaC*(1.0_R8 + ( (0.0_R8-Hb)*16.0_R8*molvisc(tBulk(n))* & - ! shr_const_g*alphaT*molPr(tBulk(n))**2/ustarw**4)**0.75)**(-1._R8/3._R8) - lambdaV = 6.5_R8 - cSkin(n) = MIN(0.0_R8, lambdaV * molPr(tBulk(n)) * Qdel / ustarw / rcpocn ) - - !--- REGIME --- - doL = shr_const_zsrflyr*shr_const_karman*shr_const_g* & - (alphaT*Hd + betaS*Fd ) / ustarw**3 - Rid = MAX(0.0_R8,Rid) - Smult = dt * (pwr+1.0_R8) / (shr_const_zsrflyr*pwr) - Sfact = dt * (pwr+1.0_R8) / (shr_const_zsrflyr)**2 - FofRi = 1.0_R8/(1.0_R8 + AMP*(Rid/Rizero)**pexp) - - if ( (doL.gt.0.0_R8) .and. (Qsol.gt.0.0) ) then - phid = MIN(1.0_R8 + 5.0_R8 * doL, 5.0_R8 + doL) - FofRi = 1.0_R8/(1.0_R8 + AMP*(Rid/Rizero)**pexp) - dif3 = (kappa0 + NUzero *FofRi) - - if ((doL.le.lambdaL).and.(NINT(regime(n)).le.2)) then - regime(n) = 2.0_R8 - Kdiff = shr_const_karman * ustarw * shr_const_zsrflyr / phid - Kvisc = Kdiff * (1.0_R8 - doL/lambdaL)**2 + & - dif3 * (doL/lambdaL)**2 * (3.0_R8 - 2.0_R8 * doL/lambdaL) - Kdiff = Kvisc - else - regime(n) = 3.0_R8 - Kdiff = kappa0 + NUzero * FofRi - Kvisc = Prandtl* kappa0 + NUzero * FofRi - endif - else - if (regime(n).eq.1.0_R8) then - Smult = 0.0_R8 - else - if (Ribulk .gt. Ricr) then - regime(n) = 3.0_R8 - Kdiff = kappa0 + NUzero * FofRi - Kvisc = Prandtl* kappa0 + NUzero * FofRi - else - regime(n) = 4.0_R8 - Kdiff = shr_const_karman*ustarw*shr_const_zsrflyr *cuberoot(1.0_R8-7.0_R8*doL) - Kvisc = Kdiff - endif - endif - - endif - - !--- IMPLICIT INTEGRATION --- - - DTiter = (warm(n) +(Smult*Hd)) /(1.+ Sfact*Kdiff) - DSiter = (salt(n) -(Smult*Fd)) /(1.+ Sfact*Kdiff) - DViter = (speed(n) +(Smult*ustarw*ustarw)) /(1.+ Sfact*Kvisc) - DTiter = MAX( 0.0_R8, DTiter) - DViter = MAX( 0.0_R8, DViter) - - Rid =(shr_const_g*(alphaT*DTiter-betaS*DSiter)*pwr*shr_const_zsrflyr) / & - (pwr*MAX(tiny,DViter))**2 - Ribulk = Rid * pwr - Ribulk = 0.0_R8 - tBulk(n) = ts(n) + DTiter - tSkin(n) = tBulk(n) + cskin(n) - - !--need to update ssq,delt,delq as function of tBulk ---- - - ssq = 0.98_R8 * qsat(tBulk(n)) / rbot(n) ! sea surf hum (kg/kg) - delt = thbot(n) - tBulk(n) ! pot temp diff (K) - delq = qbot(n) - ssq ! spec hum dif (kg/kg) - - !--- UPDATE FLUX ITERATION --- - - !!................................................................. - !! ocn_surface_flux_scheme = 0 : Default CESM1.2 - !! = 1 : COARE algorithm - !!................................................................. - if (ocn_surface_flux_scheme .eq. 0) then! use Large algorithm - - !--- compute stability & evaluate all stability functions --- - hol = shr_const_karman*shr_const_g*zbot(n)* & - (tstar/thbot(n)+qstar/(1.0_R8/shr_const_zvir+qbot(n)))/ustar**2 - hol = sign( min(abs(hol),10.0_R8), hol ) - stable = 0.5_R8 + sign(0.5_R8 , hol) - xsq = max(sqrt(abs(1.0_R8 - 16.0_R8*hol)) , 1.0_R8) - xqq = sqrt(xsq) - psimh = -5.0_R8*hol*stable + (1.0_R8-stable)*psimhu(xqq) - psixh = -5.0_R8*hol*stable + (1.0_R8-stable)*psixhu(xqq) - - !--- shift wind speed using old coefficient and stability function --- - rd = rdn / (1.0_R8 + rdn/shr_const_karman*(alz-psimh)) - u10n = vmag * rd / rdn - - !--- update neutral transfer coeffs at 10m - rdn = sqrt(cdn(u10n)) - rhn = (1.0_R8-stable) * 0.0327_R8 + stable * 0.018_R8 - ren = 0.0346_R8 - - !--- shift all coeffs to measurement height and stability --- - rd = rdn / (1.0_R8 + rdn/shr_const_karman*(alz-psimh)) - rh = rhn / (1.0_R8 + rhn/shr_const_karman*(alz-psixh)) - re = ren / (1.0_R8 + ren/shr_const_karman*(alz-psixh)) - - ustar = rd * vmag - tstar = rh * delt - qstar = re * delq - - !--- heat flux --- - - tau = rbot(n) * ustar * ustar - sen (n) = cp * tau * tstar / ustar - lat (n) = shr_const_latvap * tau * qstar / ustar - - else if (ocn_surface_flux_scheme .eq. 1) then! use COARE algorithm - - call cor30a(ubot(n),vbot(n),tbot(n),qbot(n),rbot(n) & ! in atm params - & ,us(n),vs(n),tBulk(n),ssq & ! in surf params (NB ts -> tBulk) - & ,zpbl,zbot(n),zbot(n),zref,ztref,ztref & ! in heights - & ,tau,hsb,hlb & ! out: fluxes - & ,zo,zot,zoq,hol,ustar,tstar,qstar & ! out: ss scales - & ,rd,rh,re & ! out: exch. coeffs - & ,trf,qrf,urf,vrf) ! out: reference-height params - - ! for the sake of maintaining same defs - hol=zbot(n)/hol - rd=sqrt(rd) - rh=sqrt(rh) - re=sqrt(re) - - !--- heat flux --- - sen (n) = hsb - lat (n) = hlb - - else ! N.B.: NO ocn_surface_flux_scheme=2 option - call shr_sys_abort(subName//", flux_diurnal requires ocn_surface_flux_scheme = 0 or 1") - endif - - enddo ! end iteration loop - if (iter < 1) then - call shr_sys_abort('No iterations performed ') - end if - - !--- COMPUTE FLUXES TO ATMOSPHERE AND OCEAN --- - - !--- momentum flux --- - taux(n) = tau * (ubot(n)-us(n)) / vmag - tauy(n) = tau * (vbot(n)-vs(n)) / vmag - - !--- LW radiation --- - lwup(n) = -shr_const_stebol * Tskin(n)**4 - - !--- water flux --- - evap(n) = lat(n)/shr_const_latvap - - !---water isotope flux --- - !!ZZZ bugfix to be done - call wiso_flxoce(2,rbot(n),zbot(n),s16O(n),ts(n),r16O(n),ustar,re,ssq, evap_16O(n),& - qbot(n),evap(n)) - call wiso_flxoce(3,rbot(n),zbot(n),sHDO(n),ts(n),rHDO(n),ustar,re,ssq, evap_HDO(n),& - qbot(n),evap(n)) - call wiso_flxoce(4,rbot(n),zbot(n),s18O(n),ts(n),r18O(n),ustar,re,ssq, evap_18O(n),& - qbot(n),evap(n)) - - !------------------------------------------------------------ - ! compute diagnostics: 2m ref T & Q, 10m wind speed squared - !------------------------------------------------------------ - - if (ocn_surface_flux_scheme .eq. 0) then ! use Large algorithm - - hol = hol*ztref/zbot(n) - xsq = max( 1.0_R8, sqrt(abs(1.0_R8-16.0_R8*hol)) ) - xqq = sqrt(xsq) - psix2 = -5.0_R8*hol*stable + (1.0_R8-stable)*psixhu(xqq) - fac = (rh/shr_const_karman) * (alz + al2 - psixh + psix2 ) - tref(n) = thbot(n) - delt*fac - tref(n) = tref(n) - 0.01_R8*ztref ! pot temp to temp correction - fac = (re/shr_const_karman) * (alz + al2 - psixh + psix2 ) - qref(n) = qbot(n) - delq*fac - - duu10n(n) = u10n*u10n ! 10m wind speed squared - - else if (ocn_surface_flux_scheme .eq. 1) then! use COARE algorithm - - tref(n) = trf - qref(n) = qrf - duu10n(n) = urf**2+vrf**2 - u10n = sqrt(duu10n(n)) - endif - - !------------------------------------------------------------ - ! update new prognostic variables - !------------------------------------------------------------ - - warm (n) = DTiter - salt (n) = DSiter - speed (n) = DViter - - if (ltwopm) then - tSkin_day(n) = tSkin(n) - warmmax(n) = max(DTiter,0.0_R8) - endif - - if (ltwoam) then - tSkin_night(n) = tSkin(n) - cSkin_night(n) = cSkin(n) - endif - - if ((lmidnight).and.(lfullday)) then - qSolAvg(n) = qSolInc(n)/real(nsum+1,R8) - windAvg(n) = windInc(n)/real(nsum+1,R8) - ! warmMax(n) = max(DTiter,warmMaxInc(n)) - windMax(n) = max(u10n,windMaxInc(n)) - - nsum = 0 - - qSolInc(n) = Qsol - windInc(n) = u10n - - ! warmMaxInc(n) = 0.0_R8 - windMaxInc(n) = 0.0_R8 - endif - - nInc(n) = real(nsum,R8) ! set nInc to incremented or reset nsum - - if (present(ustar_sv)) ustar_sv(n) = ustar - if (present(re_sv )) re_sv (n) = re - if (present(ssq_sv )) ssq_sv (n) = ssq - - else ! mask = 0 - - !------------------------------------------------------------ - ! no valid data here -- out of domain - !------------------------------------------------------------ - warm (n) = spval - salt (n) = spval - speed (n) = spval - regime (n) = spval - tBulk (n) = spval - tSkin (n) = spval - tSkin_night(n) = spval - tSkin_day (n) = spval - cSkin (n) = spval - cSkin_night(n) = spval - warmMax (n) = spval - windMax (n) = spval - qSolAvg (n) = spval - windAvg (n) = spval - warmMaxInc (n) = spval - windMaxInc (n) = spval - qSolInc (n) = spval - windInc (n) = spval - nInc (n) = 0.0_R8 - - sen (n) = spval ! sensible heat flux (W/m^2) - lat (n) = spval ! latent heat flux (W/m^2) - lwup (n) = spval ! long-wave upward heat flux (W/m^2) - evap (n) = spval ! evaporative water flux ((kg/s)/m^2) - evap_16O (n) = spval ! water tracer flux (kg/s)/m^2) - evap_HDO (n) = spval ! HDO tracer flux (kg/s)/m^2) - evap_18O (n) = spval ! H218O tracer flux (kg/s)/m^2) - taux (n) = spval ! x surface stress (N) - tauy (n) = spval ! y surface stress (N) - tref (n) = spval ! 2m reference height temperature (K) - qref (n) = spval ! 2m reference height humidity (kg/kg) - duu10n(n) = spval ! 10m wind speed squared (m/s)^2 - - if (present(ustar_sv)) ustar_sv(n) = spval - if (present(re_sv )) re_sv (n) = spval - if (present(ssq_sv )) ssq_sv (n) = spval - - endif ! mask - end DO ! loop over n - - end subroutine flux_atmOcn_diurnal + subroutine flux_atmOcn_diurnal( & + logunit, spval, ocn_surface_flux_scheme, & + nMax, zbot, ubot, vbot, thbot, & + qbot, rbot, tbot, us, vs, & + ts, mask, seq_flux_atmocn_minwind, & + sen, lat, lwup, & + evap, taux, tauy, tref, qref, & + uGust, lwdn, swdn, swup, prec, & + swpen, ocnsal, ocn_prognostic, & + latt, long, warm, salt, speed, regime, & + warmMax, windMax, qSolAvg, windAvg, & + warmMaxInc, windMaxInc, qSolInc, windInc, nInc, & + tBulk, tSkin, tSkin_day, tSkin_night, & + cSkin, cSkin_night, secs, dt, & + duu10n, ustar_sv, re_sv, ssq_sv, cold_start) + + ! Arguments + ! + integer ,intent(in) :: logunit + real(r8) ,intent(in) :: spval + integer ,intent(in) :: ocn_surface_flux_scheme + integer ,intent(in) :: nMax ! data vector length + integer ,intent(in) :: mask (nMax) ! ocn domain mask 0 <=> out of domain + real(R8) ,intent(in) :: zbot (nMax) ! atm level height(m) + real(R8) ,intent(in) :: ubot (nMax) ! atm u wind(m/s) + real(R8) ,intent(in) :: vbot (nMax) ! atm v wind(m/s) + real(R8) ,intent(in) :: thbot(nMax) ! atm potential T (K) + real(R8) ,intent(in) :: qbot (nMax) ! atm specific humidity(kg/kg) + real(R8) ,intent(in) :: rbot (nMax) ! atm air density(kg/m^3) + real(R8) ,intent(in) :: tbot (nMax) ! atm T(K) + real(R8) ,intent(in) :: us (nMax) ! ocn u-velocity (m/s) + real(R8) ,intent(in) :: vs (nMax) ! ocn v-velocity (m/s) + real(R8) ,intent(in) :: ts (nMax) ! ocn temperature(K) + real(R8) ,intent(in) :: uGust (nMax) ! NEW not used + real(R8) ,intent(in) :: lwdn (nMax) ! NEW + real(R8) ,intent(in) :: swdn (nMax) ! NEW + real(R8) ,intent(in) :: swup (nMax) ! NEW + real(R8) ,intent(in) :: prec (nMax) ! NEW + real(R8) ,intent(in) :: latt (nMax) ! NEW + real(R8) ,intent(in) :: long (nMax) ! NEW + logical ,intent(in) :: ocn_prognostic ! NEW + integer ,intent(in) :: secs ! NEW elsapsed seconds in day (GMT) + integer ,intent(in) :: dt ! NEW + real(R8) ,intent(inout) :: swpen (nMax) ! NEW + real(R8) ,intent(inout) :: ocnsal(nMax) ! NEW (kg/kg) + real(R8) ,intent(inout) :: warm (nMax) ! NEW + real(R8) ,intent(inout) :: salt (nMax) ! NEW + real(R8) ,intent(inout) :: speed (nMax) ! NEW + real(R8) ,intent(inout) :: regime(nMax) ! NEW + real(R8) ,intent(out) :: warmMax(nMax) ! NEW + real(R8) ,intent(out) :: windMax(nMax) ! NEW + real(R8) ,intent(inout) :: qSolAvg(nMax) ! NEW + real(R8) ,intent(inout) :: windAvg(nMax) ! NEW + real(R8) ,intent(inout) :: warmMaxInc(nMax) ! NEW + real(R8) ,intent(inout) :: windMaxInc(nMax) ! NEW + real(R8) ,intent(inout) :: qSolInc(nMax) ! NEW + real(R8) ,intent(inout) :: windInc(nMax) ! NEW + real(R8) ,intent(inout) :: nInc(nMax) ! NEW + real(R8) ,intent(out) :: tBulk (nMax) ! NEW + real(R8) ,intent(out) :: tSkin (nMax) ! NEW + real(R8) ,intent(out) :: tSkin_day (nMax) ! NEW + real(R8) ,intent(out) :: tSkin_night (nMax) ! NEW + real(R8) ,intent(out) :: cSkin (nMax) ! NEW + real(R8) ,intent(out) :: cSkin_night (nMax) ! NEW + logical ,intent(in) :: cold_start ! cold start flag + real(R8) ,intent(in) :: seq_flux_atmocn_minwind ! minimum wind speed for atmocn (m/s) + real(R8) ,intent(out) :: sen (nMax) ! heat flux: sensible (W/m^2) + real(R8) ,intent(out) :: lat (nMax) ! heat flux: latent (W/m^2) + real(R8) ,intent(out) :: lwup (nMax) ! heat flux: lw upward (W/m^2) + real(R8) ,intent(out) :: evap (nMax) ! water flux: evap ((kg/s)/m^2) + real(R8) ,intent(out) :: taux (nMax) ! surface stress, zonal (N) + real(R8) ,intent(out) :: tauy (nMax) ! surface stress, maridional (N) + real(R8) ,intent(out) :: tref (nMax) ! diag: 2m ref height T (K) + real(R8) ,intent(out) :: qref (nMax) ! diag: 2m ref humidity (kg/kg) + real(R8) ,intent(out) :: duu10n(nMax) ! diag: 10m wind speed squared (m/s)^2 + real(R8) ,intent(out),optional :: ustar_sv(nMax) ! diag: ustar + real(R8) ,intent(out),optional :: re_sv (nMax) ! diag: sqrt of exchange coefficient (water) + real(R8) ,intent(out),optional :: ssq_sv (nMax) ! diag: sea surface humidity (kg/kg) + + !--- local constants -------------------------------- + real(R8),parameter :: zref = 10.0_R8 ! reference height (m) + real(R8),parameter :: ztref = 2.0_R8 ! reference height for air T (m) + + real(R8),parameter :: lambdaC = 6.0_R8 + real(R8),parameter :: lambdaL = 0.0_R8 + real(R8),parameter :: doLMax = 1.0_R8 + real(R8),parameter :: pwr = 0.2_R8 + real(R8),parameter :: Rizero = 1.0_R8 + real(R8),parameter :: NUzero = 40.0e-4_R8 + real(R8),parameter :: Prandtl = 1.0_R8 + real(R8),parameter :: kappa0 = 0.2e-4_R8 + + real(R8),parameter :: F0 = 0.5_R8 + real(R8),parameter :: F1 = 0.15_R8 + real(R8),parameter :: R1 = 10.0_R8 + + real(R8),parameter :: Ricr = 0.30_R8 + real(R8),parameter :: tiny = 1.0e-12_R8 + real(R8),parameter :: tiny2 = 1.0e-6_R8 + real(R8),parameter :: pi = SHR_CONST_PI + + !!++ COARE only + real(R8),parameter :: zpbl =700.0_R8 ! PBL depth [m] for gustiness parametriz. + + !--- local variables -------------------------------- + integer(IN) :: n ! vector loop index + integer(IN) :: iter ! iteration loop index + integer(IN) :: lsecs ! local seconds elapsed + integer(IN) :: lonsecs ! incrememnt due to lon offset + real(R8) :: vmag ! surface wind magnitude (m/s) + real(R8) :: ssq ! sea surface humidity (kg/kg) + real(R8) :: delt ! potential T difference (K) + real(R8) :: delq ! humidity difference (kg/kg) + real(R8) :: stable ! stability factor + real(R8) :: rdn ! sqrt of neutral exchange coeff (momentum) + real(R8) :: rhn ! sqrt of neutral exchange coeff (heat) + real(R8) :: ren ! sqrt of neutral exchange coeff (water) + real(R8) :: rd ! sqrt of exchange coefficient (momentum) + real(R8) :: rh ! sqrt of exchange coefficient (heat) + real(R8) :: re ! sqrt of exchange coefficient (water) + real(R8) :: ustar ! ustar + real(R8) :: ustar_prev ! ustar + real(R8) :: qstar ! qstar + real(R8) :: tstar ! tstar + real(R8) :: hol ! H (at zbot) over L + real(R8) :: xsq ! ? + real(R8) :: xqq ! ? + real(R8) :: psimh ! stability function at zbot (momentum) + real(R8) :: psixh ! stability function at zbot (heat and water) + real(R8) :: psix2 ! stability function at ztref reference height + real(R8) :: alz ! ln(zbot/zref) + real(R8) :: al2 ! ln(zref/ztref) + real(R8) :: u10n ! 10m neutral wind + real(R8) :: tau ! stress at zbot + real(R8) :: cp ! specific heat of moist air + real(R8) :: fac ! vertical interpolation factor + real(R8) :: DTiter ! + real(R8) :: DSiter ! + real(R8) :: DViter ! + + real(R8) :: Dcool ! + real(R8) :: Qdel ! net cool skin heating + real(R8) :: Hd ! net heating above -z=d + real(R8) :: Hb ! net kinematic heating above -z = delta + real(R8) :: lambdaV ! + real(R8) :: Fd ! net fresh water forcing above -z=d + real(R8) :: ustarw ! surface wind forcing of layer above -z=d + + real(R8) :: Qsol ! solar heat flux (W/m2) + real(R8) :: Qnsol ! non-solar heat flux (W/m2) + + real(R8) :: SSS ! sea surface salinity + real(R8) :: alphaT ! + real(R8) :: betaS ! + + real(R8) :: doL ! ocean forcing stablity parameter + real(R8) :: Rid ! Richardson number at depth d + real(R8) :: Ribulk ! Bulk Richardson number at depth d + real(R8) :: FofRi ! Richardon number dependent diffusivity + real(R8) :: Smult ! multiplicative term based on regime + real(R8) :: Sfact ! multiplicative term based on regime + real(R8) :: Kdiff ! diffusive term based on regime + real(R8) :: Kvisc ! viscosity term based on regime + real(R8) :: rhocn ! + real(R8) :: rcpocn ! + real(R8) :: Nreset ! value for multiplicative reset factor + logical :: lmidnight + logical :: ltwopm + logical :: ltwoam + logical :: lfullday + integer :: nsum + real(R8) :: pexp ! eqn 19 + real(R8) :: AMP ! eqn 18 + real(R8) :: dif3 + real(R8) :: phid + + !!++ COARE only + real(R8) :: zo,zot,zoq ! roughness lengths + real(R8) :: hsb,hlb ! sens & lat heat flxs at zbot + real(R8) :: trf,qrf,urf,vrf ! reference-height quantities + + !--- local functions -------------------------------- + real(R8) :: qsat ! function: the saturation humididty of air (kg/m^3) + real(R8) :: cdn ! function: neutral drag coeff at 10m + real(R8) :: psimhu ! function: unstable part of psimh + real(R8) :: psixhu ! function: unstable part of psimx + real(R8) :: Umps ! dummy arg ~ wind velocity (m/s) + real(R8) :: Tk ! dummy arg ~ temperature (K) + real(R8) :: xd ! dummy arg ~ ? + real(R8) :: molvisc ! molecular viscosity + real(R8) :: molPr ! molecular Prandtl number + + !--- for cold air outbreak calc -------------------------------- + real(R8) :: tdiff(nMax) ! tbot - ts + real(R8) :: vscl + + qsat(Tk) = 640380.0_R8 / exp(5107.4_R8/Tk) + cdn(Umps) = 0.0027_R8 / Umps + 0.000142_R8 + 0.0000764_R8 * Umps + psimhu(xd) = log((1.0_R8+xd*(2.0_R8+xd))*(1.0_R8+xd*xd)/8.0_R8) - 2.0_R8*atan(xd) + 1.571_R8 + psixhu(xd) = 2.0_R8 * log((1.0_R8 + xd*xd)/2.0_R8) + molvisc(Tk) = 1.623e-6_R8 * exp((-1.0_R8*(Tk-273.15_R8))/45.2_R8) + molPr(Tk) = 11.64_R8 * exp((-1.0_R8*(Tk-273.15_R8))/40.7_R8) + + !--- formats ---------------------------------------- + character(*),parameter :: subName = '(flux_atmOcn_diurnal) ' + character(*),parameter :: F00 = "('(flux_atmOcn_diurnal) ',4a)" + + if (debug > 0) write(logunit,F00) "enter" + + rh = spval + dviter = spval + dtiter = spval + dsiter = spval + al2 = log(zref/ztref) + + !--- for cold air outbreak calc -------------------------------- + tdiff= tbot - ts + + ! equations 18 and 19 + AMP = 1.0_R8/F0-1.0_R8 + pexp = log( (1.0_R8/F1-F0) / (1.0_R8-F0) ) / log(R1) + + if (.not. ocn_prognostic) then + ! Set swpen and ocean salinity from following analytic expressions + swpen(:) = 0.67_R8*(exp((-1._R8*shr_const_zsrflyr)/1.0_R8)) + & + 0.33_R8*exp((-1._R8*shr_const_zsrflyr)/17.0_R8) + ocnsal(:) = shr_const_ocn_ref_sal/1000.0_R8 + else + ! use swpen and ocnsal from input argument + endif + + if (cold_start) then + write(logunit,F00) "Initialize diurnal cycle fields" + warm (:) = 0.0_R8 + salt (:) = 0.0_R8 + speed (:) = 0.0_R8 + regime (:) = 0.0_R8 + qSolAvg (:) = 0.0_R8 + windAvg (:) = 0.0_R8 + warmMax (:) = 0.0_R8 + windMax (:) = 0.0_R8 + warmMaxInc (:) = 0.0_R8 + windMaxInc (:) = 0.0_R8 + qSolInc (:) = 0.0_R8 + windInc (:) = 0.0_R8 + nInc (:) = 0.0_R8 + tSkin_day (:) = ts(:) + tSkin_night(:) = ts(:) + cSkin_night(:) = 0.0_R8 + endif + u10n = 0.0_r8 + stable = 0.0_r8 + DO n=1,nMax + + if (mask(n) /= 0) then + + !--- compute some initial and useful flux quantities --- + + vmag = max(seq_flux_atmocn_minwind, sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2) ) + if (use_coldair_outbreak_mod) then + ! Cold Air Outbreak Modification: + ! Increase windspeed for negative tbot-ts + ! based on Mahrt & Sun 1995,MWR + + if (tdiff(n).lt.td0) then + vscl=min((1._R8+alpha*(abs(tdiff(n)-td0)**0.5_R8/abs(vmag))),maxscl) + vmag=vmag*vscl + endif + endif + alz = log(zbot(n)/zref) + hol = 0.0 + psimh = 0.0 + psixh = 0.0 + rdn = sqrt(cdn(vmag)) + + tBulk(n) = ts(n)+warm(n) ! first guess for tBulk from read in ts,warm + tSkin(n) = tBulk(n) + Qsol = swdn(n) + swup(n) + SSS = 1000.0_R8*ocnsal(n)+salt(n) + lambdaV = lambdaC + + alphaT = 0.000297_R8*(1.0_R8+0.0256_R8*(ts(n)-298.15_R8)+0.003_R8*(SSS - 35.0_R8)) + betaS = 0.000756_R8*(1.0_R8-0.0016_R8*(ts(n)-298.15_R8)) + rhocn = 1023.342_R8*(1.0_R8-0.000297_R8*(ts(n)-298.15_R8)+0.000756_R8 * (SSS - 35.0_R8)) + rcpocn = rhocn * 3990.0_R8*(1.0_R8-0.0012_R8*(SSS - 35.0_R8)) + + Rid = shr_const_g * (alphaT*warm(n) - betaS*salt(n)) *pwr*shr_const_zsrflyr / & + ( pwr*MAX(tiny,speed(n)) )**2 + + Ribulk = 0.0 + + !---------------------------------------------------------- + ! convert elapsed time from GMT to local & + ! check elapsed time. reset warm if near lsecs = reset_sec + !---------------------------------------------------------- + Nreset = 1.0_R8 + + lonsecs = ceiling(long(n)/360.0_R8*86400.0) + lsecs = mod(secs + lonsecs,86400) + + lmidnight = (lsecs >= 0 .and. lsecs < dt) ! 0 = midnight + ltwopm = (lsecs >= 48600 .and. lsecs < 48600+dt) ! 48600 = 1:30pm + ltwoam = (lsecs >= 5400 .and. lsecs < 5400 +dt) ! 5400 = 1:30am + lfullday = (lsecs > 86400-dt .and. lsecs <= 86400) + nsum = nint(nInc(n)) + + if ( lmidnight ) then + Regime(n) = 1.0_R8 ! RESET DIURNAL + warm(n) = 0.0_R8 + salt(n) = 0.0_R8 + speed(n) = 0.0_R8 + endif + + ssq = 0.98_R8 * qsat(tBulk(n)) / rbot(n) ! sea surf hum (kg/kg) + delt = thbot(n) - tBulk(n) ! pot temp diff (K) + delq = qbot(n) - ssq ! spec hum dif (kg/kg) + cp = shr_const_cpdair*(1.0_R8 + shr_const_cpvir*ssq) + + !!................................................................. + !! ocn_surface_flux_scheme = 0 : Default E3SMv1 + !! = 1 : COARE algorithm + !!................................................................. + if (ocn_surface_flux_scheme .eq. 0) then! use Large algorithm + stable = 0.5_R8 + sign(0.5_R8 , delt) + + + !--- shift wind speed using old coefficient and stability function + + rd = rdn / (1.0_R8 + rdn/shr_const_karman*(alz-psimh)) + u10n = vmag * rd / rdn + + !--- initial neutral transfer coeffs at 10m + rdn = sqrt(cdn(u10n)) + rhn = (1.0_R8-stable) * 0.0327_R8 + stable * 0.018_R8 + ren = 0.0346_R8 + + !--- initial ustar, tstar, qstar --- + ustar = rdn * vmag + tstar = rhn * delt + qstar = ren * delq + + else if (ocn_surface_flux_scheme .eq. 1) then! use COARE algorithm + + call cor30a(ubot(n),vbot(n),tbot(n),qbot(n),rbot(n) & ! in atm params + & ,us(n),vs(n),tBulk(n),ssq & ! in surf params (NB ts -> tBulk) + & ,zpbl,zbot(n),zbot(n),zref,ztref,ztref & ! in heights + & ,tau,hsb,hlb & ! out: fluxes + & ,zo,zot,zoq,hol,ustar,tstar,qstar & ! out: ss scales + & ,rd,rh,re & ! out: exch. coeffs + & ,trf,qrf,urf,vrf) ! out: reference-height params + + ! for the sake of maintaining same defs + hol=zbot(n)/hol + rd=sqrt(rd) + rh=sqrt(rh) + re=sqrt(re) + + ELSE ! N.B.: *no* valid ocn_surface_flux_scheme=2 option if diurnal=.true. + + call shr_sys_abort(subName//" flux_atmOcn_diurnal requires ocn_surface_flux_scheme = 0 or 1") + + ENDIF + + ustar_prev = ustar * 2.0_R8 + iter = 0 + ! --- iterate --- + ! Originally this code did three iterations while the non-diurnal version did two + ! So in the new loop this is <= flux_con_max_iter instead of < so that the same defaults + ! will give the same answers in both cases. + do while( abs((ustar - ustar_prev)/ustar) > flux_con_tol .and. iter <= flux_con_max_iter) + iter = iter + 1 + ustar_prev = ustar + !------------------------------------------------------------ + ! iterate to converge on FLUXES Z/L, ustar, tstar and qstar + ! and on Rid in the DIURNAL CYCLE + !------------------------------------------------------------ + Smult = 0.0_R8 + Sfact = 0.0_R8 + Kdiff = 0.0_R8 + Kvisc = 0.0_R8 + dif3 = 0.0_R8 + + ustarw = ustar*sqrt(max(tiny,rbot(n)/rhocn)) + Qnsol = lwdn(n) - shr_const_stebol*(tSkin(n))**4 + & + rbot(n)*ustar*(cp*tstar + shr_const_latvap*qstar) + Hd = (Qnsol + Qsol*(1.0_R8-swpen(n)) ) / rcpocn + Fd = (prec(n) + rbot(n)*ustar*qstar ) * SSS / rhocn + + !--- COOL SKIN EFFECT --- + Dcool = lambdaV*molvisc(tBulk(n)) / ustarw + Qdel = Qnsol + Qsol * & + (0.137_R8 + 11.0_R8*Dcool - 6.6e-5/Dcool *(1.0_R8 - exp((-1.0_R8*Dcool)/8.0e-4))) + Hb = (Qdel/rcpocn)+(Fd*betaS/alphaT) + Hb = min(Hb , 0.0_R8) + + ! lambdaV = lambdaC*(1.0_R8 + ( (0.0_R8-Hb)*16.0_R8*molvisc(tBulk(n))* & + ! shr_const_g*alphaT*molPr(tBulk(n))**2/ustarw**4)**0.75)**(-1._R8/3._R8) + lambdaV = 6.5_R8 + cSkin(n) = MIN(0.0_R8, lambdaV * molPr(tBulk(n)) * Qdel / ustarw / rcpocn ) + + !--- REGIME --- + doL = shr_const_zsrflyr*shr_const_karman*shr_const_g* & + (alphaT*Hd + betaS*Fd ) / ustarw**3 + Rid = MAX(0.0_R8,Rid) + Smult = dt * (pwr+1.0_R8) / (shr_const_zsrflyr*pwr) + Sfact = dt * (pwr+1.0_R8) / (shr_const_zsrflyr)**2 + FofRi = 1.0_R8/(1.0_R8 + AMP*(Rid/Rizero)**pexp) + + if ( (doL.gt.0.0_R8) .and. (Qsol.gt.0.0) ) then + phid = MIN(1.0_R8 + 5.0_R8 * doL, 5.0_R8 + doL) + FofRi = 1.0_R8/(1.0_R8 + AMP*(Rid/Rizero)**pexp) + dif3 = (kappa0 + NUzero *FofRi) + + if ((doL.le.lambdaL).and.(NINT(regime(n)).le.2)) then + regime(n) = 2.0_R8 + Kdiff = shr_const_karman * ustarw * shr_const_zsrflyr / phid + Kvisc = Kdiff * (1.0_R8 - doL/lambdaL)**2 + & + dif3 * (doL/lambdaL)**2 * (3.0_R8 - 2.0_R8 * doL/lambdaL) + Kdiff = Kvisc + else + regime(n) = 3.0_R8 + Kdiff = kappa0 + NUzero * FofRi + Kvisc = Prandtl* kappa0 + NUzero * FofRi + endif + else + if (regime(n).eq.1.0_R8) then + Smult = 0.0_R8 + else + if (Ribulk .gt. Ricr) then + regime(n) = 3.0_R8 + Kdiff = kappa0 + NUzero * FofRi + Kvisc = Prandtl* kappa0 + NUzero * FofRi + else + regime(n) = 4.0_R8 + Kdiff = shr_const_karman*ustarw*shr_const_zsrflyr *cuberoot(1.0_R8-7.0_R8*doL) + Kvisc = Kdiff + endif + endif + + endif + + !--- IMPLICIT INTEGRATION --- + + DTiter = (warm(n) +(Smult*Hd)) /(1.+ Sfact*Kdiff) + DSiter = (salt(n) -(Smult*Fd)) /(1.+ Sfact*Kdiff) + DViter = (speed(n) +(Smult*ustarw*ustarw)) /(1.+ Sfact*Kvisc) + DTiter = MAX( 0.0_R8, DTiter) + DViter = MAX( 0.0_R8, DViter) + + Rid =(shr_const_g*(alphaT*DTiter-betaS*DSiter)*pwr*shr_const_zsrflyr) / & + (pwr*MAX(tiny,DViter))**2 + Ribulk = Rid * pwr + Ribulk = 0.0_R8 + tBulk(n) = ts(n) + DTiter + tSkin(n) = tBulk(n) + cskin(n) + + !--need to update ssq,delt,delq as function of tBulk ---- + + ssq = 0.98_R8 * qsat(tBulk(n)) / rbot(n) ! sea surf hum (kg/kg) + delt = thbot(n) - tBulk(n) ! pot temp diff (K) + delq = qbot(n) - ssq ! spec hum dif (kg/kg) + + !--- UPDATE FLUX ITERATION --- + + !!................................................................. + !! ocn_surface_flux_scheme = 0 : Default CESM1.2 + !! = 1 : COARE algorithm + !!................................................................. + if (ocn_surface_flux_scheme .eq. 0) then! use Large algorithm + + !--- compute stability & evaluate all stability functions --- + hol = shr_const_karman*shr_const_g*zbot(n)* & + (tstar/thbot(n)+qstar/(1.0_R8/shr_const_zvir+qbot(n)))/ustar**2 + hol = sign( min(abs(hol),10.0_R8), hol ) + stable = 0.5_R8 + sign(0.5_R8 , hol) + xsq = max(sqrt(abs(1.0_R8 - 16.0_R8*hol)) , 1.0_R8) + xqq = sqrt(xsq) + psimh = -5.0_R8*hol*stable + (1.0_R8-stable)*psimhu(xqq) + psixh = -5.0_R8*hol*stable + (1.0_R8-stable)*psixhu(xqq) + + !--- shift wind speed using old coefficient and stability function --- + rd = rdn / (1.0_R8 + rdn/shr_const_karman*(alz-psimh)) + u10n = vmag * rd / rdn + + !--- update neutral transfer coeffs at 10m + rdn = sqrt(cdn(u10n)) + rhn = (1.0_R8-stable) * 0.0327_R8 + stable * 0.018_R8 + ren = 0.0346_R8 + + !--- shift all coeffs to measurement height and stability --- + rd = rdn / (1.0_R8 + rdn/shr_const_karman*(alz-psimh)) + rh = rhn / (1.0_R8 + rhn/shr_const_karman*(alz-psixh)) + re = ren / (1.0_R8 + ren/shr_const_karman*(alz-psixh)) + + ustar = rd * vmag + tstar = rh * delt + qstar = re * delq + + !--- heat flux --- + + tau = rbot(n) * ustar * ustar + sen (n) = cp * tau * tstar / ustar + lat (n) = shr_const_latvap * tau * qstar / ustar + + else if (ocn_surface_flux_scheme .eq. 1) then! use COARE algorithm + + call cor30a(ubot(n),vbot(n),tbot(n),qbot(n),rbot(n) & ! in atm params + & ,us(n),vs(n),tBulk(n),ssq & ! in surf params (NB ts -> tBulk) + & ,zpbl,zbot(n),zbot(n),zref,ztref,ztref & ! in heights + & ,tau,hsb,hlb & ! out: fluxes + & ,zo,zot,zoq,hol,ustar,tstar,qstar & ! out: ss scales + & ,rd,rh,re & ! out: exch. coeffs + & ,trf,qrf,urf,vrf) ! out: reference-height params + + ! for the sake of maintaining same defs + hol=zbot(n)/hol + rd=sqrt(rd) + rh=sqrt(rh) + re=sqrt(re) + + !--- heat flux --- + sen (n) = hsb + lat (n) = hlb + + else ! N.B.: NO ocn_surface_flux_scheme=2 option + call shr_sys_abort(subName//", flux_diurnal requires ocn_surface_flux_scheme = 0 or 1") + endif + + enddo ! end iteration loop + if (iter < 1) then + call shr_sys_abort('No iterations performed ') + end if + + !--- COMPUTE FLUXES TO ATMOSPHERE AND OCEAN --- + + !--- momentum flux --- + taux(n) = tau * (ubot(n)-us(n)) / vmag + tauy(n) = tau * (vbot(n)-vs(n)) / vmag + + !--- LW radiation --- + lwup(n) = -shr_const_stebol * Tskin(n)**4 + + !--- water flux --- + evap(n) = lat(n)/shr_const_latvap + + !------------------------------------------------------------ + ! compute diagnostics: 2m ref T & Q, 10m wind speed squared + !------------------------------------------------------------ + + if (ocn_surface_flux_scheme .eq. 0) then ! use Large algorithm + + hol = hol*ztref/zbot(n) + xsq = max( 1.0_R8, sqrt(abs(1.0_R8-16.0_R8*hol)) ) + xqq = sqrt(xsq) + psix2 = -5.0_R8*hol*stable + (1.0_R8-stable)*psixhu(xqq) + fac = (rh/shr_const_karman) * (alz + al2 - psixh + psix2 ) + tref(n) = thbot(n) - delt*fac + tref(n) = tref(n) - 0.01_R8*ztref ! pot temp to temp correction + fac = (re/shr_const_karman) * (alz + al2 - psixh + psix2 ) + qref(n) = qbot(n) - delq*fac + + duu10n(n) = u10n*u10n ! 10m wind speed squared + + else if (ocn_surface_flux_scheme .eq. 1) then! use COARE algorithm + + tref(n) = trf + qref(n) = qrf + duu10n(n) = urf**2+vrf**2 + u10n = sqrt(duu10n(n)) + endif + + !------------------------------------------------------------ + ! update new prognostic variables + !------------------------------------------------------------ + + warm (n) = DTiter + salt (n) = DSiter + speed (n) = DViter + + if (ltwopm) then + tSkin_day(n) = tSkin(n) + warmmax(n) = max(DTiter,0.0_R8) + endif + + if (ltwoam) then + tSkin_night(n) = tSkin(n) + cSkin_night(n) = cSkin(n) + endif + + if ((lmidnight).and.(lfullday)) then + qSolAvg(n) = qSolInc(n)/real(nsum+1,R8) + windAvg(n) = windInc(n)/real(nsum+1,R8) + ! warmMax(n) = max(DTiter,warmMaxInc(n)) + windMax(n) = max(u10n,windMaxInc(n)) + + nsum = 0 + + qSolInc(n) = Qsol + windInc(n) = u10n + + ! warmMaxInc(n) = 0.0_R8 + windMaxInc(n) = 0.0_R8 + endif + + nInc(n) = real(nsum,R8) ! set nInc to incremented or reset nsum + + if (present(ustar_sv)) ustar_sv(n) = ustar + if (present(re_sv )) re_sv (n) = re + if (present(ssq_sv )) ssq_sv (n) = ssq + + else ! mask = 0 + + !------------------------------------------------------------ + ! no valid data here -- out of domain + !------------------------------------------------------------ + warm (n) = spval + salt (n) = spval + speed (n) = spval + regime (n) = spval + tBulk (n) = spval + tSkin (n) = spval + tSkin_night(n) = spval + tSkin_day (n) = spval + cSkin (n) = spval + cSkin_night(n) = spval + warmMax (n) = spval + windMax (n) = spval + qSolAvg (n) = spval + windAvg (n) = spval + warmMaxInc (n) = spval + windMaxInc (n) = spval + qSolInc (n) = spval + windInc (n) = spval + nInc (n) = 0.0_R8 + sen (n) = spval ! sensible heat flux (W/m^2) + lat (n) = spval ! latent heat flux (W/m^2) + lwup (n) = spval ! long-wave upward heat flux (W/m^2) + evap (n) = spval ! evaporative water flux ((kg/s)/m^2) + taux (n) = spval ! x surface stress (N) + tauy (n) = spval ! y surface stress (N) + tref (n) = spval ! 2m reference height temperature (K) + qref (n) = spval ! 2m reference height humidity (kg/kg) + duu10n(n) = spval ! 10m wind speed squared (m/s)^2 + + if (present(ustar_sv)) ustar_sv(n) = spval + if (present(re_sv )) re_sv (n) = spval + if (present(ssq_sv )) ssq_sv (n) = spval + + endif ! mask + end DO ! loop over n + + end subroutine flux_atmOcn_diurnal ! =================================================================== diff --git a/cesm/flux_atmocn/flux_atmocn_Large.F90 b/cesm/flux_atmocn/flux_atmocn_Large.F90 index c3403d564..0c2b092de 100644 --- a/cesm/flux_atmocn/flux_atmocn_Large.F90 +++ b/cesm/flux_atmocn/flux_atmocn_Large.F90 @@ -25,7 +25,6 @@ module flux_atmOcn_large_mod use shr_flux_mod, only: flux_con_tol, flux_con_max_iter use shr_flux_mod, only: alpha, maxscl, td0 use shr_sys_mod, only: shr_sys_abort - use water_isotopes, only: wiso_flxoce !subroutine used to calculate water isotope fluxes. implicit none public @@ -37,12 +36,9 @@ module flux_atmOcn_large_mod subroutine flux_atmOcn_large( & logunit, spval, nMax, & zbot, ubot, vbot, thbot, & - qbot, rainc, s16O, sHDO, s18O, rbot, & - tbot, us, vs, pslv, & + qbot, rainc, tbot, us, vs, pslv, & ts, mask, seq_flux_atmocn_minwind, & - sen, lat, lwup, & - r16O, rhdo, r18O, & - evap, evap_16O, evap_HDO, evap_18O, & + sen, lat, lwup, evap, & taux, tauy, tref, qref, & add_gusts, duu10n, ugust_out, u10res, & ustar_sv, re_sv, ssq_sv) @@ -59,12 +55,6 @@ subroutine flux_atmOcn_large( & real(R8) ,intent(in) :: thbot(nMax) ! atm potential T (K) real(R8) ,intent(in) :: qbot (nMax) ! atm specific humidity (kg/kg) real(R8) ,intent(in) :: rainc(nMax) ! atm precip for convective gustiness (kg/m^3) - RBN 24Nov2008/MDF 31Jan2022 - real(R8) ,intent(in) :: s16O (nMax) ! atm H216O tracer conc. (kg/kg) - real(R8) ,intent(in) :: sHDO (nMax) ! atm HDO tracer conc. (kg/kg) - real(R8) ,intent(in) :: s18O (nMax) ! atm H218O tracer conc. (kg/kg) - real(R8) ,intent(in) :: r16O (nMax) ! ocn H216O tracer ratio/Rstd - real(R8) ,intent(in) :: rHDO (nMax) ! ocn HDO tracer ratio/Rstd - real(R8) ,intent(in) :: r18O (nMax) ! ocn H218O tracer ratio/Rstd real(R8) ,intent(in) :: rbot (nMax) ! atm air density (kg/m^3) real(R8) ,intent(in) :: tbot (nMax) ! atm T (K) real(R8) ,intent(in) :: pslv (nMax) ! atm sea level pressure(Pa) @@ -78,9 +68,6 @@ subroutine flux_atmOcn_large( & real(R8),intent(out) :: lat (nMax) ! heat flux: latent (W/m^2) real(R8),intent(out) :: lwup (nMax) ! heat flux: lw upward (W/m^2) real(R8),intent(out) :: evap (nMax) ! water flux: evap ((kg/s)/m^2) - real(R8),intent(out) :: evap_16O (nMax) ! water flux: evap ((kg/s/m^2) - real(R8),intent(out) :: evap_HDO (nMax) ! water flux: evap ((kg/s)/m^2) - real(R8),intent(out) :: evap_18O (nMax) ! water flux: evap ((kg/s/m^2) real(R8),intent(out) :: taux (nMax) ! surface stress, zonal (N) real(R8),intent(out) :: tauy (nMax) ! surface stress, maridional (N) real(R8),intent(out) :: tref (nMax) ! diag: 2m ref height T (K) @@ -299,14 +286,6 @@ subroutine flux_atmOcn_large( & !--- water flux --- evap(n) = lat(n)/loc_latvap - !---water isotope flux --- - call wiso_flxoce(2,rbot(n),zbot(n),s16O(n),ts(n),r16O(n),ustar,re,ssq,evap_16O(n), & - qbot(n),evap(n)) - call wiso_flxoce(3,rbot(n),zbot(n),sHDO(n),ts(n),rHDO(n),ustar,re,ssq, evap_HDO(n),& - qbot(n),evap(n)) - call wiso_flxoce(4,rbot(n),zbot(n),s18O(n),ts(n),r18O(n),ustar,re,ssq, evap_18O(n), & - qbot(n),evap(n)) - !------------------------------------------------------------ ! compute diagnositcs: 2m ref T & Q, 10m wind speed squared !------------------------------------------------------------ diff --git a/cesm/flux_atmocn/flux_atmocn_UA_mod.F90 b/cesm/flux_atmocn/flux_atmocn_UA_mod.F90 new file mode 100644 index 000000000..d2f258f3d --- /dev/null +++ b/cesm/flux_atmocn/flux_atmocn_UA_mod.F90 @@ -0,0 +1,525 @@ +module flux_atmocn_UA_mod + + !=============================================================================== + ! !DESCRIPTION: + ! + ! Internal atm/ocn flux calculation + ! using University of Arizona method. + ! + ! Reference: + ! Zeng, X., M. Zhao, and R.E. Dickinson, 1998: Intercomparison of Bulk + ! Aerodynamic Algorithms for the Computation of Sea Surface Fluxes + ! Using TOGA COARE and TAO Data. J. Climate, 11, 2628–2644, + ! https://doi.org/10.1175/1520-0442(1998)011<2628%3AIOBAAF>2.0.CO%3B2 + ! + ! Equation numbers are from this paper. + ! + ! !REVISION HISTORY: + ! 2017-Aug-28 - J. Reeves Eyre - code re-written for E3SM + ! 2018-Oct-30 - J. Reeves Eyre - bug fix and add convective gustiness. + ! 2019-May-08 - J. Reeves Eyre - remove convective gustiness + ! and add cold air outbreak modification. + !=============================================================================== + + use shr_kind_mod, only : R8=>SHR_KIND_R8, IN=>SHR_KIND_IN ! shared kinds + use shr_flux_mod, only : td0, maxscl, alpha + use shr_flux_mod, only : loc_zvir, loc_tkfrz, loc_cpdair, loc_cpvir, loc_g + use shr_flux_mod, only : use_coldair_outbreak_mod, loc_karman, loc_stebol + + implicit none + private + + public :: flux_atmOcn_UA + + ! private member functions: + private :: psi_ua + private :: qsat_ua + private :: rough_ua + + integer, private :: debug = 0 + +contains + + subroutine flux_atmOcn_UA( & + logunit, spval, nMax, & + zbot, ubot, vbot, thbot, & + qbot, rbot, tbot, us, vs, pslv, & + ts, mask, sen, lat, lwup, evap, & + taux, tauy, tref, qref, & + duu10n, ustar_sv, re_sv, ssq_sv) + + !--- input arguments -------------------------------- + integer ,intent(in) :: logunit + real(R8) ,intent(in) :: spval + integer ,intent(in) :: nMax ! data vector length + integer ,intent(in) :: mask (nMax) ! ocn domain mask 0 <=> out of domain + real(R8) ,intent(in) :: zbot (nMax) ! atm level height (m) + real(R8) ,intent(in) :: ubot (nMax) ! atm u wind (m/s) + real(R8) ,intent(in) :: vbot (nMax) ! atm v wind (m/s) + real(R8) ,intent(in) :: thbot(nMax) ! atm potential T (K) + real(R8) ,intent(in) :: qbot (nMax) ! atm specific humidity (kg/kg) + real(R8) ,intent(in) :: rbot (nMax) ! atm air density (kg/m^3) + real(R8) ,intent(in) :: tbot (nMax) ! atm T (K) + real(R8) ,intent(in) :: pslv (nMax) ! sea level pressure (Pa) + real(R8) ,intent(in) :: us (nMax) ! ocn u-velocity (m/s) + real(R8) ,intent(in) :: vs (nMax) ! ocn v-velocity (m/s) + real(R8) ,intent(in) :: ts (nMax) ! ocn temperature (K) + + !--- output arguments ------------------------------- + real(R8),intent(out) :: sen (nMax) ! heat flux: sensible (W/m^2) + real(R8),intent(out) :: lat (nMax) ! heat flux: latent (W/m^2) + real(R8),intent(out) :: lwup (nMax) ! heat flux: lw upward (W/m^2) + real(R8),intent(out) :: evap (nMax) ! water flux: evap ((kg/s)/m^2) + real(R8),intent(out) :: taux (nMax) ! surface stress, zonal (N) + real(R8),intent(out) :: tauy (nMax) ! surface stress, maridional (N) + real(R8),intent(out) :: tref (nMax) ! diag: 2m ref height T (K) + real(R8),intent(out) :: qref (nMax) ! diag: 2m ref humidity (kg/kg) + real(R8),intent(out) :: duu10n(nMax) ! diag: 10m wind speed squared (m/s)^2 + + real(R8),intent(out),optional :: ustar_sv(nMax) ! diag: ustar + real(R8),intent(out),optional :: re_sv (nMax) ! diag: sqrt of exchange coefficient (water) + real(R8),intent(out),optional :: ssq_sv (nMax) ! diag: sea surface humidity (kg/kg) + + !--- local constants -------------------------------- + real(R8),parameter :: zetam = -1.574_R8 ! Very unstable zeta cutoff for momentum (-) + real(R8),parameter :: zetat = -0.465_R8 ! Very unstable zeta cutoff for T/q (-) + real(R8),parameter :: umin = 0.1_R8 ! minimum wind speed (m/s) + real(R8),parameter :: zref = 10.0_R8 ! reference height (m) + real(R8),parameter :: ztref = 2.0_R8 ! reference height for air T (m) + real(R8),parameter :: beta = 1.0_R8 ! constant used in W* calculation (-) + real(R8),parameter :: zpbl = 1000.0_R8 ! PBL height used in W* calculation (m) + real(R8),parameter :: gamma = 0.0098_R8 ! Dry adiabatic lapse rate (K/m) + real(R8),parameter :: onethird = 1.0_R8/3.0_R8 ! Used repeatedly. + + !--- local variables -------------------------------- + integer :: n ! vector loop index + integer :: i ! iteration loop index + real(R8) :: vmag_abs ! surface wind magnitude (m s-1) + real(R8) :: vmag_rel ! surface wind magnitude relative to surface current (m s-1) + real(R8) :: vmag ! surface wind magnitude with large eddy correction and minimum value (m s-1) + ! (This can change on each iteration.) + real(R8) :: thv ! virtual temperature (K) + real(R8) :: ssq ! sea surface humidity (kg/kg) + real(R8) :: delth ! potential T difference (K) + real(R8) :: delthv ! virtual potential T difference (K) + real(R8) :: delq ! humidity difference (kg/kg) + real(R8) :: ustar ! friction velocity (m s-1) + real(R8) :: qstar ! humidity scaling parameter (kg/kg) + real(R8) :: tstar ! temperature scaling parameter (K) + real(R8) :: thvstar ! virtual temperature scaling parameter (K) + real(R8) :: wstar ! convective velocity scale (m s-1) + real(R8) :: zeta ! dimensionless height (z / Obukhov length) + real(R8) :: obu ! Obukhov length (m) + real(R8) :: tau ! magnitude of wind stress (N m-2) + real(R8) :: cp ! specific heat of moist air (J kg-1 K-1) + real(R8) :: xlv ! Latent heat of vaporization (J kg-1) + real(R8) :: visa ! Kinematic viscosity of dry air (m2 s-1) + real(R8) :: tbot_oC ! Temperature used in visa (deg C) + real(R8) :: rb ! Bulk Richardson number (-) + real(R8) :: zo ! Roughness length for momentum (m) + real(R8) :: zoq ! Roughness length for moisture (m) + real(R8) :: zot ! Roughness length for heat (m) + real(R8) :: u10 ! 10-metre wind speed (m s-1) + real(R8) :: re ! Moisture exchange coefficient for compatibility with default algorithm. + real(R8) :: loc_epsilon ! Ratio of gas constants (-) + + !--- for cold air outbreak calc -------------------------------- + real(R8) :: tdiff(nMax) ! tbot - ts + real(R8) :: vscl + + !--- formats ---------------------------------------- + character(*),parameter :: subName = '(flux_atmOcn) ' + character(*),parameter :: F00 = "('(flux_atmOcn) ',4a)" + !--------------------------------------------------------------------------- + + !----- + ! Straight from original subroutine. + if (debug > 0) write(logunit,F00) "enter" + + ! Evaluate loc_epsilon. + loc_epsilon = 1.0_R8 / (1.0_R8 + loc_zvir) + + !--- for cold air outbreak calc -------------------------------- + tdiff = tbot - ts + + ! Loop over grid points. + do n=1,nMax + + if (mask(n) /= 0) then + + !-----Calculate some required near surface variables.--------- + vmag_abs = sqrt( ubot(n)**2 + vbot(n)**2 ) + vmag_rel = sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2 ) + + ! For Cold Air Outbreak Modification (based on Mahrt & Sun 1995,MWR): + if (use_coldair_outbreak_mod) then + ! Increase windspeed for negative tbot-ts + if (tdiff(n).lt.td0) then + vscl=min((1._R8+alpha*(abs(tdiff(n)-td0)**0.5_R8/abs(vmag_rel))),maxscl) + vmag_rel=vmag_rel*vscl + endif + endif + + delth = thbot(n) - ts(n) ! Pot. temp. difference with surface (K) + ! Note this is equivalent to Zeng et al + ! (1998) version = delt + 0.0098*zbot + thv = thbot(n)*(1.0_R8+0.61_R8*qbot(n)) ! Virtual potential temperature (K) + ! EQN (17): + !ssq = 0.98_R8 * qsat_ua(ts(n),ps, & ! Surface specific humidity (kg kg-1) + ! loc_epsilon) + ssq = 0.98_R8 * qsat_ua(ts(n),pslv(n), & ! Surface specific humidity (kg kg-1) + loc_epsilon) + delq = qbot(n) - ssq ! Difference to surface (kg kg-1) + delthv = delth*(1.0_R8+0.61_R8*qbot(n)) + & ! Difference of virtual potential + & 0.61_R8*thbot(n)*delq ! temperature with surface (K) + + xlv = 1.0e+6_R8 * & ! Latent heat of vaporization (J kg-1) + & (2.501_R8 - 0.00237_R8 * (ts(n) - loc_tkfrz)) + tbot_oC = tbot(n) - loc_tkfrz + visa = 1.326e-5_R8 * (1.0_R8 + & ! Kinematic viscosity of dry + & 6.542e-3_R8*tbot_oC + & ! air (m2 s-1) from Andreas (1989) + & 8.301e-6_R8*tbot_oC*tbot_oC - & ! CRREL Rep. 89-11 + & 4.84e-9_R8*tbot_oC*tbot_oC*tbot_oC) + cp = loc_cpdair*(1.0_R8 + loc_cpvir*ssq) ! specific heat of moist air (J kg-1 K-1) + + !-----Initial values of u* and convective velocity.----------- + ustar = 0.06_R8 + wstar = 0.5_R8 + ! Update wind speed if unstable regime. + if (delthv.lt.0.0_R8) then + ! EQN (19) + vmag = sqrt( vmag_rel**2 + beta*beta*wstar*wstar ) + else + ! EQN (18) + vmag = max(umin,vmag_rel) + endif + + !-----Iterate to compute new u* and z0.----------------------- + do i = 1,5 + ! EQN (24) + zo = 0.013_R8*ustar*ustar/loc_g + 0.11_R8*visa/ustar + ! EQN (9) assuming neutral + ustar = loc_karman*vmag/log(zbot(n)/zo) + enddo + + !-----Assess stability.--------------------------------------- + rb = loc_g*zbot(n)*delthv / (thv*vmag*vmag) ! bulk Richardson number + + if(rb.ge.0.0_R8) then + ! Neutral or stable: EQNs (4), (9), (13) and definition of rb. + zeta = rb*log(zbot(n)/zo) / & + & (1.0_R8 - 5.0_R8*min(rb,0.19_R8)) + else + ! Unstable: EQNs (4), (8), (12) and definition of rb. + zeta = rb*log(zbot(n)/zo) + endif + + obu = zbot(n)/zeta ! Obukhov length + obu = sign(max(zbot(n)/10.0_R8, abs(obu)), obu) + + !-----Main iterations (2-10 iterations would be fine).------- + do i=1,10 + + ! Update roughness lengths. + call rough_ua(zo,zot,zoq,ustar,visa) + + ! Wind variables. + zeta = zbot(n) / obu + if (zeta.lt.zetam) then + ! Very unstable regime + ! EQN (7) with extra z0 term. + ustar = loc_karman * vmag / (log(zetam*obu/zo) - & + & psi_ua(1_IN, zetam) + & + & psi_ua(1_IN, zo/obu) + & + & 1.14_R8 * ((-zeta)**onethird - (-zetam)**onethird) ) + else if (zeta.lt.0.0_R8) then + ! Unstable regime + ! EQN (8) with extra z0 term. + ustar = loc_karman * vmag / (log(zbot(n)/zo) - & + & psi_ua(1_IN,zeta) + psi_ua(1_IN,zo/obu) ) + else if (zeta.le.1.0_R8) then + ! Stable regime + ! EQN (9) with extra z0 term. + ustar = loc_karman * vmag / (log(zbot(n)/zo) + & + & 5.0_R8*zeta - 5.0_R8*zo/obu) + else + ! Very stable regime + ! EQN (10) with extra z0 term. + ustar = loc_karman * vmag / (log(obu/zo) + 5.0_R8 - & + & 5.0_R8*zo/obu + & + & (5.0_R8*log(zeta) + zeta - 1.0_R8) ) + endif + + ! Temperature variables. + if(zeta.lt.zetat) then + ! Very unstable regime + ! EQN (11) with extra z0 term. + tstar = loc_karman * delth / (log(zetat*obu/zot) - & + & psi_ua(2_IN, zetat) + & + & psi_ua(2_IN, zot/obu) + & + & 0.8_R8*((-zetat)**(-onethird) - (-zeta)**(-onethird)) ) + else if (zeta.lt.0.0_R8) then + ! Unstable regime + ! EQN (12) with extra z0 term. + tstar = loc_karman * delth / & + & (log(zbot(n)/zot) - psi_ua(2_IN,zeta) + psi_ua(2_IN,zot/obu)) + else if (zeta.le.1.0_R8) then + ! Stable regime + ! EQN (13) with extra z0 term. + tstar = loc_karman * delth / (log(zbot(n)/zot) + & + & 5.0_R8*zeta - 5.0_R8*zot/obu) + else + ! Very stable regime + ! EQN (14) with extra z0 term. + tstar = loc_karman * delth / (log(obu/zot) + & + & 5.0_R8 - 5.0_R8*zot/obu + & + & (5.0_R8*log(zeta) + zeta - 1.0_R8) ) + endif + + ! Humidity variables. + ! This is done with re to give variable to save out like + ! in old algorithm. + if (zeta.lt.zetat) then + ! Very unstable regime + ! EQN (11) with extra z0 term. + re = loc_karman / (log(zetat*obu/zoq) - psi_ua(2_IN,zetat) + & + & psi_ua(2_IN,zoq/obu) + & + & 0.8_R8*((-zetat)**(-onethird) - (-zeta)**(-onethird)) ) + else if (zeta.lt.0.0_R8) then + ! Unstable regime + ! EQN (12) with extra z0 term. + re = loc_karman / & + & (log(zbot(n)/zoq) - psi_ua(2_IN,zeta) + psi_ua(2_IN,zoq/obu)) + else if (zeta.le.1.0_R8) then + ! Stable regime + ! EQN (13) with extra z0 term. + re = loc_karman / & + & (log(zbot(n)/zoq) + 5.0_R8*zeta - 5.0_R8*zoq/obu) + else + ! Very stable regime + ! EQN (14) with extra z0 term. + re = loc_karman / & + & (log(obu/zoq) + 5.0_R8 - 5.0_R8*zoq/obu + & + & (5.0_R8*log(zeta) + zeta - 1.0_R8) ) + endif + qstar = re * delq + + ! Update Obukhov length. + thvstar = tstar*(1.0_R8 + 0.61_R8*qbot(n)) + 0.61_R8*thbot(n)*qstar + ! EQN (4) + obu = ustar*ustar * thv / (loc_karman*loc_g*thvstar) + obu = sign( max(zbot(n)/10.0_R8, abs(obu)) ,obu) + + ! Update wind speed if in unstable regime. + if (delthv.lt.0.0_R8) then + ! EQN (20) + wstar = beta * (-loc_g*ustar*thvstar*zpbl/thv)**onethird + ! EQN (19) + vmag = sqrt(vmag_rel**2 + wstar*wstar) + else + ! EQN (18) + vmag = max(umin,vmag_rel) + endif + + enddo ! End of iterations for ustar, tstar, qstar etc. + + + !-----Calculate fluxes and wind stress.--------------------- + + !--- momentum flux --- + ! This should ensure zero wind stress when (relative) wind speed is zero, + ! components are consistent with total, and we don't ever divide by zero. + ! EQN (21) + tau = rbot(n) * ustar * ustar + taux(n) = tau * (ubot(n)-us(n)) / max(umin, vmag_rel) + tauy(n) = tau * (vbot(n)-vs(n)) / max(umin, vmag_rel) + + !--- heat flux --- + ! EQNs (22) and (23) + sen (n) = cp * rbot(n) * tstar * ustar + lat (n) = xlv * rbot(n) * qstar * ustar + lwup(n) = -loc_stebol * ts(n)**4 + + !--- water flux --- + evap(n) = lat(n)/xlv + + !------------------------------------------------------------ + ! compute diagnositcs: 2m ref T & Q, 10m wind speed squared + !------------------------------------------------------------ + + zeta = zbot(n) / obu + if (zeta.lt.zetat) then + if (zeta.lt.zetam) then + ! Very unstable regime for U. + ! EQN (7) + u10 = vmag_abs + (ustar/loc_karman) * & + & 1.14_R8 * ((-zref/obu)**onethird - (-zeta)**onethird) + else + ! Unstable regime for U. + ! EQN (8) + u10 = vmag_abs + (ustar/loc_karman) * & + & (log(zref/zbot(n)) - (psi_ua(1_IN,zref/obu) - psi_ua(1_IN,zeta)) ) + endif + ! Very unstable regime for T and q. + ! EQN (11) + tref(n) = thbot(n) + (tstar/loc_karman) * & + & 0.8_R8 * ((-zeta)**(-onethird) - (-ztref/obu)**(-onethird)) + qref(n) = qbot(n) + (qstar/loc_karman) * & + & 0.8_R8 * ((-zeta)**(-onethird) - (-ztref/obu)**(-onethird)) + + else if (zeta.lt.0.0_R8) then + ! Unstable regime. + ! EQN (8) + u10 = vmag_abs + (ustar/loc_karman) * & + & (log(zref/zbot(n)) - (psi_ua(1_IN,zref/obu) - psi_ua(1_IN,zeta)) ) + ! EQN (12) + tref(n) = thbot(n) + (tstar/loc_karman) * & + & (log(ztref/zbot(n)) - (psi_ua(2_IN,ztref/obu) - psi_ua(2_IN,zeta)) ) + qref(n) = qbot(n) + (qstar/loc_karman) * & + & (log(ztref/zbot(n)) - (psi_ua(2_IN,ztref/obu) - psi_ua(2_IN,zeta)) ) + else if (zeta.le.1.0_R8) then + ! Stable regime. + ! EQN (9) + u10 = vmag_abs + (ustar/loc_karman) * & + & (log(zref/zbot(n)) + 5.0_R8*zref/obu - 5.0_R8*zeta) + ! EQN (13) + tref(n) = thbot(n) + (tstar/loc_karman) * & + & (log(ztref/zbot(n)) + 5.0_R8*ztref/obu - 5.0_R8*zeta) + qref(n) = qbot(n) + (qstar/loc_karman) * & + & (log(ztref/zbot(n)) + 5.0_R8*ztref/obu - 5.0_R8*zeta) + else + ! Very stable regime. + ! EQN (10) + u10 = vmag_abs + (ustar/loc_karman) * & + & (5.0_R8*log(zref/zbot(n)) + zref/obu - zeta) + ! EQN (14) + tref(n) = thbot(n) + (tstar/loc_karman) * & + & (5.0_R8*log(ztref/zbot(n)) + ztref/obu - zeta) + qref(n) = qbot(n) + (qstar/loc_karman) * & + & (5.0_R8*log(ztref/zbot(n)) + ztref/obu - zeta) + + endif + + tref(n) = tref(n) - gamma*ztref ! pot. temp to temp correction + duu10n(n) = u10*u10 ! 10m wind speed squared + + !------------------------------------------------------------ + ! optional diagnostics, needed for water tracer fluxes (dcn) + !------------------------------------------------------------ + if (present(ustar_sv)) ustar_sv(n) = ustar + if (present(ssq_sv )) ssq_sv(n) = ssq + if (present(re_sv )) re_sv(n) = re + + else + + !------------------------------------------------------------ + ! no valid data here -- out of ocean domain + !------------------------------------------------------------ + sen (n) = spval ! sensible heat flux (W/m^2) + lat (n) = spval ! latent heat flux (W/m^2) + lwup (n) = spval ! long-wave upward heat flux (W/m^2) + evap (n) = spval ! evaporative water flux ((kg/s)/m^2) + evap_16O (n) = spval !water tracer flux (kg/s)/m^2) + evap_HDO (n) = spval !HDO tracer flux (kg/s)/m^2) + evap_18O (n) = spval !H218O tracer flux (kg/s)/m^2) + taux (n) = spval ! x surface stress (N) + tauy (n) = spval ! y surface stress (N) + tref (n) = spval ! 2m reference height temperature (K) + qref (n) = spval ! 2m reference height humidity (kg/kg) + duu10n(n) = spval ! 10m wind speed squared (m/s)^2 + + ! Optional diagnostics too: + if (present(ustar_sv)) ustar_sv(n) = spval + if (present(re_sv )) re_sv (n) = spval + if (present(ssq_sv )) ssq_sv (n) = spval + + endif + + enddo ! loop over grid points + + end subroutine flux_atmOcn_UA + + + !=============================================================================== + + real(R8) function psi_ua(k,zeta) + + ! Stability function for rb < 0 + + !-----Input variables.---------- + integer(IN), intent(in) :: k ! Indicates whether this is for momentum (k=1) + ! or for heat/moisture (k=2) + real(R8), intent(in) :: zeta ! Dimensionless height (=z/L) + + !-----Local variables.---------- + real(R8) :: chik ! Function of zeta. + + ! EQN (16) + chik = (1.0_R8 - 16.0_R8*zeta)**0.25_R8 + + if(k.eq.1) then + ! EQN (15) for momentum + psi_ua = 2.0_R8 * log((1.0_R8 + chik)*0.5_R8) + & + & log((1.0_R8 + chik*chik)*0.5_R8) - & + & 2.0_R8 * atan(chik) + 2.0_R8 * atan(1.0_R8) + else + ! EQN (15) for heat/moisture + psi_ua = 2.0_R8 * log((1.0_R8 + chik*chik)*0.5_R8) + endif + + end function psi_ua + + !=============================================================================== + + real(R8) function qsat_ua(t,p,loc_epsilon) + + ! Uses Tetens' formula for saturation vapor pressure from + ! Buck(1981) JAM 20, 1527-1532 + + !-----Input variables.---------- + real(R8), intent(in) :: t ! temperature (K) + real(R8), intent(in) :: p ! pressure (Pa) + real(R8), intent(in) :: loc_epsilon ! Ratio of gas constants (-) + + !-----Local variables.---------- + real(R8) :: esat ! saturated vapor pressure (hPa) + + ! Calculate saturated vapor pressure in hPa. + esat = (1.0007_R8 + 0.00000346_R8 * (p/100.0_R8)) * 6.1121_R8 * & + & exp(17.502_R8 * (t - loc_tkfrz) / (240.97_R8 + (t - loc_tkfrz))) + + ! Convert to specific humidity (kg kg-1). + qsat_ua = loc_epsilon * esat / ((p/100.0_R8) - (1.0_R8 - loc_epsilon)*esat) + + end function qsat_ua + + !=============================================================================== + + subroutine rough_ua(zo,zot,zoq,ustar,visa) + + ! Calculate roughness lengths: zo, zot, zoq. + + !-----Input variables.---------- + real(R8), intent(in) :: ustar ! friction velocity (m s-1) + real(R8), intent(in) :: visa ! kinematic viscosity of dry air (m2 s-1) + + !-----Output variables.--------- + real(R8), intent(out) :: zo ! roughness length for momentum (m) + real(R8), intent(out) :: zot ! roughness length for heat (m) + real(R8), intent(out) :: zoq ! roughness length for water vapor (m) + + !-----Local variables.---------- + real(R8) :: re_rough ! Rougness Reynold's number (-) + real(R8) :: xq ! Logarithm of roughness length ratios (moisture) + real(R8) :: xt ! Logarithm of roughness length ratios (heat) + + zo = 0.013_R8*ustar*ustar/loc_g + 0.11_R8*visa/ustar ! EQN (24) + re_rough = ustar*zo/visa ! By definition. + xq = 2.67_R8*re_rough**0.25_R8 - 2.57_R8 ! EQN (25) + xt = xq ! EQN (26) + zoq = zo/exp(xq) ! By definition of xq + zot = zo/exp(xt) ! By definition of xt + + end subroutine rough_ua + +end module flux_atmocn_UA_mod diff --git a/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 b/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 new file mode 100644 index 000000000..c4d52b266 --- /dev/null +++ b/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 @@ -0,0 +1,140 @@ +module flux_atmocn_driver_mod + + use shr_kind_mod, only : R8=>SHR_KIND_R8, IN=>SHR_KIND_IN ! shared kinds + use shr_const_mod, only : shr_const_spval + use flux_atmocn_Large_mod, only : flux_atmocn_Large + use flux_atmocn_COARE_mod, only : flux_atmocn_COARE + use flux_atmocn_UA_mod, only : flux_atmocn_UA + + implicit none + public + +contains + + subroutine flux_atmOcn_driver(logunit, nMax, & + zbot, ubot, vbot, thbot, & + qbot, rainc, rbot, & + tbot, us, vs, pslv, & + ts, mask, seq_flux_atmocn_minwind, & + sen, lat, lwup, evap, & + taux, tauy, tref, qref, & + ocn_surface_flux_scheme, & + add_gusts, duu10n, ugust_out, u10res, & + ustar_sv, re_sv, ssq_sv, missval) + + !--- input arguments -------------------------------- + integer , intent(in) :: logunit + integer , intent(in) :: nMax ! data vector length + integer , intent(in) :: mask (nMax) ! ocn domain mask 0 <=> out of domain + logical , intent(in) :: add_gusts + real(R8) , intent(in) :: zbot (nMax) ! atm level height (m) + real(R8) , intent(in) :: ubot (nMax) ! atm u wind (m/s) + real(R8) , intent(in) :: vbot (nMax) ! atm v wind (m/s) + real(R8) , intent(in) :: thbot(nMax) ! atm potential T (K) + real(R8) , intent(in) :: qbot (nMax) ! atm specific humidity (kg/kg) + real(R8) , intent(in) :: rainc(nMax) ! atm precip for convective gustiness (kg/m^3) - RBN 24Nov2008/MDF 31Jan2022 + real(R8) , intent(in) :: s16O (nMax) ! atm H216O tracer conc. (kg/kg) + real(R8) , intent(in) :: sHDO (nMax) ! atm HDO tracer conc. (kg/kg) + real(R8) , intent(in) :: s18O (nMax) ! atm H218O tracer conc. (kg/kg) + real(R8) , intent(in) :: r16O (nMax) ! ocn H216O tracer ratio/Rstd + real(R8) , intent(in) :: rHDO (nMax) ! ocn HDO tracer ratio/Rstd + real(R8) , intent(in) :: r18O (nMax) ! ocn H218O tracer ratio/Rstd + real(R8) , intent(in) :: rbot (nMax) ! atm air density (kg/m^3) + real(R8) , intent(in) :: tbot (nMax) ! atm T (K) + real(R8) , intent(in) :: pslv (nMax) ! atm sea level pressure(Pa) + real(R8) , intent(in) :: us (nMax) ! ocn u-velocity (m/s) + real(R8) , intent(in) :: vs (nMax) ! ocn v-velocity (m/s) + real(R8) , intent(in) :: ts (nMax) ! ocn temperature (K) + real(R8) , intent(in) :: seq_flux_atmocn_minwind ! minimum wind speed for atmocn (m/s) + integer , intent(in) :: ocn_surface_flux_scheme + + !--- output arguments ------------------------------- + real(R8),intent(out) :: sen (nMax) ! heat flux: sensible (W/m^2) + real(R8),intent(out) :: lat (nMax) ! heat flux: latent (W/m^2) + real(R8),intent(out) :: lwup (nMax) ! heat flux: lw upward (W/m^2) + real(R8),intent(out) :: evap (nMax) ! water flux: evap ((kg/s)/m^2) + real(R8),intent(out) :: evap_16O (nMax) ! water flux: evap ((kg/s/m^2) + real(R8),intent(out) :: evap_HDO (nMax) ! water flux: evap ((kg/s)/m^2) + real(R8),intent(out) :: evap_18O (nMax) ! water flux: evap ((kg/s/m^2) + real(R8),intent(out) :: taux (nMax) ! surface stress, zonal (N) + real(R8),intent(out) :: tauy (nMax) ! surface stress, maridional (N) + real(R8),intent(out) :: tref (nMax) ! diag: 2m ref height T (K) + real(R8),intent(out) :: qref (nMax) ! diag: 2m ref humidity (kg/kg) + real(R8),intent(out) :: duu10n(nMax) ! diag: 10m wind speed squared (m/s)^2 + real(R8),intent(out) :: ugust_out(nMax) ! diag: gustiness addition to U10 (m/s) + real(R8),intent(out) :: u10res(nMax) ! diag: gustiness addition to U10 (m/s) + + real(R8),intent(out),optional :: ustar_sv(nMax) ! diag: ustar + real(R8),intent(out),optional :: re_sv (nMax) ! diag: sqrt of exchange coefficient (water) + real(R8),intent(out),optional :: ssq_sv (nMax) ! diag: sea surface humidity (kg/kg) + real(R8),intent(in) ,optional :: missval ! masked value + + !--- local variables -------------------------------- + integer :: n + real(R8) :: spval ! local missing value + !-------------------------------------------------------------------------------- + + !!................................................................. + !! ocn_surface_flux_scheme = 0 : Large and Pond + !! = 1 : COARE algorithm + !! = 2 : UA algorithm + !!................................................................. + + if (present(missval)) then + spval = missval + else + spval = shr_const_spval + endif + + ! Default flux scheme. + if (ocn_surface_flux_scheme == 0) then + + call flux_atmOcn_Large( & + logunit, spval, nMax, & + zbot, ubot, vbot, thbot, & + qbot, rainc, rbot, & + tbot, us, vs, pslv, & + ts, mask, seq_flux_atmocn_minwind, & + sen, lat, lwup, evap, & + taux, tauy, tref, qref, & + add_gusts, duu10n, ugust_out, u10res, & + ustar_sv=ustar_sv, re_sv=re_sv, ssq_sv=ssq_sv) + + else if (ocn_surface_flux_scheme == 1) then + + call flux_atmOcn_COARE( & + logunit, spval, nMax, & + zbot, ubot, vbot, thbot, & + qbot, rainc, rbot, & + tbot, us, vs, pslv, & + ts, mask, seq_flux_atmocn_minwind, & + sen, lat, lwup, evap, & + taux, tauy, tref, qref, & + duu10n, ugust_out, u10res, & + ustar_sv=ustar_sv, re_sv=re_sv, ssq_sv=ssq_sv) + + else if (ocn_surface_flux_scheme == 2) then + + call flux_atmOcn_UA( & + logunit, spval, nMax, & + zbot, ubot, vbot, thbot, & + qbot, rbot, tbot, us, vs, pslv, & + ts, mask, sen, lat, lwup, evap, & + taux, tauy, tref, qref, & + duu10n, ustar_sv=ustar_sv, re_sv=re_sv, ssq_sv=ssq_sv) + + do n = 1,nMax + if (mask(n) /= 0) then + u10res(n) = sqrt(duu10n(n)) + ugust_out(n) = 0._r8 + else + u10res (n) = spval + ugust_out(n) = spval + end if + end do + + end if + + end subroutine flux_atmOcn_driver + +end module flux_atmocn_driver_mod diff --git a/cime_config/buildnml b/cime_config/buildnml index 534160855..3256ff65c 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -37,7 +37,7 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): config["CPL_I2O_PER_CAT"] = case.get_value("CPL_I2O_PER_CAT") config["DRV_THREADING"] = case.get_value("DRV_THREADING") config["CPL_ALBAV"] = case.get_value("CPL_ALBAV") - config["FLDS_WISO"] = case.get_value("FLDS_WISO") + config["CPL_EPBAL"] = case.get_value("CPL_EPBAL") config["BUDGETS"] = case.get_value("BUDGETS") config["MACH"] = case.get_value("MACH") config["MPILIB"] = case.get_value("MPILIB") @@ -657,7 +657,7 @@ def buildnml(case, caseroot, component): libs = cmeps_lib_list(case) with Case(case.get_value("CASEROOT"), read_only=False) as case_tmp: case_tmp.set_value("CASE_SUPPORT_LIBRARIES", ",".join(libs)) - + esmfmkfile = os.getenv("ESMFMKFILE") expect( esmfmkfile and os.path.isfile(esmfmkfile), diff --git a/cime_config/config_component_cesm.xml b/cime_config/config_component_cesm.xml index 5d5d1d43d..b5bc98695 100644 --- a/cime_config/config_component_cesm.xml +++ b/cime_config/config_component_cesm.xml @@ -537,19 +537,6 @@ - - logical - TRUE,FALSE - FALSE - - TRUE - TRUE - - run_flags - env_run.xml - Turn on the passing of water isotope fields through the coupler - - integer 1,3,5,10,36 diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 06e9a08e0..313b7f2ad 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -2495,7 +2495,6 @@ - logical flds @@ -2504,7 +2503,7 @@ Pass water isotopes between components - $FLDS_WISO + .false. diff --git a/doc/source/addendum/fieldnames.rst b/doc/source/addendum/fieldnames.rst index 471d52e7a..58b2713e0 100644 --- a/doc/source/addendum/fieldnames.rst +++ b/doc/source/addendum/fieldnames.rst @@ -34,7 +34,6 @@ The following state names are currently supported. Note that each application mi "Si_imask", "sea ice land mask" "Si_ifrac_n", "ice fraction by thickness category" "Si_qref", "reference height specific humidity" - "Si_qref_wiso", "reference specific water isotope humidity at 2 meters" "Si_t", "sea ice surface temperature" "Si_tref", "reference height temperature" "Si_u10", "10m wind speed" @@ -56,10 +55,8 @@ The following state names are currently supported. Note that each application mi "Sl_lfrac", "" "Sl_lfrin", "" "Sl_qref", "" - "Sl_qref_wiso", "" "Sl_ram1", "" "Sl_snowh", "" - "Sl_snowh_wiso", "" "Sl_t", "" "Sl_topo_elev", "" "Sl_topo", "" diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index d86d4c771..5872b5b19 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -75,10 +75,10 @@ module esmFldsExchange_cesm_mod character(len=CX) :: rof2lnd_map = 'unset' character(len=CX) :: lnd2rof_map = 'unset' - ! optional mapping files + ! optional mapping files character(len=CX) :: wav2ocn_map ='unset' character(len=CX) :: ocn2wav_map = 'unset' - + ! no mapping files (value is 'idmap' or 'unset') character(len=CX) :: atm2ice_map = 'unset' character(len=CX) :: atm2ocn_map = 'unset' @@ -95,7 +95,6 @@ module esmFldsExchange_cesm_mod logical :: flds_co2a ! Pass CO2 from ATM to surface components logical :: flds_co2b ! Pass CO2 from ATM to LND and back from LND to ATM logical :: flds_co2c ! Pass CO2 from ATM to surface (OCN/LND) and back from them to ATM - logical :: flds_wiso ! Pass water isotop fields logical :: flds_r2l_stream_channel_depths ! Pass channel depths from ROF to LND logical :: add_gusts ! Whether to include fields related to the gustiness parameterization @@ -237,11 +236,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) flds_i2o_per_cat - ! are water isotope exchanges enabled? - call NUOPC_CompAttributeGet(gcomp, name='flds_wiso', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) flds_wiso - 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 @@ -262,7 +256,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) write(logunit,'(a,l7)') trim(subname)//' flds_co2a = ',flds_co2a write(logunit,'(a,l7)') trim(subname)//' flds_co2b = ',flds_co2b write(logunit,'(a,l7)') trim(subname)//' flds_co2c = ',flds_co2c - write(logunit,'(a,l7)') trim(subname)//' flds_wiso = ',flds_wiso write(logunit,'(a,l7)') trim(subname)//' flds_i2o_per_cat = ',flds_i2o_per_cat write(logunit,'(a,l7)') trim(subname)//' flds_r2l_stream_channel_depths = ',flds_r2l_stream_channel_depths write(logunit,'(a,l7)') trim(subname)//' add_gusts = ', add_gusts @@ -315,9 +308,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addfld_from(compatm, 'Sa_ptem') call addfld_from(compatm, 'Sa_dens') call addfld_from(compatm, 'Faxa_rainc') - if (flds_wiso) then - call addfld_from(compatm, 'Sa_shum_wiso') - end if else if (is_local%wrap%aoflux_grid == 'ogrid') then if (mapuv_with_cart3d) then @@ -335,9 +325,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmap_from(compatm, 'Sa_ptem', compocn, mapbilnr, 'one', atm2ocn_map) call addmap_from(compatm, 'Sa_dens', compocn, mapbilnr, 'one', atm2ocn_map) call addmap_from(compatm, 'Sa_pslv', compocn, mapbilnr, 'one', atm2ocn_map) - if (fldchk(is_local%wrap%FBImp(compatm,compatm), 'Sa_shum_wiso', rc=rc)) then - call addmap_from(compatm, 'Sa_shum_wiso', compocn, mapbilnr, 'one', atm2ocn_map) - end if end if end if @@ -490,18 +477,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmrg_to(complnd, 'Sa_shum', mrg_from=compatm, mrg_fld='Sa_shum', mrg_type='copy') end if end if - if (flds_wiso) then - if (phase == 'advertise') then - call addfld_from(compatm, 'Sa_shum_wiso') - call addfld_to(complnd, 'Sa_shum_wiso') - else - if ( fldchk(is_local%wrap%FBexp(complnd) , 'Sa_shum_wiso', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_shum_wiso', rc=rc)) then - call addmap_from(compatm, 'Sa_shum_wiso', complnd, mapbilnr, 'one', atm2lnd_map) - call addmrg_to(complnd, 'Sa_shum_wiso', mrg_from=compatm, mrg_fld='Sa_shum_wiso', mrg_type='copy') - end if - end if - end if ! --------------------------------------------------------------------- ! to lnd: prognostic CO2 at the lowest atm model level ! --------------------------------------------------------------------- @@ -759,42 +734,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if - if (flds_wiso) then - if (phase == 'advertise') then - call addfld_from(comprof, 'Flrr_volr_wiso') - call addfld_to(complnd, 'Flrr_volr_wiso') - else - if ( fldchk(is_local%wrap%FBExp(complnd) , 'Flrr_volr_wiso', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_volr_wiso', rc=rc)) then - call addmap_from(comprof, 'Flrr_volr_wiso', complnd, mapconsf, 'one', rof2lnd_map) - call addmrg_to(complnd, 'Flrr_volr_wiso', & - mrg_from=comprof, mrg_fld='Flrr_volr_wiso', mrg_type='copy') - end if - end if - if (phase == 'advertise') then - call addfld_from(comprof, 'Flrr_volrmch_wiso') - call addfld_to(complnd, 'Flrr_volrmch_wiso') - else - if ( fldchk(is_local%wrap%FBExp(complnd) , 'Flrr_volrmch_wiso', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_volrmch_wiso', rc=rc)) then - call addmap_from(comprof, 'Flrr_volrmch_wiso', complnd, mapconsf, 'one', rof2lnd_map) - call addmrg_to(complnd, 'Flrr_volrmch_wiso', & - mrg_from=comprof, mrg_fld='Flrr_volrmch_wiso', mrg_type='copy') - end if - end if - if (phase == 'advertise') then - call addfld_from(comprof, 'Flrr_flood_wiso') - call addfld_to(complnd, 'Flrr_flood_wiso') - else - if ( fldchk(is_local%wrap%FBExp(complnd) , 'Flrr_flood_wiso', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_flood_wiso', rc=rc)) then - call addmap_from(comprof, 'Flrr_flood_wiso', complnd, mapconsf, 'one', rof2lnd_map) - call addmrg_to(complnd, 'Flrr_flood_wiso', & - mrg_from=comprof, mrg_fld='Flrr_flood_wiso', mrg_type='copy') - end if - end if - end if - ! --------------------------------------------------------------------- ! to lnd: ice sheet grid coverage on global grid from glc ! to lnd: ice sheet mask where we are potentially sending non-zero fluxes from glc @@ -1055,35 +994,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if - if (flds_wiso) then - if (phase == 'advertise') then - call addfld_from(complnd , 'Sl_qref_wiso') - call addfld_from(compice , 'Si_qref_wiso') - call addfld_aoflux('So_qref_wiso') - call addfld_to(compatm , 'Sx_qref_wiso') - else - if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_qref_wiso', rc=rc)) then - if (fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_qref_wiso', rc=rc)) then - call addmap_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=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) - call addmrg_to(compatm , 'Sx_qref_wiso', & - mrg_from=compice, mrg_fld='Si_qref_wiso', mrg_type='merge', mrg_fracname='ifrac') - end if - if (fldchk(is_local%wrap%FBMed_aoflux_o, 'So_qref_wiso', rc=rc)) then - if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - call addmap_aoflux( 'So_qref_wiso', compatm, mapconsf, 'ofrac', ocn2atm_map) ! map ocn->atm - end if - call addmrg_to(compatm , 'Sx_qref_wiso', & - mrg_from=compmed, mrg_fld='So_qref_wiso', mrg_type='merge', mrg_fracname='ofrac') - end if - end if - end if - end if - ! --------------------------------------------------------------------- ! to atm: merged reference temperature at 2 meters ! to atm: merged 10m wind speed @@ -1171,34 +1081,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if - if (flds_wiso) then - if (phase == 'advertise') then - call addfld_from(complnd , 'Sl_qref_wiso') - call addfld_from(compice , 'Si_qref_wiso') - call addfld_aoflux('So_qref_wiso') - call addfld_to(compatm , 'Sx_qref_wiso') - else - if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_qref_wiso', rc=rc)) then - if (fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_qref_wiso', rc=rc)) then - call addmap_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=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) - call addmrg_to(compatm , 'Sx_qref_wiso', & - mrg_from=compice, mrg_fld='Si_qref_wiso', mrg_type='merge', mrg_fracname='ifrac') - end if - if (fldchk(is_local%wrap%FBMed_aoflux_o, 'So_qref_wiso', rc=rc)) then - if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - call addmap_aoflux('So_qref_wiso', compatm, mapconsf, 'ofrac', ocn2atm_map) - end if - call addmrg_to(compatm , 'Sx_qref_wiso', & - mrg_from=compmed, mrg_fld='So_qref_wiso', mrg_type='merge', mrg_fracname='ofrac') - end if - end if - end if - end if ! --------------------------------------------------------------------- ! to atm: merged zonal surface stress ! to atm: merged meridional surface stress @@ -1206,7 +1088,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to atm: merged surface sensible heat flux ! to atm: merged surface upward longwave heat flux ! to atm: evaporation water flux from water - ! to atm: evaporation water flux from water isotopes ! --------------------------------------------------------------------- if (phase == 'advertise') then call addfld_to(compatm, 'Faxx_taux') @@ -1370,35 +1251,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if - if (flds_wiso) then - if (phase == 'advertise') then - call addfld_to(compatm, 'Faxx_evap_wiso') - call addfld_from(complnd, 'Fall_evap_wiso') - call addfld_from(compice, 'Faii_evap_wiso') - call addfld_aoflux( 'Faox_evap_wiso') - 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, 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=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) - call addmrg_to(compatm , 'Faxx_evap_wiso', & - mrg_from=compice, mrg_fld='Faii_evap_wiso', mrg_type='merge', mrg_fracname='ifrac') - end if - if (fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_evap_wiso', rc=rc)) then - if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - call addmap_aoflux('Faox_evap_wiso', compatm, mapconsf, 'ofrac', ocn2atm_map) - end if - call addmrg_to(compatm , 'Faxx_evap_wiso', & - mrg_from=compmed, mrg_fld='Faox_evap_wiso', mrg_type='merge', mrg_fracname='ofrac') - end if - end if - end if - end if - ! --------------------------------------------------------------------- ! to atm: merged surface temperature and unmerged temperatures from ice and ocn ! --------------------------------------------------------------------- @@ -2045,38 +1897,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if - if (flds_wiso) then - if (phase == 'advertise') then - call addfld_from(compatm, 'Faxa_rainc_wiso') - call addfld_from(compatm, 'Faxa_rainl_wiso') - call addfld_to(compocn, 'Faxa_rain_wiso' ) - call addfld_from(compatm, 'Faxa_snowc_wiso') - call addfld_from(compatm, 'Faxa_snowl_wiso') - call addfld_from(compatm, 'Faxa_snow_wiso' ) - else - ! Note that the mediator atm/ocn flux calculation needs Faxa_rainc for the gustiness parameterization - ! which by default is not actually used - if ( fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainl_wiso', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainc_wiso', rc=rc) .and. & - fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_rain_wiso' , rc=rc)) then - call addmap_from(compatm, 'Faxa_rainl_wiso', compocn, mapconsf, 'one', atm2ocn_map) - call addmap_from(compatm, 'Faxa_rainc_wiso', compocn, mapconsf, 'one', atm2ocn_map) - call addmrg_to(compocn, 'Faxa_rain_wiso' , & - mrg_from=compatm, mrg_fld=trim('Faxa_rainc_wiso')//':'//trim('Faxa_rainl_wiso'), & - mrg_type='sum_with_weights', mrg_fracname='ofrac') - end if - if ( fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_snow_wiso', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowl_wiso', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowc_wiso', rc=rc)) then - call addmap_from(compatm, 'Faxa_snowl_wiso', compocn, mapconsf, 'one', atm2ocn_map) - call addmap_from(compatm, 'Faxa_snowc_wiso', compocn, mapconsf, 'one', atm2ocn_map) - call addmrg_to(compocn, 'Faxa_snow_wiso', & - mrg_from=compatm, mrg_fld=trim('Faxa_snowc_wiso')//':'//trim('Faxa_snowl_wiso'), & - mrg_type='sum_with_weights', mrg_fracname='ofrac') - end if - end if - end if - ! --------------------------------------------------------------------- ! to ocn: merged sensible heat flux ! --------------------------------------------------------------------- @@ -2113,18 +1933,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if - if (flds_wiso) then - if (phase == 'advertise') then - call addfld_aoflux( 'Faox_lat_wiso' ) - call addfld_to(compocn, 'Foxx_lat_wiso' ) - else - if ( fldchk(is_local%wrap%FBexp(compocn), 'Foxx_lat_wiso', rc=rc)) then - call addmrg_to(compocn, 'Foxx_lat_wiso', & - mrg_from=compmed, mrg_fld='Faox_lat_wiso', mrg_type='merge', mrg_fracname='ofrac') - end if - end if - end if - ! --------------------------------------------------------------------- ! to ocn: wind speed squared at 10 meters from med ! --------------------------------------------------------------------- @@ -2317,19 +2125,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) mrg_from=compice, mrg_fld='Fioi_meltw', mrg_type='copy_with_weights', mrg_fracname='ifrac') end if end if - if (flds_wiso) then - if (phase == 'advertise') then - call addfld_from(compice , 'Fioi_meltw_wiso') - call addfld_to(compocn , 'Fioi_meltw_wiso') - else - if ( fldchk(is_local%wrap%FBexp(compocn) , 'Fioi_meltw_wiso', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compice, compice), 'Fioi_meltw_wiso', rc=rc)) then - call addmap_from(compice, 'Fioi_meltw_wiso', compocn, mapfcopy, 'unset', 'unset') - call addmrg_to(compocn, 'Fioi_meltw_wiso', & - mrg_from=compice, mrg_fld='Fioi_meltw_wiso', mrg_type='copy_with_weights', mrg_fracname='ifrac') - end if - end if - end if ! --------------------------------------------------------------------- ! to ocn: heat flux from melting ice from ice ! --------------------------------------------------------------------- @@ -2549,7 +2344,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if if (ocn_name == 'mpaso') then !----------------------------- - ! to ocn: + ! to ocn: !----------------------------- if (phase == 'advertise') then call addfld_from(compwav, 'Sw_Hs') @@ -2562,7 +2357,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if !----------------------------- - ! to ocn: + ! to ocn: !----------------------------- if (phase == 'advertise') then call addfld_from(compwav, 'Sw_Fp') @@ -2575,7 +2370,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if !----------------------------- - ! to ocn: + ! to ocn: !----------------------------- if (phase == 'advertise') then call addfld_from(compwav, 'Sw_ustokes_wavenumber_1') @@ -2588,7 +2383,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if !----------------------------- - ! to ocn: + ! to ocn: !----------------------------- if (phase == 'advertise') then call addfld_from(compwav, 'Sw_vstokes_wavenumber_1') @@ -2601,7 +2396,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if !----------------------------- - ! to ocn: + ! to ocn: !----------------------------- if (phase == 'advertise') then call addfld_from(compwav, 'Sw_ustokes_wavenumber_2') @@ -2614,7 +2409,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if !----------------------------- - ! to ocn: + ! to ocn: !----------------------------- if (phase == 'advertise') then call addfld_from(compwav, 'Sw_vstokes_wavenumber_2') @@ -2627,7 +2422,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if !----------------------------- - ! to ocn: + ! to ocn: !----------------------------- if (phase == 'advertise') then call addfld_from(compwav, 'Sw_ustokes_wavenumber_3') @@ -2640,7 +2435,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if !----------------------------- - ! to ocn: + ! to ocn: !----------------------------- if (phase == 'advertise') then call addfld_from(compwav, 'Sw_vstokes_wavenumber_3') @@ -2653,7 +2448,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if !----------------------------- - ! to ocn: + ! to ocn: !----------------------------- if (phase == 'advertise') then call addfld_from(compwav, 'Sw_ustokes_wavenumber_4') @@ -2666,7 +2461,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if !----------------------------- - ! to ocn: + ! to ocn: !----------------------------- if (phase == 'advertise') then call addfld_from(compwav, 'Sw_vstokes_wavenumber_4') @@ -2679,7 +2474,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if !----------------------------- - ! to ocn: + ! to ocn: !----------------------------- if (phase == 'advertise') then call addfld_from(compwav, 'Sw_ustokes_wavenumber_5') @@ -2692,7 +2487,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if !----------------------------- - ! to ocn: + ! to ocn: !----------------------------- if (phase == 'advertise') then call addfld_from(compwav, 'Sw_vstokes_wavenumber_5') @@ -2705,7 +2500,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if !----------------------------- - ! to ocn: + ! to ocn: !----------------------------- if (phase == 'advertise') then call addfld_from(compwav, 'Sw_ustokes_wavenumber_6') @@ -2718,7 +2513,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if !----------------------------- - ! to ocn: + ! to ocn: !----------------------------- if (phase == 'advertise') then call addfld_from(compwav, 'Sw_vstokes_wavenumber_6') @@ -2731,7 +2526,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if !----------------------------- - ! to ocn: + ! to ocn: !----------------------------- if (phase == 'advertise') then call addfld_from(compwav, 'Sw_ustokes_wavenumber_6') @@ -2744,7 +2539,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if !----------------------------- - ! to ocn: + ! to ocn: !----------------------------- if (phase == 'advertise') then call addfld_from(compwav, 'Sw_vstokes_wavenumber_6') @@ -3004,49 +2799,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if - if (flds_wiso) then - if (phase == 'advertise') then - call addfld_from(compatm, 'Faxa_rainc_wiso') - call addfld_from(compatm, 'Faxa_rainl_wiso') - call addfld_from(compatm, 'Faxa_rain_wiso' ) - call addfld_to(compice, 'Faxa_rain_wiso' ) - else - if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_rain_wiso' , rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainl_wiso', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainc_wiso', rc=rc)) then - call addmap_from(compatm, 'Faxa_rainc_wiso', compice, mapconsf, 'one', atm2ice_map) - call addmap_from(compatm, 'Faxa_rainl_wiso', compice, mapconsf, 'one', atm2ice_map) - call addmrg_to(compice, 'Faxa_rain_wiso' , & - mrg_from=compatm, mrg_fld='Faxa_rainc_wiso:Faxa_rainl_wiso', mrg_type='sum') - else if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_rain_wiso', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rain_wiso', rc=rc)) then - call addmap_from(compatm, 'Faxa_rain_wiso', compice, mapconsf, 'one', atm2ice_map) - call addmrg_to(compice, 'Faxa_rain_wiso', & - mrg_from=compatm, mrg_fld='Faxa_rain_wiso', mrg_type='copy') - end if - end if - - if (phase == 'advertise') then - call addfld_from(compatm, 'Faxa_snowc_wiso') - call addfld_from(compatm, 'Faxa_snowl_wiso') - call addfld_from(compatm, 'Faxa_snow_wiso' ) - call addfld_to(compice, 'Faxa_snow_wiso' ) - else - if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_snow_wiso', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowl_wiso', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowc_wiso', rc=rc)) then - call addmap_from(compatm, 'Faxa_snowc_wiso', compice, mapconsf, 'one', atm2ice_map) - call addmap_from(compatm, 'Faxa_snowl_wiso', compice, mapconsf, 'one', atm2ice_map) - call addmrg_to(compice, 'Faxa_snow_wiso' , & - mrg_from=compatm, mrg_fld='Faxa_snowc_wiso:Faxa_snowl_wiso', mrg_type='sum') - else if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_snow_wiso', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snow_wiso', rc=rc)) then - call addmap_from(compatm, 'Faxa_snow_wiso', compice, mapconsf, 'one', atm2ice_map) - call addmrg_to(compice, 'Faxa_snow_wiso', mrg_from=compatm, mrg_fld='Faxa_snow_wiso', mrg_type='copy') - end if - end if - end if - ! --------------------------------------------------------------------- ! to ice: height at the lowest model level from atm ! --------------------------------------------------------------------- @@ -3146,7 +2898,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if ! --------------------------------------------------------------------- ! to ice: specific humidity at the lowest model level from atm - ! to ice: specific humidity for water isotopes at the lowest model level from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then call addfld_from(compatm, 'Sa_shum') @@ -3158,19 +2909,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmrg_to(compice, 'Sa_shum', mrg_from=compatm, mrg_fld='Sa_shum', mrg_type='copy') end if end if - if (flds_wiso) then - if (phase == 'advertise') then - call addfld_from(compatm, 'Sa_shum_wiso') - call addfld_to(compice, 'Sa_shum_wiso') - else - if ( fldchk(is_local%wrap%FBexp(compice) , 'Sa_shum_wiso', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_shum_wiso', rc=rc)) then - call addmap_from(compatm, 'Sa_shum_wiso', compice, mapbilnr, 'one', atm2ice_map) - call addmrg_to(compice, 'Sa_shum_wiso', mrg_from=compatm, mrg_fld='Sa_shum_wiso', mrg_type='copy') - end if - end if - end if - ! --------------------------------------------------------------------- ! to ice: sea surface temperature from ocn ! --------------------------------------------------------------------- @@ -3273,22 +3011,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if end if - !----------------------------- - ! to ice: Ratio of ocean surface level abund. H2_16O/H2O/Rstd from ocean - !----------------------------- - if (flds_wiso) then - if (phase == 'advertise') then - call addfld_from(compocn, 'So_roce_wiso') - call addfld_to(compice, 'So_roce_wiso') - else - if ( fldchk(is_local%wrap%FBImp(compocn, compocn), 'So_roce_wiso', rc=rc) .and. & - fldchk(is_local%wrap%FBExp(compice) , 'So_roce_wiso', rc=rc)) then - call addmap_from(compocn, 'So_roce_wiso', compice, mapfcopy, 'unset', 'unset') - call addmrg_to(compice, 'So_roce_wiso', mrg_from=compocn, mrg_fld='So_roce_wiso', mrg_type='copy') - end if - end if - end if - ! --------------------------------------------------------------------- ! to ice: wave elevation spectrum (field with ungridded dimensions) ! --------------------------------------------------------------------- @@ -3494,27 +3216,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) 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) ! --------------------------------------------------------------------- diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index d9248bf93..96489eca2 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -43,10 +43,6 @@ canonical_units: kg m-2 s-1 description: med export - atm/ocn evaporation water flux computed in medidator # - - standard_name: Faox_evap_wiso - canonical_units: kg m-2 s-1 - description: med export - atm/ocn evaporation water flux 16O, 18O, HDO computed in medidator - # - standard_name: Faox_lat alias: mean_laten_heat_flx_atm_into_ocn canonical_units: W m-2 @@ -90,10 +86,6 @@ canonical_units: kg m-2 s-1 description: lnd import to med # - - standard_name: Fall_evap_wiso - canonical_units: kg m-2 s-1 - description: lnd import to med - # - standard_name: Fall_fco2_lnd canonical_units: moles m-2 s-1 description: lnd import to med @@ -174,10 +166,6 @@ canonical_units: kg kg-1 description: lnd import to med # - - standard_name: Sl_qref_wiso - canonical_units: kg kg-1 - description: lnd import to med - # - standard_name: Sl_ram1 canonical_units: s/m description: lnd import to med @@ -186,10 +174,6 @@ canonical_units: m description: lnd import to med # - - standard_name: Sl_snowh_wiso - canonical_units: m - description: lnd import to med - # - standard_name: Sl_soilw canonical_units: m3/m3 description: lnd import to med @@ -302,61 +286,32 @@ canonical_units: kg(N)/m2/sec description: atm import to med - currently nhx and noy # - - standard_name: Faxa_prec_wiso - canonical_units: kg m-2 s-1 - description: atm import to med - # - standard_name: Faxa_rain alias: mean_prec_rate canonical_units: kg m-2 s-1 description: atm import to med # - - standard_name: Faxa_rain_wiso - alias: mean_prec_rate_wiso - canonical_units: kg m-2 s-1 - description: atm import to med - # - standard_name: Faxa_rainc canonical_units: kg m-2 s-1 description: atm import to med # - - standard_name: Faxa_rainc_wiso - canonical_units: kg m-2 s-1 - description: atm import to med - # - standard_name: Faxa_rainl canonical_units: kg m-2 s-1 description: atm import to med # - - standard_name: Faxa_rainl_wiso - canonical_units: kg m-2 s-1 - description: atm import to med - # - standard_name: Faxa_snow alias: mean_fprec_rate canonical_units: kg m-2 s-1 description: atm import to med # - - standard_name: Faxa_snow_wiso - canonical_units: kg m-2 s-1 - description: atm import to med - # - standard_name: Faxa_snowc canonical_units: kg m-2 s-1 description: atm import to med # - - standard_name: Faxa_snowc_wiso - canonical_units: kg m-2 s-1 - description: atm import to med - # - standard_name: Faxa_snowl canonical_units: kg m-2 s-1 description: atm import to med # - - standard_name: Faxa_snowl_wiso - canonical_units: kg m-2 s-1 - description: atm import to med - # - standard_name: Faxa_swnet canonical_units: W m-2 description: atm import to med @@ -430,11 +385,6 @@ canonical_units: kg kg-1 description: atm import to med - bottom layer specific humidiaty # - - standard_name: Sa_shum_wiso - alias: inst_spec_humid_height_lowest_wiso - canonical_units: kg kg-1 - description: atm import to med - bottom layer specific humidity 16O, 18O, HDO - # - standard_name: Sa_tbot alias: inst_temp_height_lowest canonical_units: K @@ -501,10 +451,6 @@ canonical_units: kg m-2 s-1 description: atm export from meditor - merged water evaporation flux # - - standard_name: Faxx_evap_wiso - canonical_units: kg m-2 s-1 - description: atm export from med - merged water evaporation flux for 16O, 18O and HDO - # - standard_name: Faxx_lat alias: mean_laten_heat_flx canonical_units: W m-2 @@ -549,10 +495,6 @@ canonical_units: kg kg-1 description: atm export from med # - - standard_name: Sx_qref_wiso - canonical_units: kg kg-1 - description: atm export from med - # - standard_name: Sx_t alias: surface_temperature canonical_units: K @@ -589,26 +531,14 @@ 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 # - - standard_name: Figg_rofi_wiso - canonical_units: kg m-2 s-1 - description: glc import to med - glc frozen runoff_iceberg flux to ice for 16O, 18O, HDO - # - standard_name: Flgg_hflx canonical_units: W m-2 description: glc import to med to med (no elevation classes) @@ -660,10 +590,6 @@ canonical_units: kg m-2 s-1 description: ice import to med # - - standard_name: Faii_evap_wiso - canonical_units: kg m-2 s-1 - description: ice import to med for 16O, 18O, HDO - # - standard_name: Faii_lat alias: mean_laten_heat_flx_atm_into_ice canonical_units: W m-2 @@ -710,24 +636,11 @@ canonical_units: W m-2 description: ice import to med to ocean - net heat flux to ocean # - - standard_name: Fioi_melth_wiso - canonical_units: kg m-2 s-1 - description: ice import to med to ocean - isotope head flux to ocean for 16O, 18O, HDO - # - - standard_name: Fioi_melth_HDO - canonical_units: kg m-2 s-1 - description: ice import to med to ocean - isotope head flux to ocean - # - standard_name: Fioi_meltw alias: mean_fresh_water_to_ocean_rate canonical_units: kg m-2 s-1 description: ice import to med to ocean - fresh water to ocean (h2o flux from melting) # - - standard_name: Fioi_meltw_wiso - alias: mean_fresh_water_to_ocean_rate_wiso - canonical_units: kg m-2 s-1 - description: ice import to med to ocean - fresh water to ocean (h2o flux from melting) for 16O, 18O, HDO - # - standard_name: Fioi_salt alias: mean_salt_rate canonical_units: kg m-2 s-1 @@ -807,10 +720,6 @@ canonical_units: kg kg-1 description: ice import to med # - - standard_name: Si_qref_wiso - canonical_units: kg kg-1 - description: ice import to med - # - standard_name: Si_t alias: sea_ice_surface_temperature canonical_units: K @@ -941,22 +850,10 @@ canonical_units: kg kg-1 description: ocn import to med # - - standard_name: So_qref_wiso - canonical_units: kg kg-1 - description: ocn import to med - # - standard_name: So_re canonical_units: 1 description: ocn import to med # - - standard_name: So_qref_wiso - canonical_units: kg kg-1 - description: ocn import to med - # - - standard_name: So_roce_wiso - canonical_units: unitless - description: ocn import to med - # - standard_name: So_s alias: s_surf canonical_units: g kg-1 @@ -1052,19 +949,10 @@ canonical_units: kg m-2 s-1 description: med export to ocn - specific humidity flux # - - standard_name: Foxx_evap_wiso - alias: mean_evap_rate_wiso - canonical_units: kg m-2 s-1 - description: med export to ocn - specific humidity flux 16O, 18O, HDO - # - standard_name: Foxx_lat canonical_units: W m-2 description: med export to ocn - latent heat flux into ocean # - - standard_name: Foxx_lat_wiso - canonical_units: W m-2 - description: med export to ocn - latent heat flux into ocean for 16O, 18O, HDO - # - standard_name: Foxx_lat canonical_units: W m-2 description: med export to ocn - latent heat flux into ocean for HDO @@ -1103,19 +991,11 @@ canonical_units: kg m-2 s-1 description: med export to ocn - water flux due to runoff (frozen) # - - standard_name: Foxx_rofi_wiso - canonical_units: kg m-2 s-1 - description: med export to ocn - water flux due to runoff (frozen) for 16O, 18O, HDO - # - standard_name: Foxx_rofl alias: mean_runoff_rate canonical_units: kg m-2 s-1 description: med export to ocn - water flux due to runoff (liquid) # - - standard_name: Foxx_rofl_wiso - canonical_units: kg m-2 s-1 - description: med export to ocn - water flux due to runoff (liquid) for 16O, 18O, HDO - # - standard_name: Foxx_swnet alias: mean_net_sw_flx canonical_units: W m-2 @@ -1176,26 +1056,14 @@ canonical_units: kg m-2 s-1 description: river import to med - water flux due to flooding # - - standard_name: Flrr_flood_wiso - canonical_units: kg m-2 s-1 - description: river import to med - water flux due to flooding for 16O, 18O, HDO - # - standard_name: Flrr_volr canonical_units: m description: river import to med - river channel total water volume # - - standard_name: Flrr_volr_wiso - canonical_units: m - description: river import to med - river channel total water volume from 16O, 18O, HDO - # - standard_name: Flrr_volrmch canonical_units: m description: river import to med - river channel main channel water volume # - - standard_name: Flrr_volrmch_wiso - canonical_units: m - description: river import to med - river channel main channel water volume from 16O, 18O, HDO - # - standard_name: Sr_tdepth canonical_units: m description: river import to med - tributary channel water depth @@ -1212,10 +1080,6 @@ 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 - # - standard_name: Forr_rofl canonical_units: kg m-2 s-1 description: river import to med - water flux due to runoff (liquid) @@ -1224,10 +1088,6 @@ canonical_units: kg m-2 s-1 description: river import to med - water flux due to runoff originating from glc (liquid) # - - standard_name: Forr_rofl_wiso - canonical_units: kg m-2 s-1 - 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_diag_mod.F90 b/mediator/med_diag_mod.F90 index 6dd8e9808..35fed0dce 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -33,7 +33,7 @@ module med_diag_mod use med_utils_mod , only : chkerr => med_utils_ChkErr use perf_mod , only : t_startf, t_stopf use shr_log_mod , only : shr_log_error - + implicit none private @@ -162,28 +162,6 @@ module med_diag_mod integer :: f_watr_roff = unset_index ! water: runoff/flood integer :: f_watr_roff_glc = unset_index ! water: runoff/flood from glc integer :: f_watr_ioff = unset_index ! water: frozen runoff - integer :: f_watr_ioff_glc = unset_index ! water: frozen runoff from glc - integer :: f_watr_frz_16O = unset_index ! water isotope: freezing - integer :: f_watr_melt_16O = unset_index ! water isotope: melting - integer :: f_watr_rain_16O = unset_index ! water isotope: precip, liquid - integer :: f_watr_snow_16O = unset_index ! water isotope: prcip, frozen - integer :: f_watr_evap_16O = unset_index ! water isotope: evaporation - integer :: f_watr_roff_16O = unset_index ! water isotope: runoff/flood - integer :: f_watr_ioff_16O = unset_index ! water isotope: frozen runoff - integer :: f_watr_frz_18O = unset_index ! water isotope: freezing - integer :: f_watr_melt_18O = unset_index ! water isotope: melting - integer :: f_watr_rain_18O = unset_index ! water isotope: precip, liquid - integer :: f_watr_snow_18O = unset_index ! water isotope: precip, frozen - integer :: f_watr_evap_18O = unset_index ! water isotope: evaporation - integer :: f_watr_roff_18O = unset_index ! water isotope: runoff/flood - integer :: f_watr_ioff_18O = unset_index ! water isotope: frozen runoff - integer :: f_watr_frz_HDO = unset_index ! water isotope: freezing - integer :: f_watr_melt_HDO = unset_index ! water isotope: melting - integer :: f_watr_rain_HDO = unset_index ! water isotope: precip, liquid - integer :: f_watr_snow_HDO = unset_index ! water isotope: precip, frozen - integer :: f_watr_evap_HDO = unset_index ! water isotope: evaporation - integer :: f_watr_roff_HDO = unset_index ! water isotope: runoff/flood - integer :: f_watr_ioff_HDO = unset_index ! water isotope: frozen runoff integer :: f_heat_beg = unset_index ! 1st index for heat integer :: f_heat_end = unset_index ! Last index for heat @@ -192,25 +170,6 @@ module med_diag_mod integer :: f_salt_beg = unset_index ! 1st index for salt integer :: f_salt_end = unset_index ! Last index for salt - integer :: f_16O_beg = unset_index ! 1st index for 16O water isotope - integer :: f_16O_end = unset_index ! Last index for 16O water isotope - integer :: f_18O_beg = unset_index ! 1st index for 18O water isotope - integer :: f_18O_end = unset_index ! Last index for 18O water isotope - integer :: f_HDO_beg = unset_index ! 1st index for HDO water isotope - integer :: f_HDO_end = unset_index ! Last index for HDO water isotope - - ! --------------------------------- - ! water isotopes names and indices - ! --------------------------------- - - logical :: flds_wiso = .false.! If water isotope fields are active - - ! TODO: for now set to .false. - but this needs to be set in an initialization phase - - integer, parameter :: nisotopes = 3 - integer :: iso0(nisotopes) - integer :: isof(nisotopes) - character(len=5) :: isoname(nisotopes) - ! --------------------------------- ! P for period ! --------------------------------- @@ -373,43 +332,6 @@ subroutine med_diag_init(gcomp, rc) end if f_watr_end = f_watr_ioff_glc ! field last index for water - if (flds_wiso) then - call add_to_budget_diag(budget_diags%fields, f_watr_frz_16O ,'wfreeze_16O' ) ! field water isotope: freezing - call add_to_budget_diag(budget_diags%fields, f_watr_melt_16O ,'wmelt_16O' ) ! field water isotope: melting - call add_to_budget_diag(budget_diags%fields, f_watr_rain_16O ,'wrain_16O' ) ! field water isotope: precip, liquid - call add_to_budget_diag(budget_diags%fields, f_watr_snow_16O ,'wsnow_16O' ) ! field water isotope: prcip, frozen - call add_to_budget_diag(budget_diags%fields, f_watr_evap_16O ,'wevap_16O' ) ! field water isotope: evaporation - call add_to_budget_diag(budget_diags%fields, f_watr_roff_16O ,'wrunoff_16O' ) ! field water isotope: runoff/flood - call add_to_budget_diag(budget_diags%fields, f_watr_ioff_16O ,'wfrzrof_16O' ) ! field water isotope: frozen runoff - f_16O_beg = f_watr_frz_16O ! field 1st index for 16O water isotope - f_16O_end = f_watr_ioff_16O ! field Last index for 16O water isotope - - call add_to_budget_diag(budget_diags%fields, f_watr_frz_18O ,'wfreeze_18O' ) ! field water isotope: freezing - call add_to_budget_diag(budget_diags%fields, f_watr_melt_18O ,'wmelt_18O' ) ! field water isotope: melting - call add_to_budget_diag(budget_diags%fields, f_watr_rain_18O ,'wrain_18O' ) ! field water isotope: precip, liquid - call add_to_budget_diag(budget_diags%fields, f_watr_snow_18O ,'wsnow_18O' ) ! field water isotope: precip, frozen - call add_to_budget_diag(budget_diags%fields, f_watr_evap_18O ,'wevap_18O' ) ! field water isotope: evaporation - call add_to_budget_diag(budget_diags%fields, f_watr_roff_18O ,'wrunoff_18O' ) ! field water isotope: runoff/flood - call add_to_budget_diag(budget_diags%fields, f_watr_ioff_18O ,'wfrzrof_18O' ) ! field water isotope: frozen runoff - f_18O_beg = f_watr_frz_18O ! field 1st index for 18O water isotope - f_18O_end = f_watr_ioff_18O ! field Last index for 18O water isotope - - call add_to_budget_diag(budget_diags%fields, f_watr_frz_HDO ,'wfreeze_HDO' ) ! field water isotope: freezing - call add_to_budget_diag(budget_diags%fields, f_watr_melt_HDO ,'wmelt_HDO' ) ! field water isotope: melting - call add_to_budget_diag(budget_diags%fields, f_watr_rain_HDO ,'wrain_HDO' ) ! field water isotope: precip, liquid - call add_to_budget_diag(budget_diags%fields, f_watr_snow_HDO ,'wsnow_HDO' ) ! field water isotope: precip, frozen - call add_to_budget_diag(budget_diags%fields, f_watr_evap_HDO ,'wevap_HDO' ) ! field water isotope: evaporation - call add_to_budget_diag(budget_diags%fields, f_watr_roff_HDO ,'wrunoff_HDO' ) ! field water isotope: runoff/flood - call add_to_budget_diag(budget_diags%fields, f_watr_ioff_HDO ,'wfrzrof_HDO' ) ! field water isotope: frozen runoff - f_HDO_beg = f_watr_frz_HDO ! field 1st index for HDO water isotope - f_HDO_end = f_watr_ioff_HDO ! field Last index for HDO water isotope - - ! water isotopes - iso0(:) = (/ f_16O_beg, f_18O_beg, f_hdO_beg /) - isof(:) = (/ f_16O_end, f_18O_end, f_hdO_end /) - isoname(:) = (/ 'H216O', 'H218O', ' HDO' /) - end if - ! ----------------------------------------- ! Salt fluxes budget terms (for v1 only) ! ----------------------------------------- @@ -729,15 +651,6 @@ subroutine med_phases_diag_atm(gcomp, rc) areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (flds_wiso) then - call diag_atm_wiso_recv(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainc_wiso', & - f_watr_rain_16O, f_watr_rain_18O, f_watr_rain_HDO, areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_atm_wiso_recv(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainl_wiso', & - f_watr_rain_16O, f_watr_rain_18O, f_watr_rain_HDO, areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - ! heat implied by snow flux from atm to mediator budget_local(f_heat_latf,c_atm_recv ,ip) = -budget_local(f_watr_snow,c_atm_recv ,ip)*shr_const_latice budget_local(f_heat_latf,c_lnd_arecv,ip) = -budget_local(f_watr_snow,c_lnd_arecv,ip)*shr_const_latice @@ -775,14 +688,6 @@ subroutine med_phases_diag_atm(gcomp, rc) areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! water isotopes - if (flds_wiso) then - call diag_atm_wiso_send(is_local%wrap%FBImp(compatm,compatm), 'Faxa_evap_wiso', & - f_watr_evap_16O, f_watr_evap_18O, f_watr_evap_HDO, & - areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - deallocate(afrac) call t_stopf('MED:'//subname) end subroutine med_phases_diag_atm @@ -857,118 +762,6 @@ subroutine diag_atm_send(FB, fldname, nf, areas, lats, afrac, lfrac, ofrac, ifra end if end subroutine diag_atm_send - subroutine diag_atm_wiso_recv(FB, fldname, nf_16O, nf_18O, nf_HDO, areas, lats, & - afrac, lfrac, ofrac, ifrac, budget, rc) - ! input/output variables - type(ESMF_FieldBundle) , intent(in) :: FB - character(len=*) , intent(in) :: fldname - integer , intent(in) :: nf_16O - integer , intent(in) :: nf_18O - integer , intent(in) :: nf_HDO - real(r8) , intent(in) :: areas(:) - real(r8) , intent(in) :: lats(:) - real(r8) , intent(in) :: afrac(:) - real(r8) , intent(in) :: lfrac(:) - real(r8) , intent(in) :: ofrac(:) - real(r8) , intent(in) :: ifrac(:) - real(r8) , intent(inout) :: budget(:,:,:) - integer , intent(out) :: rc - ! local variables - integer :: n, ip - real(r8), pointer :: data(:,:) - ! ------------------------------------------------------------------ - rc = ESMF_SUCCESS - if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then - call fldbun_getdata2d(FB, trim(fldname), data, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ip = period_inst - do n = 1,size(data, dim=2) - budget(nf_16O,c_atm_recv,ip) = budget(nf_16O,c_atm_recv,ip) - areas(n)*afrac(n)*data(1,n) - budget(nf_16O,c_lnd_arecv,ip) = budget(nf_16O,c_lnd_arecv,ip) + areas(n)*lfrac(n)*data(1,n) - budget(nf_16O,c_ocn_arecv,ip) = budget(nf_16O,c_ocn_arecv,ip) + areas(n)*ofrac(n)*data(1,n) - if (lats(n) > 0.0_r8) then - budget(nf_16O,c_inh_arecv,ip) = budget(nf_16O,c_inh_arecv,ip) + areas(n)*ifrac(n)*data(1,n) - else - budget(nf_16O,c_ish_arecv,ip) = budget(nf_16O,c_ish_arecv,ip) + areas(n)*ifrac(n)*data(1,n) - end if - - budget(nf_18O,c_atm_recv,ip) = budget(nf_18O,c_atm_recv,ip) - areas(n)*afrac(n)*data(2,n) - budget(nf_18O,c_lnd_arecv,ip) = budget(nf_18O,c_lnd_arecv,ip) + areas(n)*lfrac(n)*data(2,n) - budget(nf_18O,c_ocn_arecv,ip) = budget(nf_18O,c_ocn_arecv,ip) + areas(n)*ofrac(n)*data(2,n) - if (lats(n) > 0.0_r8) then - budget(nf_18O,c_inh_arecv,ip) = budget(nf_18O,c_inh_arecv,ip) + areas(n)*ifrac(n)*data(2,n) - else - budget(nf_18O,c_ish_arecv,ip) = budget(nf_18O,c_ish_arecv,ip) + areas(n)*ifrac(n)*data(2,n) - end if - - budget(nf_HDO,c_atm_recv,ip) = budget(nf_HDO,c_atm_recv,ip) - areas(n)*afrac(n)*data(3,n) - budget(nf_HDO,c_lnd_arecv,ip) = budget(nf_HDO,c_lnd_arecv,ip) + areas(n)*lfrac(n)*data(3,n) - budget(nf_HDO,c_ocn_arecv,ip) = budget(nf_HDO,c_ocn_arecv,ip) + areas(n)*ofrac(n)*data(3,n) - if (lats(n) > 0.0_r8) then - budget(nf_HDO,c_inh_arecv,ip) = budget(nf_HDO,c_inh_arecv,ip) + areas(n)*ifrac(n)*data(3,n) - else - budget(nf_HDO,c_ish_arecv,ip) = budget(nf_HDO,c_ish_arecv,ip) + areas(n)*ifrac(n)*data(3,n) - end if - end do - end if - end subroutine diag_atm_wiso_recv - - subroutine diag_atm_wiso_send(FB, fldname, nf_16O, nf_18O, nf_HDO, areas, lats, & - afrac, lfrac, ofrac, ifrac, budget, rc) - ! input/output variables - type(ESMF_FieldBundle) , intent(in) :: FB - character(len=*) , intent(in) :: fldname - integer , intent(in) :: nf_16O - integer , intent(in) :: nf_18O - integer , intent(in) :: nf_HDO - real(r8) , intent(in) :: areas(:) - real(r8) , intent(in) :: lats(:) - real(r8) , intent(in) :: afrac(:) - real(r8) , intent(in) :: lfrac(:) - real(r8) , intent(in) :: ofrac(:) - real(r8) , intent(in) :: ifrac(:) - real(r8) , intent(inout) :: budget(:,:,:) - integer , intent(out) :: rc - ! local variables - integer :: n, ip - real(r8), pointer :: data(:,:) - ! ------------------------------------------------------------------ - rc = ESMF_SUCCESS - if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then - call fldbun_getdata2d(FB, trim(fldname), data, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ip = period_inst - do n = 1,size(data, dim=2) - budget(nf_16O,c_atm_send,ip) = budget(nf_16O,c_atm_send,ip) - areas(n)*afrac(n)*data(1,n) - budget(nf_16O,c_lnd_asend,ip) = budget(nf_16O,c_lnd_asend,ip) + areas(n)*lfrac(n)*data(1,n) - budget(nf_16O,c_ocn_asend,ip) = budget(nf_16O,c_ocn_asend,ip) + areas(n)*ofrac(n)*data(1,n) - if (lats(n) > 0.0_r8) then - budget(nf_16O,c_inh_asend,ip) = budget(nf_16O,c_inh_asend,ip) + areas(n)*ifrac(n)*data(1,n) - else - budget(nf_16O,c_ish_asend,ip) = budget(nf_16O,c_ish_asend,ip) + areas(n)*ifrac(n)*data(1,n) - end if - - budget(nf_18O,c_atm_send,ip) = budget(nf_18O,c_atm_send,ip) - areas(n)*afrac(n)*data(2,n) - budget(nf_18O,c_lnd_asend,ip) = budget(nf_18O,c_lnd_asend,ip) + areas(n)*lfrac(n)*data(2,n) - budget(nf_18O,c_ocn_asend,ip) = budget(nf_18O,c_ocn_asend,ip) + areas(n)*ofrac(n)*data(2,n) - if (lats(n) > 0.0_r8) then - budget(nf_18O,c_inh_asend,ip) = budget(nf_18O,c_inh_asend,ip) + areas(n)*ifrac(n)*data(2,n) - else - budget(nf_18O,c_ish_asend,ip) = budget(nf_18O,c_ish_asend,ip) + areas(n)*ifrac(n)*data(2,n) - end if - - budget(nf_HDO,c_atm_send,ip) = budget(nf_HDO,c_atm_send,ip) - areas(n)*afrac(n)*data(3,n) - budget(nf_HDO,c_lnd_asend,ip) = budget(nf_HDO,c_lnd_asend,ip) + areas(n)*lfrac(n)*data(3,n) - budget(nf_HDO,c_ocn_asend,ip) = budget(nf_HDO,c_ocn_asend,ip) + areas(n)*ofrac(n)*data(3,n) - if (lats(n) > 0.0_r8) then - budget(nf_HDO,c_inh_asend,ip) = budget(nf_HDO,c_inh_asend,ip) + areas(n)*ifrac(n)*data(3,n) - else - budget(nf_HDO,c_ish_asend,ip) = budget(nf_HDO,c_ish_asend,ip) + areas(n)*ifrac(n)*data(3,n) - end if - end do - end if - end subroutine diag_atm_wiso_send - !=============================================================================== subroutine med_phases_diag_lnd( gcomp, rc) @@ -1040,18 +833,6 @@ subroutine med_phases_diag_lnd( gcomp, rc) areas, lfrac, budget_local, minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (flds_wiso) then - call diag_lnd_wiso(is_local%wrap%FBImp(complnd,complnd), 'Flrl_evap_wiso', & - f_watr_evap_16O, f_watr_evap_18O, f_watr_evap_HDO, ic, areas, lfrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_lnd_wiso(is_local%wrap%FBImp(complnd,complnd), 'Flrl_rofl_wiso', & - f_watr_roff_16O, f_watr_roff_18O, f_watr_roff_HDO, ic, areas, lfrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_lnd_wiso(is_local%wrap%FBImp(complnd,complnd), 'Flrl_rofi_wiso', & - f_watr_ioff_16O, f_watr_ioff_18O, f_watr_ioff_HDO, ic, areas, lfrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - budget_local(f_heat_ioff,ic,ip) = -budget_local(f_watr_ioff,ic,ip)*shr_const_latice !------------------------------- @@ -1077,23 +858,6 @@ subroutine med_phases_diag_lnd( gcomp, rc) call diag_lnd(is_local%wrap%FBExp(complnd), 'Flrl_flood', f_watr_roff, ic, areas, lfrac, budget_local, minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (flds_wiso) then - call diag_lnd_wiso(is_local%wrap%FBExp(complnd), 'Faxa_rainc_wiso', & - f_watr_rain_16O, f_watr_rain_18O, f_watr_rain_HDO, ic, areas, lfrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_lnd_wiso(is_local%wrap%FBExp(complnd), 'Faxa_rainl_wiso', & - f_watr_rain_16O, f_watr_rain_18O, f_watr_rain_HDO, ic, areas, lfrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_lnd_wiso(is_local%wrap%FBExp(complnd), 'Faxa_snowc_wiso', & - f_watr_snow_16O, f_watr_snow_18O, f_watr_snow_HDO, ic, areas, lfrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_lnd_wiso(is_local%wrap%FBExp(complnd), 'Faxa_snowl_wiso', & - f_watr_snow_16O, f_watr_snow_18O, f_watr_snow_HDO, ic, areas, lfrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_lnd_wiso(is_local%wrap%FBExp(complnd), 'Flrl_flood_wiso', & - f_watr_roff_16O, f_watr_roff_18O, f_watr_roff_HDO, ic, areas, lfrac, budget_local, minus=.true., rc=rc) - end if - budget_local(f_heat_latf,ic,ip) = -budget_local(f_watr_snow,ic,ip)*shr_const_latice call t_stopf('MED:'//subname) @@ -1130,43 +894,6 @@ subroutine diag_lnd(FB, fldname, nf, ic, areas, lfrac, budget, minus, rc) end if end subroutine diag_lnd - subroutine diag_lnd_wiso(FB, fldname, nf_16O, nf_18O, nf_HDO, ic, areas, lfrac, budget, minus, rc) - ! input/output variables - type(ESMF_FieldBundle) , intent(in) :: FB - character(len=*) , intent(in) :: fldname - integer , intent(in) :: nf_16O - integer , intent(in) :: nf_18O - integer , intent(in) :: nf_HDO - integer , intent(in) :: ic - real(r8) , intent(in) :: areas(:) - real(r8) , intent(in) :: lfrac(:) - real(r8) , intent(inout) :: budget(:,:,:) - logical, optional , intent(in) :: minus - integer , intent(out) :: rc - ! local variables - integer :: n, ip - real(r8), pointer :: data(:,:) - ! ------------------------------------------------------------------ - rc = ESMF_SUCCESS - - if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then - call fldbun_getdata2d(FB, trim(fldname), data, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ip = period_inst - do n = 1, size(data, dim=2) - if (present(minus)) then - budget(nf_16O,ic,ip) = budget(nf_16O,ic,ip) - areas(n)*lfrac(n)*data(1,n) - budget(nf_18O,ic,ip) = budget(nf_18O,ic,ip) - areas(n)*lfrac(n)*data(2,n) - budget(nf_HDO,ic,ip) = budget(nf_HDO,ic,ip) - areas(n)*lfrac(n)*data(3,n) - else - budget(nf_16O,ic,ip) = budget(nf_16O,ic,ip) + areas(n)*lfrac(n)*data(1,n) - budget(nf_18O,ic,ip) = budget(nf_18O,ic,ip) + areas(n)*lfrac(n)*data(2,n) - budget(nf_HDO,ic,ip) = budget(nf_HDO,ic,ip) + areas(n)*lfrac(n)*data(3,n) - end if - end do - end if - end subroutine diag_lnd_wiso - !=============================================================================== subroutine med_phases_diag_rof( gcomp, rc) @@ -1221,18 +948,6 @@ subroutine med_phases_diag_rof( gcomp, 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', & - f_watr_ioff_16O, f_watr_ioff_18O, f_watr_ioff_HDO, ic, areas, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_rof_wiso(is_local%wrap%FBExp(comprof), 'Forr_rofl_wiso', & - f_watr_roff_16O, f_watr_roff_18O, f_watr_roff_HDO, ic, areas, budget_local, minus=.true., rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_rof_wiso(is_local%wrap%FBExp(comprof), 'Forr_rofi_wiso', & - f_watr_ioff_16O, f_watr_ioff_18O, f_watr_ioff_HDO, ic, areas, budget_local, minus=.true., rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - budget_local(f_heat_ioff,ic,ip) = -budget_local(f_watr_ioff,ic,ip)*shr_const_latice budget_local(f_heat_ioff_glc,ic,ip) = -budget_local(f_watr_ioff_glc,ic,ip)*shr_const_latice @@ -1262,15 +977,6 @@ subroutine med_phases_diag_rof( gcomp, 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', & - f_watr_roff_16O, f_watr_roff_18O, f_watr_roff_HDO, ic, areas, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_rof_wiso(is_local%wrap%FBExp(comprof), 'Flrl_rofi_wiso', & - f_watr_ioff_16O, f_watr_ioff_18O, f_watr_ioff_HDO, ic, areas, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - budget_local(f_heat_ioff,ic,ip) = -budget_local(f_watr_ioff,ic,ip)*shr_const_latice budget_local(f_heat_ioff_glc,ic,ip) = -budget_local(f_watr_ioff_glc,ic,ip)*shr_const_latice @@ -1308,43 +1014,6 @@ subroutine diag_rof(FB, fldname, nf, ic, areas, budget, minus, rc) end if end subroutine diag_rof - subroutine diag_rof_wiso(FB, fldname, nf_16O, nf_18O, nf_HDO, ic, areas, budget, minus, rc) - ! input/output variables - type(ESMF_FieldBundle) , intent(in) :: FB - character(len=*) , intent(in) :: fldname - integer , intent(in) :: nf_16O - integer , intent(in) :: nf_18O - integer , intent(in) :: nf_HDO - integer , intent(in) :: ic - real(r8) , intent(in) :: areas(:) - real(r8) , intent(inout) :: budget(:,:,:) - logical, optional , intent(in) :: minus - integer , intent(out) :: rc - - ! local variables - integer :: n, ip - real(r8), pointer :: data(:,:) - ! ------------------------------------------------------------------ - rc = ESMF_SUCCESS - - if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then - call fldbun_getdata2d(FB, trim(fldname), data, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ip = period_inst - do n = 1, size(data, dim=2) - if (present(minus)) then - budget(nf_16O,ic,ip) = budget(nf_16O,ic,ip) - areas(n)*data(1,n) - budget(nf_18O,ic,ip) = budget(nf_18O,ic,ip) - areas(n)*data(2,n) - budget(nf_HDO,ic,ip) = budget(nf_HDO,ic,ip) - areas(n)*data(3,n) - else - budget(nf_16O,ic,ip) = budget(nf_16O,ic,ip) + areas(n)*data(1,n) - budget(nf_18O,ic,ip) = budget(nf_18O,ic,ip) + areas(n)*data(2,n) - budget(nf_HDO,ic,ip) = budget(nf_HDO,ic,ip) + areas(n)*data(3,n) - end if - end do - end if - end subroutine diag_rof_wiso - !=============================================================================== subroutine med_phases_diag_glc( gcomp, rc) @@ -1577,27 +1246,6 @@ subroutine med_phases_diag_ocn( gcomp, 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) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_ocn_wiso(is_local%wrap%FBExp(compocn), 'Fioi_meltw_wiso', & - f_watr_melt_16O, f_watr_melt_HDO, f_watr_melt_HDO, ic, areas, sfrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_ocn_wiso(is_local%wrap%FBExp(compocn), 'Fioi_rain_wiso' , & - f_watr_rain_16O, f_watr_rain_HDO, f_watr_rain_HDO, ic, areas, sfrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_ocn_wiso(is_local%wrap%FBExp(compocn), 'Fioi_snow_wiso' , & - f_watr_snow_16O, f_watr_snow_HDO, f_watr_snow_HDO, ic, areas, sfrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_ocn_wiso(is_local%wrap%FBExp(compocn), 'Foxx_rofl_wiso' , & - f_watr_roff_16O, f_watr_roff_HDO, f_watr_roff_HDO, ic, areas, sfrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_ocn_wiso(is_local%wrap%FBExp(compocn), 'Foxx_rofi_wiso' , & - f_watr_ioff_16O, f_watr_ioff_HDO, f_watr_ioff_HDO, ic, areas, sfrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hrain', f_heat_rain , ic, areas, sfrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hsnow', f_heat_snow , ic, areas, sfrac, budget_local, rc=rc) @@ -1655,36 +1303,6 @@ subroutine diag_ocn(FB, fldname, nf, ic, areas, frac, budget, scale, rc) end if end subroutine diag_ocn - subroutine diag_ocn_wiso(FB, fldname, nf_16O, nf_18O, nf_HDO, ic, areas, frac, budget, rc) - ! input/output variables - type(ESMF_FieldBundle) , intent(in) :: FB - character(len=*) , intent(in) :: fldname - integer , intent(in) :: nf_16O - integer , intent(in) :: nf_18O - integer , intent(in) :: nf_HDO - integer , intent(in) :: ic - real(r8) , intent(in) :: areas(:) - real(r8) , intent(in) :: frac(:) - real(r8) , intent(inout) :: budget(:,:,:) - integer , intent(out) :: rc - - ! local variables - integer :: n, ip - real(r8), pointer :: data(:,:) - ! ------------------------------------------------------------------ - rc = ESMF_SUCCESS - if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then - call fldbun_getdata2d(FB, trim(fldname), data, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ip = period_inst - do n = 1, size(data, dim=2) - budget(nf_16O,ic,ip) = budget(nf_16O,ic,ip) + areas(n)*frac(n)*data(1,n) - budget(nf_18O,ic,ip) = budget(nf_18O,ic,ip) + areas(n)*frac(n)*data(2,n) - budget(nf_HDO,ic,ip) = budget(nf_HDO,ic,ip) + areas(n)*frac(n)*data(3,n) - end do - end if - end subroutine diag_ocn_wiso - !=============================================================================== subroutine med_phases_diag_ice_ice2med( gcomp, rc) @@ -1782,15 +1400,6 @@ subroutine med_phases_diag_ice_ice2med( gcomp, rc) areas, lats, ifrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (flds_wiso) then - call diag_ice_recv_wiso(is_local%wrap%FBImp(compice,compice), 'Fioi_meltw_wiso', & - f_watr_melt_16O, f_watr_melt_18O, f_watr_melt_HDO, areas, lats, ifrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_ice_recv_wiso(is_local%wrap%FBImp(compice,compice), 'Faii_evap_wiso', & - f_watr_evap_16O, f_watr_evap_18O, f_watr_evap_HDO, areas, lats, ifrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - call t_stopf('MED:'//subname) end subroutine med_phases_diag_ice_ice2med @@ -1838,47 +1447,6 @@ subroutine diag_ice_recv(FB, fldname, nf, areas, lats, ifrac, budget, minus, sca end if end subroutine diag_ice_recv - subroutine diag_ice_recv_wiso(FB, fldname, nf_16O, nf_18O, nf_HDO, areas, lats, ifrac, budget, minus, rc) - ! input/output variables - type(ESMF_FieldBundle) , intent(in) :: FB - character(len=*) , intent(in) :: fldname - integer , intent(in) :: nf_16O - integer , intent(in) :: nf_18O - integer , intent(in) :: nf_HDO - real(r8) , intent(in) :: areas(:) - real(r8) , intent(in) :: lats(:) - real(r8) , intent(in) :: ifrac(:) - real(r8) , intent(inout) :: budget(:,:,:) - logical, optional , intent(in) :: minus - integer , intent(out) :: rc - ! local variables - integer :: n, ic, ip - real(r8), pointer :: data(:,:) - ! ------------------------------------------------------------------ - rc = ESMF_SUCCESS - - if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then - call fldbun_getdata2d(FB, trim(fldname), data, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ip = period_inst - do n = 1, size(data, dim=2) - if (lats(n) > 0.0_r8) then - ic = c_inh_recv - else - ic = c_ish_recv - endif - if (present(minus)) then - budget(nf_16O,ic,ip) = budget(nf_16O,ic,ip) - areas(n)*ifrac(n)*data(1,n) - budget(nf_18O,ic,ip) = budget(nf_18O,ic,ip) - areas(n)*ifrac(n)*data(2,n) - budget(nf_HDO,ic,ip) = budget(nf_HDO,ic,ip) - areas(n)*ifrac(n)*data(3,n) - else - budget(nf_16O,ic,ip) = budget(nf_16O,ic,ip) + areas(n)*ifrac(n)*data(1,n) - budget(nf_18O,ic,ip) = budget(nf_18O,ic,ip) + areas(n)*ifrac(n)*data(2,n) - budget(nf_HDO,ic,ip) = budget(nf_HDO,ic,ip) + areas(n)*ifrac(n)*data(3,n) - end if - end do - end if - end subroutine diag_ice_recv_wiso !=============================================================================== subroutine med_phases_diag_ice_med2ice( gcomp, rc) @@ -1965,15 +1533,6 @@ subroutine med_phases_diag_ice_med2ice( gcomp, rc) budget_local(f_watr_frz ,ic,ip) = budget_local(f_heat_frz ,ic,ip)*HFLXtoWFLX end if - if (flds_wiso) then - call diag_ice_send_wiso(is_local%wrap%FBExp(compice), 'Faxa_rain_wiso', & - f_watr_rain_16O, f_watr_rain_18O, f_watr_rain_HDO, areas, lats, ifrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_ice_send_wiso(is_local%wrap%FBExp(compice), 'Faxa_snow_wiso', & - f_watr_snow_16O, f_watr_snow_18O, f_watr_snow_HDO, areas, lats, ifrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - call t_stopf('MED:'//subname) end subroutine med_phases_diag_ice_med2ice @@ -2007,41 +1566,6 @@ subroutine diag_ice_send(FB, fldname, nf, areas, lats, ifrac, budget, rc) end if end subroutine diag_ice_send - subroutine diag_ice_send_wiso(FB, fldname, nf_16O, nf_18O, nf_HDO, areas, lats, ifrac, budget, rc) - ! input/output variables - type(ESMF_FieldBundle) , intent(in) :: FB - character(len=*) , intent(in) :: fldname - integer , intent(in) :: nf_16O - integer , intent(in) :: nf_18O - integer , intent(in) :: nf_HDO - real(r8) , intent(in) :: areas(:) - real(r8) , intent(in) :: lats(:) - real(r8) , intent(in) :: ifrac(:) - real(r8) , intent(inout) :: budget(:,:,:) - integer , intent(out) :: rc - - ! local variables - integer :: n, ic, ip - real(r8), pointer :: data(:,:) - ! ------------------------------------------------------------------ - rc = ESMF_SUCCESS - if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then - call fldbun_getdata2d(FB, trim(fldname), data, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ip = period_inst - do n = 1, size(data, dim=2) - if (lats(n) > 0.0_r8) then - ic = c_inh_send - else - ic = c_ish_send - endif - budget(nf_16O,ic,ip) = budget(nf_16O,ic,ip) + areas(n)*ifrac(n)*data(1,n) - budget(nf_18O,ic,ip) = budget(nf_18O,ic,ip) + areas(n)*ifrac(n)*data(2,n) - budget(nf_HDO,ic,ip) = budget(nf_HDO,ic,ip) + areas(n)*ifrac(n)*data(3,n) - end do - end if - end subroutine diag_ice_send_wiso - !=============================================================================== subroutine med_phases_diag_print(gcomp, rc) @@ -2159,9 +1683,6 @@ subroutine med_phases_diag_print(gcomp, rc) ! budget normalizations (global area and 1e6 for water) datagpr = datagpr/(4.0_r8*shr_const_pi) datagpr(f_watr_beg:f_watr_end,:,:) = datagpr(f_watr_beg:f_watr_end,:,:) * 1.0e6_r8 - if ( flds_wiso ) then - datagpr(iso0(1):isof(nisotopes),:,:) = datagpr(iso0(1):isof(nisotopes),:,:) * 1.0e6_r8 - end if datagpr(:,:,:) = datagpr(:,:,:)/budget_counter(:,:,:) ! Write diagnostic tables to logunit (maintask only) @@ -2311,38 +1832,6 @@ subroutine med_diag_print_atm(data, ip, date, tod) sum(data(f_watr_beg:f_watr_end,icn,ip)) + sum(data(f_watr_beg:f_watr_end,ics,ip)) + & sum(data(f_watr_beg:f_watr_end,ico,ip)) - if ( flds_wiso ) then - do is = 1, nisotopes - write(diagunit,*) ' ' - write(diagunit,FAH) subname,trim(str)//' '//isoname(is)//' WATER BUDGET (kg/m2s*1e6): period = ', & - trim(budget_diags%periods(ip)%name),': date = ',date,tod - write(diagunit,FA0) & - budget_diags%comps(ica)%name,& - budget_diags%comps(icl)%name,& - budget_diags%comps(icn)%name,& - budget_diags%comps(ics)%name,& - budget_diags%comps(ico)%name,' *SUM* ' - do nf = iso0(is), isof(is) - write(diagunit,FA1) budget_diags%fields(nf)%name,& - data(nf,ica,ip), & - data(nf,icl,ip), & - data(nf,icn,ip), & - data(nf,ics,ip), & - data(nf,ico,ip), & - data(nf,ica,ip) + data(nf,icl,ip) + data(nf,icn,ip) + data(nf,ics,ip) + data(nf,ico,ip) - enddo - write(diagunit,FA1) ' *SUM*', & - sum(data(iso0(is):isof(is),ica,ip)), & - sum(data(iso0(is):isof(is),icl,ip)), & - sum(data(iso0(is):isof(is),icn,ip)), & - sum(data(iso0(is):isof(is),ics,ip)), & - sum(data(iso0(is):isof(is),ico,ip)), & - sum(data(iso0(is):isof(is),ica,ip)) + sum(data(iso0(is):isof(is),icl,ip)) + & - sum(data(iso0(is):isof(is),icn,ip)) + sum(data(iso0(is):isof(is),ics,ip)) + & - sum(data(iso0(is):isof(is),ico,ip)) - end do - end if - enddo end subroutine med_diag_print_atm @@ -2450,65 +1939,6 @@ subroutine med_diag_print_lnd_ice_ocn(data, ip, date, tod) -sum(data(f_watr_beg:f_watr_end,icas,ip)), & -sum(data(f_watr_beg:f_watr_end,icar,ip)) + sum(data(f_watr_beg:f_watr_end,icxs,ip)) + & sum(data(f_watr_beg:f_watr_end,icxr,ip)) - sum(data(f_watr_beg:f_watr_end,icas,ip)) - - if ( flds_wiso ) then - do is = 1, nisotopes - - ! heat budgets atm<->lnd, atm<->ocn, atm<->ice_nh, atm<->ice_sh for water isotopes - - write(diagunit,*) ' ' - write(diagunit,FAH) subname,trim(str)//isoname(is)//' WATER BUDGET (kg/m2s*1e6): period = ',& - trim(budget_diags%periods(ip)%name), & - ': date = ',date,tod - write(diagunit,FA0) & - budget_diags%comps(icar)%name,& - budget_diags%comps(icxs)%name,& - budget_diags%comps(icxr)%name,& - budget_diags%comps(icas)%name,' *SUM* ' - do nf = iso0(is), isof(is) - write(diagunit,FA1) budget_diags%fields(nf)%name,& - -data(nf,icar,ip), & - data(nf,icxs,ip), & - data(nf,icxr,ip), & - -data(nf,icas,ip), & - -data(nf,icar,ip) + data(nf,icxs,ip) + data(nf,icxr,ip) - data(nf,icas,ip) - enddo - write(diagunit,FA1) ' *SUM*',& - -sum(data(iso0(is):isof(is),icar,ip)),& - sum(data(iso0(is):isof(is),icxs,ip)), & - sum(data(iso0(is):isof(is),icxr,ip)), & - -sum(data(iso0(is):isof(is),icas,ip)), & - -sum(data(iso0(is):isof(is),icar,ip)) + sum(data(iso0(is):isof(is),icxs,ip)) + & - sum(data(iso0(is):isof(is),icxr,ip)) - sum(data(iso0(is):isof(is),icas,ip)) - - ! water budgets atm<->lnd, atm<->ocn, atm<->ice_nh, atm<->ice_sh for water isotopes - - write(diagunit,*) ' ' - write(diagunit,FAH) subname,trim(str)//isoname(is)//' WATER BUDGET (kg/m2s*1e6): period = ',& - trim(budget_diags%periods(ip)%name),& - ': date = ',date,tod - write(diagunit,FA0) & - budget_diags%comps(icar)%name,& - budget_diags%comps(icxs)%name,& - budget_diags%comps(icxr)%name,& - budget_diags%comps(icas)%name,' *SUM* ' - do nf = iso0(is), isof(is) - write(diagunit,FA1) budget_diags%fields(nf)%name,& - -data(nf,icar,ip), & - data(nf,icxs,ip), & - data(nf,icxr,ip), & - -data(nf,icas,ip), & - -data(nf,icar,ip) + data(nf,icxs,ip) + data(nf,icxr,ip) - data(nf,icas,ip) - enddo - write(diagunit,FA1) ' *SUM*', & - -sum(data(iso0(is):isof(is), icar, ip)), & - sum(data(iso0(is):isof(is), icxs, ip)), & - sum(data(iso0(is):isof(is), icxr, ip)), & - -sum(data(iso0(is):isof(is), icas, ip)), & - -sum(data(iso0(is):isof(is), icar, ip)) + sum(data(iso0(is):isof(is), icxs, ip)) + & - sum(data(iso0(is):isof(is), icxr, ip)) - sum(data(iso0(is):isof(is), icas, ip)) - end do - end if enddo end subroutine med_diag_print_lnd_ice_ocn @@ -2666,55 +2096,6 @@ subroutine med_diag_print_summary(data, ip, date, tod) sum_net_water_atm, sum_net_water_lnd, sum_net_water_rof, sum_net_water_ocn, & sum_net_water_ice_nh, sum_net_water_ice_sh, sum_net_water_glc, sum_net_water_tot - ! write out net water water-isoptope budgets - - if ( flds_wiso ) then - - do is = 1, nisotopes - write(diagunit,*) ' ' - write(diagunit,FAH) subname,'NET '//isoname(is)//' WATER BUDGET (kg/m2s*1e6): period = ', & - trim(budget_diags%periods(ip)%name),': date = ',date,tod - write(diagunit,FA0r) ' atm',' lnd',' rof',' ocn',' ice nh',' ice sh',' glc',' *SUM* ' - do nf = iso0(is), isof(is) - net_water_atm = data(nf, c_atm_recv, ip) + data(nf, c_atm_send, ip) - net_water_lnd = data(nf, c_lnd_recv, ip) + data(nf, c_lnd_send, ip) - net_water_rof = data(nf, c_rof_recv, ip) + data(nf, c_rof_send, ip) - net_water_ocn = data(nf, c_ocn_recv, ip) + data(nf, c_ocn_send, ip) - net_water_ice_nh = data(nf, c_inh_recv, ip) + data(nf, c_inh_send, ip) - net_water_ice_sh = data(nf, c_ish_recv, ip) + data(nf, c_ish_send, ip) - net_water_glc = data(nf, c_glc_recv, ip) + data(nf, c_glc_send, ip) - net_water_tot = net_water_atm + net_water_lnd + net_water_rof + net_water_ocn + & - net_water_ice_nh + net_water_ice_sh + net_water_glc - - write(diagunit,FA1r) budget_diags%fields(nf)%name,& - net_water_atm, net_water_lnd, net_water_rof, net_water_ocn, & - net_water_ice_nh, net_water_ice_sh, net_water_glc, net_water_tot - enddo - - sum_net_water_atm = sum(data(iso0(is):isof(is), c_atm_recv, ip)) + & - sum(data(iso0(is):isof(is), c_atm_send, ip)) - sum_net_water_lnd = sum(data(iso0(is):isof(is), c_lnd_recv, ip)) + & - sum(data(iso0(is):isof(is), c_lnd_send, ip)) - sum_net_water_rof = sum(data(iso0(is):isof(is), c_rof_recv, ip)) + & - sum(data(iso0(is):isof(is), c_rof_send, ip)) - sum_net_water_ocn = sum(data(iso0(is):isof(is), c_ocn_recv, ip)) + & - sum(data(iso0(is):isof(is), c_ocn_send, ip)) - sum_net_water_ice_nh = sum(data(iso0(is):isof(is), c_inh_recv, ip)) + & - sum(data(iso0(is):isof(is), c_inh_send, ip)) - sum_net_water_ice_sh = sum(data(iso0(is):isof(is), c_ish_recv, ip)) + & - sum(data(iso0(is):isof(is), c_ish_send, ip)) - sum_net_water_glc = sum(data(iso0(is):isof(is), c_glc_recv, ip)) + & - sum(data(iso0(is):isof(is), c_glc_send, ip)) - sum_net_water_tot = sum_net_water_atm + sum_net_water_lnd + sum_net_water_rof + & - sum_net_water_ocn + sum_net_water_ice_nh + sum_net_water_ice_sh + & - sum_net_water_glc - - write(diagunit,FA1r)' *SUM*',& - sum_net_water_atm, sum_net_water_lnd, sum_net_water_rof, sum_net_water_ocn, & - sum_net_water_ice_nh, sum_net_water_ice_sh, sum_net_water_glc, sum_net_water_tot - end do - end if - ! ----------------------------- ! write out net salt budgets ! ----------------------------- diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index 7e246b610..02b7de063 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -74,7 +74,6 @@ module med_phases_aofluxes_mod ! Private data !-------------------------------------------------------------------------- - logical :: flds_wiso ! use case logical :: compute_atm_dens logical :: compute_atm_thbot integer :: ocn_surface_flux_scheme ! use case @@ -107,9 +106,7 @@ module med_phases_aofluxes_mod real(R8) , pointer :: uocn (:) => null() ! ocn velocity, zonal real(R8) , pointer :: vocn (:) => null() ! ocn velocity, meridional real(R8) , pointer :: tocn (:) => null() ! ocean temperature - real(R8) , pointer :: roce_16O (:) => null() ! ocn H2O ratio - real(R8) , pointer :: roce_HDO (:) => null() ! ocn HDO ratio - real(R8) , pointer :: roce_18O (:) => null() ! ocn H218O ratio + ! input: atm real(R8) , pointer :: zbot (:) => null() ! atm level height real(R8) , pointer :: ubot (:) => null() ! atm velocity, zonal @@ -122,9 +119,6 @@ module med_phases_aofluxes_mod real(R8) , pointer :: psfc (:) => null() ! atm surface pressure real(R8) , pointer :: dens (:) => null() ! atm bottom density real(R8) , pointer :: tbot (:) => null() ! atm bottom surface T - real(R8) , pointer :: shum_16O (:) => null() ! atm H2O tracer - real(R8) , pointer :: shum_HDO (:) => null() ! atm HDO tracer - real(R8) , pointer :: shum_18O (:) => null() ! atm H218O tracer real(R8) , pointer :: lwdn (:) => null() ! atm downward longwave heat flux real(R8) , pointer :: rainc (:) => null() ! convective rain flux ! local size and computational mask and area: on aoflux grid @@ -139,9 +133,6 @@ module med_phases_aofluxes_mod real(R8) , pointer :: lat (:) => null() ! heat flux: latent real(R8) , pointer :: lwup (:) => null() ! lwup over ocean real(R8) , pointer :: evap (:) => null() ! water flux: evaporation - real(R8) , pointer :: evap_16O (:) => null() ! H2O flux: evaporation - real(R8) , pointer :: evap_HDO (:) => null() ! HDO flux: evaporation - real(R8) , pointer :: evap_18O (:) => null() ! H218O flux: evaporation real(R8) , pointer :: taux (:) => null() ! wind stress, zonal real(R8) , pointer :: tauy (:) => null() ! wind stress, meridional real(R8) , pointer :: tref (:) => null() ! diagnostic: 2m ref T @@ -386,13 +377,6 @@ subroutine med_aofluxes_init(gcomp, aoflux_in, aoflux_out, rc) ! Initialize module variables !---------------------------------- - 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 call NUOPC_CompAttributeGet(gcomp, name='ocn_surface_flux_scheme', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (isPresent .and. isSet) then @@ -637,13 +621,8 @@ subroutine med_aofluxes_init_agrid(gcomp, aoflux_in, aoflux_out, rc) ! input fields from atm and ocn on atm grid ! ------------------------ - if (flds_wiso) then - allocate(fldnames_ocn_in(5)) - fldnames_ocn_in = (/'So_omask ','So_t ','So_u ','So_v ','So_roce_wiso' /) - else - allocate(fldnames_ocn_in(4)) - fldnames_ocn_in = (/'So_omask','So_t ','So_u ','So_v '/) - end if + allocate(fldnames_ocn_in(4)) + fldnames_ocn_in = (/'So_omask','So_t ','So_u ','So_v '/) call FB_init(FBocn_a, is_local%wrap%flds_scalar_name, & FBgeom=is_local%wrap%FBImp(compatm,compatm), fieldnamelist=fldnames_ocn_in, name='FBocn_a', rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -1070,22 +1049,15 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) #ifdef CESMCOUPLED call flux_atmocn (logunit=logunit, & nMax=aoflux_in%lsize, & - zbot=aoflux_in%zbot, ubot=aoflux_in%ubot, vbot=aoflux_in%vbot, thbot=aoflux_in%thbot, qbot=aoflux_in%shum, & - rainc=aoflux_in%rainc, & - s16O=aoflux_in%shum_16O, sHDO=aoflux_in%shum_HDO, s18O=aoflux_in%shum_18O, rbot=aoflux_in%dens, & - tbot=aoflux_in%tbot, us=aoflux_in%uocn, vs=aoflux_in%vocn, pslv=aoflux_in%psfc, ts=aoflux_in%tocn, & - mask=aoflux_in%mask, seq_flux_atmocn_minwind=0.5_r8, & - sen=aoflux_out%sen, lat=aoflux_out%lat, lwup=aoflux_out%lwup, & - r16O=aoflux_in%roce_16O, rhdo=aoflux_in%roce_HDO, r18O=aoflux_in%roce_18O, & - evap=aoflux_out%evap, evap_16O=aoflux_out%evap_16O, evap_HDO=aoflux_out%evap_HDO, evap_18O=aoflux_out%evap_18O, & + zbot=aoflux_in%zbot, ubot=aoflux_in%ubot, vbot=aoflux_in%vbot, thbot=aoflux_in%thbot, & + qbot=aoflux_in%shum, rainc=aoflux_in%rainc, rbot=aoflux_in%dens, & + tbot=aoflux_in%tbot, us=aoflux_in%uocn, vs=aoflux_in%vocn, pslv=aoflux_in%psfc, & + ts=aoflux_in%tocn, mask=aoflux_in%mask, seq_flux_atmocn_minwind=0.5_r8, & + sen=aoflux_out%sen, lat=aoflux_out%lat, lwup=aoflux_out%lwup, evap=aoflux_out%evap, & 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, & - ugust_out = aoflux_out%ugust_out, & - u10res = aoflux_out%u10res, & - ustar_sv=aoflux_out%ustar, re_sv=aoflux_out%re, ssq_sv=aoflux_out%ssq, & - missval=0.0_r8) + add_gusts=add_gusts, duu10n=aoflux_out%duu10n, ugust_out = aoflux_out%ugust_out, u10res = aoflux_out%u10res, & + ustar_sv=aoflux_out%ustar, re_sv=aoflux_out%re, ssq_sv=aoflux_out%ssq, missval=0.0_r8) #else #ifdef UFS_AOFLUX @@ -1658,19 +1630,6 @@ subroutine set_aoflux_in_pointers(fldbun_a, fldbun_o, aoflux_in, lsize, xgrid, r if (chkerr(rc,__LINE__,u_FILE_u)) return end if - if (flds_wiso) then - call fldbun_getfldptr(fldbun_a, 'Sa_shum_16O', aoflux_in%shum_16O, xgrid=xgrid, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call fldbun_getfldptr(fldbun_a, 'Sa_shum_18O', aoflux_in%shum_18O, xgrid=xgrid, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call fldbun_getfldptr(fldbun_a, 'Sa_shum_HDO', aoflux_in%shum_HDO, xgrid=xgrid, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - else - allocate(aoflux_in%shum_16O(lsize)); aoflux_in%shum_16O(:) = 0._R8 - allocate(aoflux_in%shum_18O(lsize)); aoflux_in%shum_18O(:) = 0._R8 - allocate(aoflux_in%shum_HDO(lsize)); aoflux_in%shum_HDO(:) = 0._R8 - end if - ! ------------------------ ! input fields from ocn on aoflux_grid ! ------------------------ @@ -1684,18 +1643,6 @@ 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_o, 'So_v', aoflux_in%vocn, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (flds_wiso) then - call fldbun_getfldptr(fldbun_o, 'So_roce_16O', aoflux_in%roce_16O, xgrid=xgrid, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call fldbun_getfldptr(fldbun_o, 'So_roce_18O', aoflux_in%roce_18O, xgrid=xgrid, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call fldbun_getfldptr(fldbun_o, 'So_roce_HDO', aoflux_in%roce_HDO, xgrid=xgrid, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - else - allocate(aoflux_in%roce_16O(aoflux_in%lsize)); aoflux_in%roce_16O(:) = 0._R8 - allocate(aoflux_in%roce_18O(aoflux_in%lsize)); aoflux_in%roce_18O(:) = 0._R8 - allocate(aoflux_in%roce_HDO(aoflux_in%lsize)); aoflux_in%roce_HDO(:) = 0._R8 - end if end subroutine set_aoflux_in_pointers @@ -1741,18 +1688,6 @@ subroutine set_aoflux_out_pointers(fldbun, lsize, aoflux_out, xgrid, rc) call fldbun_getfldptr(fldbun, 'Faox_lwup', aoflux_out%lwup, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (flds_wiso) then - call fldbun_getfldptr(fldbun, 'Faox_evap_16O', aoflux_out%evap_16O, xgrid=xgrid, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call fldbun_getfldptr(fldbun, 'Faox_evap_18O', aoflux_out%evap_18O, xgrid=xgrid, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call fldbun_getfldptr(fldbun, 'Faox_evap_HDO', aoflux_out%evap_HDO, xgrid=xgrid, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - else - allocate(aoflux_out%evap_16O(lsize)); aoflux_out%evap_16O(:) = 0._R8 - allocate(aoflux_out%evap_18O(lsize)); aoflux_out%evap_18O(:) = 0._R8 - allocate(aoflux_out%evap_HDO(lsize)); aoflux_out%evap_HDO(:) = 0._R8 - end if if (add_gusts) then call fldbun_getfldptr(fldbun, 'So_ugustOut', aoflux_out%ugust_out, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return diff --git a/mediator/med_phases_post_rof_mod.F90 b/mediator/med_phases_post_rof_mod.F90 index f21bf2271..472502f21 100644 --- a/mediator/med_phases_post_rof_mod.F90 +++ b/mediator/med_phases_post_rof_mod.F90 @@ -64,7 +64,6 @@ subroutine med_phases_post_rof_init(gcomp, rc) ! local variables character(CL) :: cvalue logical :: isPresent, isSet - logical :: flds_wiso character(len=*), parameter :: subname='(med_phases_post_rof_init)' !--------------------------------------- @@ -95,20 +94,6 @@ subroutine med_phases_post_rof_init(gcomp, rc) 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_log_error('remove_negative_runoff_lnd and remove_negative_runoff_glc must be set to false when flds_wiso is true', rc=rc) - return - 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 From d9eb391f045243f22c25ac230843ca10ac7365eb Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 16 Oct 2025 22:23:44 +0200 Subject: [PATCH 095/123] compile fixes for removing isotopes --- cesm/flux_atmocn/flux_atmocn_Large.F90 | 6 ++---- cesm/flux_atmocn/flux_atmocn_UA_mod.F90 | 3 --- cesm/flux_atmocn/flux_atmocn_driver_mod.F90 | 9 --------- 3 files changed, 2 insertions(+), 16 deletions(-) diff --git a/cesm/flux_atmocn/flux_atmocn_Large.F90 b/cesm/flux_atmocn/flux_atmocn_Large.F90 index 0c2b092de..8bfedaa9b 100644 --- a/cesm/flux_atmocn/flux_atmocn_Large.F90 +++ b/cesm/flux_atmocn/flux_atmocn_Large.F90 @@ -36,7 +36,8 @@ module flux_atmOcn_large_mod subroutine flux_atmOcn_large( & logunit, spval, nMax, & zbot, ubot, vbot, thbot, & - qbot, rainc, tbot, us, vs, pslv, & + qbot, rainc, rbot, & + tbot, us, vs, pslv, & ts, mask, seq_flux_atmocn_minwind, & sen, lat, lwup, evap, & taux, tauy, tref, qref, & @@ -318,9 +319,6 @@ subroutine flux_atmOcn_large( & lat (n) = spval ! latent heat flux (W/m^2) lwup (n) = spval ! long-wave upward heat flux (W/m^2) evap (n) = spval ! evaporative water flux ((kg/s)/m^2) - evap_16O (n) = spval ! water tracer flux (kg/s)/m^2) - evap_HDO (n) = spval ! HDO tracer flux (kg/s)/m^2) - evap_18O (n) = spval ! H218O tracer flux (kg/s)/m^2) taux (n) = spval ! x surface stress (N) tauy (n) = spval ! y surface stress (N) tref (n) = spval ! 2m reference height temperature (K) diff --git a/cesm/flux_atmocn/flux_atmocn_UA_mod.F90 b/cesm/flux_atmocn/flux_atmocn_UA_mod.F90 index d2f258f3d..269d3ad98 100644 --- a/cesm/flux_atmocn/flux_atmocn_UA_mod.F90 +++ b/cesm/flux_atmocn/flux_atmocn_UA_mod.F90 @@ -419,9 +419,6 @@ subroutine flux_atmOcn_UA( & lat (n) = spval ! latent heat flux (W/m^2) lwup (n) = spval ! long-wave upward heat flux (W/m^2) evap (n) = spval ! evaporative water flux ((kg/s)/m^2) - evap_16O (n) = spval !water tracer flux (kg/s)/m^2) - evap_HDO (n) = spval !HDO tracer flux (kg/s)/m^2) - evap_18O (n) = spval !H218O tracer flux (kg/s)/m^2) taux (n) = spval ! x surface stress (N) tauy (n) = spval ! y surface stress (N) tref (n) = spval ! 2m reference height temperature (K) diff --git a/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 b/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 index c4d52b266..ea9f494d9 100644 --- a/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 +++ b/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 @@ -33,12 +33,6 @@ subroutine flux_atmOcn_driver(logunit, nMax, & real(R8) , intent(in) :: thbot(nMax) ! atm potential T (K) real(R8) , intent(in) :: qbot (nMax) ! atm specific humidity (kg/kg) real(R8) , intent(in) :: rainc(nMax) ! atm precip for convective gustiness (kg/m^3) - RBN 24Nov2008/MDF 31Jan2022 - real(R8) , intent(in) :: s16O (nMax) ! atm H216O tracer conc. (kg/kg) - real(R8) , intent(in) :: sHDO (nMax) ! atm HDO tracer conc. (kg/kg) - real(R8) , intent(in) :: s18O (nMax) ! atm H218O tracer conc. (kg/kg) - real(R8) , intent(in) :: r16O (nMax) ! ocn H216O tracer ratio/Rstd - real(R8) , intent(in) :: rHDO (nMax) ! ocn HDO tracer ratio/Rstd - real(R8) , intent(in) :: r18O (nMax) ! ocn H218O tracer ratio/Rstd real(R8) , intent(in) :: rbot (nMax) ! atm air density (kg/m^3) real(R8) , intent(in) :: tbot (nMax) ! atm T (K) real(R8) , intent(in) :: pslv (nMax) ! atm sea level pressure(Pa) @@ -53,9 +47,6 @@ subroutine flux_atmOcn_driver(logunit, nMax, & real(R8),intent(out) :: lat (nMax) ! heat flux: latent (W/m^2) real(R8),intent(out) :: lwup (nMax) ! heat flux: lw upward (W/m^2) real(R8),intent(out) :: evap (nMax) ! water flux: evap ((kg/s)/m^2) - real(R8),intent(out) :: evap_16O (nMax) ! water flux: evap ((kg/s/m^2) - real(R8),intent(out) :: evap_HDO (nMax) ! water flux: evap ((kg/s)/m^2) - real(R8),intent(out) :: evap_18O (nMax) ! water flux: evap ((kg/s/m^2) real(R8),intent(out) :: taux (nMax) ! surface stress, zonal (N) real(R8),intent(out) :: tauy (nMax) ! surface stress, maridional (N) real(R8),intent(out) :: tref (nMax) ! diag: 2m ref height T (K) From 5c47bc7be6ee81eac87d7a77b1e5c4d5b2457aee Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 16 Oct 2025 22:53:21 +0200 Subject: [PATCH 096/123] removed CPL_EPBAL --- cime_config/buildnml | 1 - 1 file changed, 1 deletion(-) diff --git a/cime_config/buildnml b/cime_config/buildnml index 3256ff65c..9d729ee8a 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -37,7 +37,6 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): config["CPL_I2O_PER_CAT"] = case.get_value("CPL_I2O_PER_CAT") config["DRV_THREADING"] = case.get_value("DRV_THREADING") config["CPL_ALBAV"] = case.get_value("CPL_ALBAV") - config["CPL_EPBAL"] = case.get_value("CPL_EPBAL") config["BUDGETS"] = case.get_value("BUDGETS") config["MACH"] = case.get_value("MACH") config["MPILIB"] = case.get_value("MPILIB") From 0856db6cf1490280a3a9d4a27e9ce5666fa70f9e Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 16 Oct 2025 23:04:00 +0200 Subject: [PATCH 097/123] reintroduced usage of shr_wv_sat_qsat that was lost in the cherry-pick from NorESMHub --- cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 | 7 +++++-- cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 | 16 +++++++++++++--- cesm/flux_atmocn/flux_atmocn_Large.F90 | 4 +++- 3 files changed, 21 insertions(+), 6 deletions(-) diff --git a/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 b/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 index 4b0efdf2f..d0862bd0a 100644 --- a/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 +++ b/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 @@ -25,6 +25,7 @@ module flux_atmocn_COARE_mod use shr_const_mod, only : shr_const_rgas, shr_const_cpdair use shr_flux_mod, only : td0, maxscl, alpha use shr_flux_mod, only : use_coldair_outbreak_mod + use shr_wv_sat_mod, only : shr_wv_sat_qsat_liquid ! use saturation calculation consistent with CAM implicit none private @@ -43,7 +44,7 @@ subroutine flux_atmOcn_COARE( & logunit, spval, nMax, zbot, ubot, vbot, thbot, & qbot, rainc, rbot, tbot ,us ,vs, pslv, & ts, mask, seq_flux_atmocn_minwind, & - sen, lat, lwup, evap, & + sen, lat, lwup, evap, & taux ,tauy, tref, qref, & duu10n, ugust_out, u10res, & ustar_sv, re_sv, ssq_sv) @@ -147,7 +148,9 @@ subroutine flux_atmOcn_COARE( & vmag=vmag*vscl endif endif - ssq = 0.98_R8 * qsat(ts(n)) / rbot(n) ! sea surf hum (kg/kg) + + call shr_wv_sat_qsat_liquid(ts(n), pslv(n), qsat, ssq) + ssq = 0.98_R8 * ssq ! sea surf hum (kg/kg) call cor30a(ubot(n),vbot(n),tbot(n),qbot(n),rbot(n), & ! in atm params us(n),vs(n),ts(n),ssq, & ! in surf params diff --git a/cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 b/cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 index 9a2beef71..2a76ee091 100644 --- a/cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 +++ b/cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 @@ -26,6 +26,7 @@ module flux_atmocn_diurnal_mod use shr_const_mod, only : shr_const_ocn_ref_sal, shr_const_zsrflyr, shr_const_rgas use shr_sys_mod, only : shr_sys_abort use flux_atmocn_COARE_mod, only : cor30a + use shr_wv_sat_mod, only : shr_wv_sat_qsat_liquid ! use saturation calculation consistent with CAM implicit none private @@ -236,6 +237,7 @@ subroutine flux_atmOcn_diurnal( & real(R8) :: tdiff(nMax) ! tbot - ts real(R8) :: vscl + ! NOTE: this should use the shr_wv_sat_qsat_liquid if this routine is ever used in production qsat(Tk) = 640380.0_R8 / exp(5107.4_R8/Tk) cdn(Umps) = 0.0027_R8 / Umps + 0.000142_R8 + 0.0000764_R8 * Umps psimhu(xd) = log((1.0_R8+xd*(2.0_R8+xd))*(1.0_R8+xd*xd)/8.0_R8) - 2.0_R8*atan(xd) + 1.571_R8 @@ -353,8 +355,12 @@ subroutine flux_atmOcn_diurnal( & speed(n) = 0.0_R8 endif - ssq = 0.98_R8 * qsat(tBulk(n)) / rbot(n) ! sea surf hum (kg/kg) - delt = thbot(n) - tBulk(n) ! pot temp diff (K) + ! This should be changed to use the subroutine below + ssq = 0.98_R8 * qsat(tBulk(n)) / rbot(n) ! sea surf hum (kg/kg) + ! call shr_wv_sat_qsat_liquid(tBulk(n), pslv(n), qsat, ssq) + ! ssq = 0.98_R8 * ssq ! sea surf hum (kg/kg) + + delt = thbot(n) - tBulk(n) ! pot temp diff (K) delq = qbot(n) - ssq ! spec hum dif (kg/kg) cp = shr_const_cpdair*(1.0_R8 + shr_const_cpvir*ssq) @@ -498,7 +504,11 @@ subroutine flux_atmOcn_diurnal( & !--need to update ssq,delt,delq as function of tBulk ---- - ssq = 0.98_R8 * qsat(tBulk(n)) / rbot(n) ! sea surf hum (kg/kg) + ! This should be changed to use the subroutine below + ssq = 0.98_R8 * qsat(tBulk(n)) / rbot(n) ! sea surf hum (kg/kg) + ! call shr_wv_sat_qsat_liquid(tBulk(n), pslv(n), qsat, ssq) + ! ssq = 0.98_R8 * ssq ! sea surf hum (kg/kg) + delt = thbot(n) - tBulk(n) ! pot temp diff (K) delq = qbot(n) - ssq ! spec hum dif (kg/kg) diff --git a/cesm/flux_atmocn/flux_atmocn_Large.F90 b/cesm/flux_atmocn/flux_atmocn_Large.F90 index 8bfedaa9b..85f95f716 100644 --- a/cesm/flux_atmocn/flux_atmocn_Large.F90 +++ b/cesm/flux_atmocn/flux_atmocn_Large.F90 @@ -25,6 +25,7 @@ module flux_atmOcn_large_mod use shr_flux_mod, only: flux_con_tol, flux_con_max_iter use shr_flux_mod, only: alpha, maxscl, td0 use shr_sys_mod, only: shr_sys_abort + use shr_wv_sat_mod, only: shr_wv_sat_qsat_liquid ! use saturation calculation consistent with CAM implicit none public @@ -209,7 +210,8 @@ subroutine flux_atmOcn_large( & endif endif - ssq = 0.98_R8 * qsat(ts(n)) / rbot(n) ! sea surf hum (kg/kg) + call shr_wv_sat_qsat_liquid(ts(n), pslv(n), qsat, ssq) + ssq = 0.98_R8 * ssq ! sea surf hum (kg/kg) delt = thbot(n) - ts(n) ! pot temp diff (K) delq = qbot(n) - ssq ! spec hum dif (kg/kg) alz = log(zbot(n)/zref) From c3e34f4e33aedf41a1ed6cadd11f63c9a8bc9561 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 17 Oct 2025 11:47:52 +0200 Subject: [PATCH 098/123] some cleanup of routine --- cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 | 50 +++++++++----------- cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 | 15 +++--- 2 files changed, 29 insertions(+), 36 deletions(-) diff --git a/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 b/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 index d0862bd0a..46231bdf5 100644 --- a/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 +++ b/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 @@ -20,12 +20,10 @@ module flux_atmocn_COARE_mod ! * added diagnostics, comments and references !------------------------------------------------------------------------------- - use shr_kind_mod, only : R8=>SHR_KIND_R8, IN=>SHR_KIND_IN ! shared kinds - use shr_const_mod, only : shr_const_stebol, shr_const_latvap, shr_const_g - use shr_const_mod, only : shr_const_rgas, shr_const_cpdair - use shr_flux_mod, only : td0, maxscl, alpha - use shr_flux_mod, only : use_coldair_outbreak_mod - use shr_wv_sat_mod, only : shr_wv_sat_qsat_liquid ! use saturation calculation consistent with CAM + use shr_kind_mod, only : R8=>SHR_KIND_R8, IN=>SHR_KIND_IN ! shared kinds + use shr_flux_mod, only : loc_stebol, loc_latvap, loc_g, loc_cpdair + use shr_flux_mod, only : td0, maxscl, alpha, use_coldair_outbreak_mod + use shr_const_mod, only : shr_const_rgas implicit none private @@ -91,7 +89,7 @@ subroutine flux_atmOcn_COARE( & real(R8),parameter :: zpbl =700.0_R8 ! PBL depth [m] for gustiness parametriz. !--- local variables -------------------------------- - integer(IN) :: n ! vector loop index + integer :: n ! vector loop index real(R8) :: vmag ! surface wind magnitude (m/s) real(R8) :: ssq ! sea surface humidity (kg/kg) real(R8) :: delt ! potential T difference (K) @@ -173,10 +171,10 @@ subroutine flux_atmOcn_COARE( & !--- heat flux --- sen (n) = hsb lat (n) = hlb - lwup(n) = -shr_const_stebol * ts(n)**4 + lwup(n) = -loc_stebol * ts(n)**4 !--- water flux --- - evap(n) = lat(n)/shr_const_latvap + evap(n) = lat(n)/loc_latvap !------------------------------------------------------------ ! compute diagnositcs: 2m ref T & Q, 10m wind speed squared @@ -241,20 +239,16 @@ subroutine cor30a(ubt,vbt,tbt,qbt,rbt, & ! in atm params real(R8), intent(out) :: trf,qrf,urf,vrf ! Local variables - real(R8):: ua,va,ta,q,rb,us,vs,ts,qs,zi,zu,zt,zq,zru,zrq,zrt ! internal vars - - real(R8):: cpa,rgas,grav,pi,von,beta ! phys. params - real(R8):: le,rhoa,cpv ! derived phys. params - real(R8):: t,visa,du,dq,dt ! params of problem - - real(R8):: u10,zo10,zot10,cd10,ch10,ct10,ct,cc,ribu,zetu,l10,charn ! init vars - real(R8):: zet,rr,bf,ug,ut ! loop iter vars - real(R8):: cdn_10,chn_10,cen_10 ! aux. output vars - - integer(IN):: i,nits ! iter loop counters - - integer(IN):: jcool ! aux. cool-skin vars - real(R8) :: dter,wetc,dqer + real(R8) :: ua,va,ta,q,rb,us,vs,ts,qs,zi,zu,zt,zq,zru,zrq,zrt ! internal vars + real(R8) :: cpa,rgas,grav,pi,von,beta ! phys. params + real(R8) :: le,rhoa,cpv ! derived phys. params + real(R8) :: t,visa,du,dq,dt ! params of problem + real(R8) :: u10,zo10,zot10,cd10,ch10,ct10,ct,cc,ribu,zetu,l10,charn ! init vars + real(R8) :: zet,rr,bf,ug,ut ! loop iter vars + real(R8) :: cdn_10,chn_10,cen_10 ! aux. output vars + integer :: i,nits ! iter loop counters + integer :: jcool ! aux. cool-skin vars + real(R8) :: dter,wetc,dqer !---------------------------------------------------------------- ua = ubt !wind components (m/s) at height zu (m) @@ -278,14 +272,14 @@ subroutine cor30a(ubt,vbt,tbt,qbt,rbt, & ! in atm params Beta= 1.2_R8 von = 0.4_R8 pi = 3.141593_R8 - grav= SHR_CONST_G - Rgas= SHR_CONST_RGAS - cpa = SHR_CONST_CPDAIR + grav= loc_g + Rgas= shr_const_rgas + cpa = loc_cpdair !*** physical parameters - Le = SHR_CONST_LATVAP -.00237e6_R8*(ts-273.16_R8) + Le = loc_latvap -.00237e6_R8*(ts-273.16_R8) - ! cpv = shr_const_cpdair*(1.0_R8 + shr_const_cpvir*Qs) ! form in NCAR code + ! cpv = loc_cpdair*(1.0_R8 + loc_cpvir*Qs) ! form in NCAR code cpv = cpa*(1.0_R8+0.84_R8*Q) ! rhoa= P/(Rgas*ta*(1+0.61*Q)) ! if input were pressure diff --git a/cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 b/cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 index 2a76ee091..ed0dd9a4a 100644 --- a/cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 +++ b/cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 @@ -48,7 +48,7 @@ subroutine flux_atmOcn_diurnal( & ts, mask, seq_flux_atmocn_minwind, & sen, lat, lwup, & evap, taux, tauy, tref, qref, & - uGust, lwdn, swdn, swup, prec, & + lwdn, swdn, swup, prec, & swpen, ocnsal, ocn_prognostic, & latt, long, warm, salt, speed, regime, & warmMax, windMax, qSolAvg, windAvg, & @@ -63,6 +63,9 @@ subroutine flux_atmOcn_diurnal( & real(r8) ,intent(in) :: spval integer ,intent(in) :: ocn_surface_flux_scheme integer ,intent(in) :: nMax ! data vector length + integer ,intent(in) :: secs ! NEW elsapsed seconds in day (GMT) + integer ,intent(in) :: dt ! NEW + logical ,intent(in) :: cold_start ! NEW cold start flag integer ,intent(in) :: mask (nMax) ! ocn domain mask 0 <=> out of domain real(R8) ,intent(in) :: zbot (nMax) ! atm level height(m) real(R8) ,intent(in) :: ubot (nMax) ! atm u wind(m/s) @@ -74,7 +77,7 @@ subroutine flux_atmOcn_diurnal( & real(R8) ,intent(in) :: us (nMax) ! ocn u-velocity (m/s) real(R8) ,intent(in) :: vs (nMax) ! ocn v-velocity (m/s) real(R8) ,intent(in) :: ts (nMax) ! ocn temperature(K) - real(R8) ,intent(in) :: uGust (nMax) ! NEW not used + real(R8) ,intent(in) :: seq_flux_atmocn_minwind ! minimum wind speed for atmocn (m/s) real(R8) ,intent(in) :: lwdn (nMax) ! NEW real(R8) ,intent(in) :: swdn (nMax) ! NEW real(R8) ,intent(in) :: swup (nMax) ! NEW @@ -82,16 +85,12 @@ subroutine flux_atmOcn_diurnal( & real(R8) ,intent(in) :: latt (nMax) ! NEW real(R8) ,intent(in) :: long (nMax) ! NEW logical ,intent(in) :: ocn_prognostic ! NEW - integer ,intent(in) :: secs ! NEW elsapsed seconds in day (GMT) - integer ,intent(in) :: dt ! NEW real(R8) ,intent(inout) :: swpen (nMax) ! NEW real(R8) ,intent(inout) :: ocnsal(nMax) ! NEW (kg/kg) real(R8) ,intent(inout) :: warm (nMax) ! NEW real(R8) ,intent(inout) :: salt (nMax) ! NEW real(R8) ,intent(inout) :: speed (nMax) ! NEW real(R8) ,intent(inout) :: regime(nMax) ! NEW - real(R8) ,intent(out) :: warmMax(nMax) ! NEW - real(R8) ,intent(out) :: windMax(nMax) ! NEW real(R8) ,intent(inout) :: qSolAvg(nMax) ! NEW real(R8) ,intent(inout) :: windAvg(nMax) ! NEW real(R8) ,intent(inout) :: warmMaxInc(nMax) ! NEW @@ -99,14 +98,14 @@ subroutine flux_atmOcn_diurnal( & real(R8) ,intent(inout) :: qSolInc(nMax) ! NEW real(R8) ,intent(inout) :: windInc(nMax) ! NEW real(R8) ,intent(inout) :: nInc(nMax) ! NEW + real(R8) ,intent(out) :: warmMax(nMax) ! NEW + real(R8) ,intent(out) :: windMax(nMax) ! NEW real(R8) ,intent(out) :: tBulk (nMax) ! NEW real(R8) ,intent(out) :: tSkin (nMax) ! NEW real(R8) ,intent(out) :: tSkin_day (nMax) ! NEW real(R8) ,intent(out) :: tSkin_night (nMax) ! NEW real(R8) ,intent(out) :: cSkin (nMax) ! NEW real(R8) ,intent(out) :: cSkin_night (nMax) ! NEW - logical ,intent(in) :: cold_start ! cold start flag - real(R8) ,intent(in) :: seq_flux_atmocn_minwind ! minimum wind speed for atmocn (m/s) real(R8) ,intent(out) :: sen (nMax) ! heat flux: sensible (W/m^2) real(R8) ,intent(out) :: lat (nMax) ! heat flux: latent (W/m^2) real(R8) ,intent(out) :: lwup (nMax) ! heat flux: lw upward (W/m^2) From 9f548a4ad8321495b07b0bb5fbe0fb5b7f8a62f5 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 17 Oct 2025 16:27:42 +0200 Subject: [PATCH 099/123] fixed compiler issue --- mediator/med_diag_mod.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index 35fed0dce..8ced33fc4 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -162,6 +162,7 @@ module med_diag_mod integer :: f_watr_roff = unset_index ! water: runoff/flood integer :: f_watr_roff_glc = unset_index ! water: runoff/flood from glc integer :: f_watr_ioff = unset_index ! water: frozen runoff + integer :: f_watr_ioff_glc = unset_index ! water: frozen runoff from glc integer :: f_heat_beg = unset_index ! 1st index for heat integer :: f_heat_end = unset_index ! Last index for heat From a570a159d558127fe2b7362479379dc0691f1de2 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 17 Oct 2025 16:49:35 +0200 Subject: [PATCH 100/123] more compile problem fixes in git workflow --- mediator/med_diag_mod.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index 8ced33fc4..787202db6 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -1729,7 +1729,7 @@ subroutine med_diag_print_atm(data, ip, date, tod) integer , intent(in) :: tod ! local variables - integer :: ic,nf,is ! data array indicies + integer :: ic,nf ! data array indicies integer :: ica,icl integer :: icn,ics,ico character(len=40) :: str ! string @@ -1851,7 +1851,7 @@ subroutine med_diag_print_lnd_ice_ocn(data, ip, date, tod) integer , intent(in) :: tod ! local variables - integer :: ic,nf,is ! data array indicies + integer :: ic,nf ! data array indicies integer :: icar,icas integer :: icxs,icxr character(len=40) :: str ! string @@ -1958,7 +1958,7 @@ subroutine med_diag_print_summary(data, ip, date, tod) integer , intent(in) :: tod ! local variables - integer :: nf,is ! data array indicies + integer :: nf ! data array indicies real(r8) :: atm_area, lnd_area, ocn_area real(r8) :: ice_area_nh, ice_area_sh real(r8) :: sum_area From 175641390d170dc2d7795baee115b86f4ad2f6ed Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 17 Oct 2025 20:08:38 +0200 Subject: [PATCH 101/123] updates to get compilation working --- cesm/flux_atmocn/shr_flux_mod.F90 | 2343 +---------------------------- 1 file changed, 24 insertions(+), 2319 deletions(-) diff --git a/cesm/flux_atmocn/shr_flux_mod.F90 b/cesm/flux_atmocn/shr_flux_mod.F90 index 537beaf4c..27e905e9e 100644 --- a/cesm/flux_atmocn/shr_flux_mod.F90 +++ b/cesm/flux_atmocn/shr_flux_mod.F90 @@ -1,56 +1,26 @@ module shr_flux_mod - ! atm/ocn/flux calculations + ! constants for atm/ocn/flux calculations - ! !USES: - - use shr_kind_mod, only : R8=>SHR_KIND_R8, IN=>SHR_KIND_IN ! shared kinds + use shr_kind_mod, only : R8=>SHR_KIND_R8, IN=>SHR_KIND_IN ! shared kinds use shr_const_mod, only : shr_const_zvir, shr_const_cpdair, shr_const_cpvir, shr_const_karman, shr_const_g ! shared constants - use shr_const_mod, only : shr_const_latvap, shr_const_latice, shr_const_stebol, shr_const_tkfrz, shr_const_pi, shr_const_spval + use shr_const_mod, only : shr_const_latvap, shr_const_latice, shr_const_stebol, shr_const_tkfrz use shr_const_mod, only : shr_const_ocn_ref_sal, shr_const_zsrflyr, shr_const_rgas - use shr_sys_mod, only : shr_sys_abort ! shared system routines - use shr_wv_sat_mod, only: shr_wv_sat_qsat_liquid ! use saturation calculation consistent with CAM - implicit none - - private ! default private + use shr_sys_mod, only : shr_sys_abort ! shared system routines - ! !PUBLIC TYPES: - - ! none - - ! !PUBLIC MEMBER FUNCTIONS: + implicit none + public - public :: flux_atmOcn ! computes atm/ocn fluxes - public :: flux_atmOcn_diurnal ! computes atm/ocn fluxes with diurnal cycle - public :: flux_atmOcn_UA ! computes atm/ocn fluxes using University of Ariz algorithm (Zeng et al., 1998) - public :: flux_MOstability ! boundary layer stability scales/functions public :: shr_flux_adjust_constants ! adjust constant values used in flux calculations. (used by CAM as well) - ! !PRIVATE MEMBER FUNCTIONS: - private :: psi_ua - private :: qsat_ua - private :: rough_ua - private :: cuberoot - private :: cor30a - private :: psiuo - private :: psit_30 - - ! !PUBLIC DATA MEMBERS: - - integer(IN),parameter,public :: shr_flux_MOwScales = 1 ! w scales option - integer(IN),parameter,public :: shr_flux_MOfunctions = 2 ! functions option - real (R8),parameter,public :: shr_flux_MOgammaM = 3.59_R8 - real (R8),parameter,public :: shr_flux_MOgammaS = 7.86_R8 - - !--- rename kinds for local readability only --- - - integer,parameter :: debug = 0 ! internal debug level + integer, parameter :: debug = 0 ! internal debug level ! The follow variables are not declared as parameters so that they can be ! adjusted to support aquaplanet and potentially other simple model modes. ! The flux_adjust_constants subroutine is called to set the desired ! values. The default values are from shr_const_mod. Currently they are ! only used by the flux_atmocn routine. + real(R8) :: loc_zvir = shr_const_zvir real(R8) :: loc_cpdair = shr_const_cpdair real(R8) :: loc_cpvir = shr_const_cpvir @@ -64,16 +34,14 @@ module shr_flux_mod ! These control convergence of the iterative flux calculation ! (For Large and Pond scheme only; not UA or COARE). real(r8) :: flux_con_tol = 0.0_R8 - integer(IN) :: flux_con_max_iter = 2 + integer :: flux_con_max_iter = 2 !--- cold air outbreak parameters (Mahrt & Sun 1995,MWR) ------------- logical :: use_coldair_outbreak_mod = .false. + real(R8),parameter :: alpha = 1.4_R8 real(R8),parameter :: maxscl =2._R8 ! maximum wind scaling for flux - real(R8),parameter :: td0 = -10._R8 ! start t-ts for scaling - - character(len=*), parameter :: sourcefile = & - __FILE__ + real(R8),parameter :: td0 = -10._R8 ! start t-ts for scaling !=============================================================================== contains @@ -81,23 +49,24 @@ module shr_flux_mod subroutine shr_flux_adjust_constants( & zvir, cpair, cpvir, karman, gravit, & - latvap, latice, stebol, flux_convergence_tolerance, & + latvap, latice, stebol, & + flux_convergence_tolerance, & flux_convergence_max_iteration, & coldair_outbreak_mod) ! Adjust local constants. Used to support simple models. - real(R8), optional, intent(in) :: zvir - real(R8), optional, intent(in) :: cpair - real(R8), optional, intent(in) :: cpvir - real(R8), optional, intent(in) :: karman - real(R8), optional, intent(in) :: gravit - real(R8), optional, intent(in) :: latvap - real(R8), optional, intent(in) :: latice - real(R8), optional, intent(in) :: stebol - real(r8), optional, intent(in) :: flux_convergence_tolerance - integer(in), optional, intent(in) :: flux_convergence_max_iteration - logical, optional, intent(in) :: coldair_outbreak_mod + real(R8) , optional, intent(in) :: zvir + real(R8) , optional, intent(in) :: cpair + real(R8) , optional, intent(in) :: cpvir + real(R8) , optional, intent(in) :: karman + real(R8) , optional, intent(in) :: gravit + real(R8) , optional, intent(in) :: latvap + real(R8) , optional, intent(in) :: latice + real(R8) , optional, intent(in) :: stebol + real(r8) , optional, intent(in) :: flux_convergence_tolerance + integer(in) , optional, intent(in) :: flux_convergence_max_iteration + logical , optional, intent(in) :: coldair_outbreak_mod !---------------------------------------------------------------------------- if (present(zvir)) loc_zvir = zvir @@ -114,2268 +83,4 @@ subroutine shr_flux_adjust_constants( & end subroutine shr_flux_adjust_constants - !=============================================================================== - ! !IROUTINE: flux_atmOcn -- internal atm/ocn flux calculation - ! - ! !DESCRIPTION: - ! - ! Internal atm/ocn flux calculation - ! - ! !REVISION HISTORY: - ! 2002-Jun-10 - B. Kauffman - code migrated from cpl5 to cpl6 - ! 2003-Apr-02 - B. Kauffman - taux & tauy now utilize ocn velocity - ! 2003-Apr-02 - B. Kauffman - tref,qref,duu10n mods as per Bill Large - ! 2006-Nov-07 - B. Kauffman - code migrated from cpl6 to share - ! - ! 2011-Mar-13 - J. Nusbaumer - Water Isotope ocean flux added. - - ! 2019-May-16 - Jack Reeves Eyre (UA) and Kai Zhang (PNNL) - - ! Added COARE/Fairall surface flux scheme option - ! (ocn_surface_flux_scheme .eq. 1) based on code from - ! Thomas Toniazzo (Bjerknes Centre, Bergen) ” - !=============================================================================== - SUBROUTINE flux_atmOcn(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & - & qbot, rainc ,s16O ,sHDO ,s18O ,rbot, & - & tbot ,us ,vs, pslv, & - & ts ,mask , seq_flux_atmocn_minwind, & - & sen ,lat ,lwup , & - & r16O, rhdo, r18O, & - & evap ,evap_16O, evap_HDO, evap_18O, & - & taux ,tauy ,tref ,qref , & - & ocn_surface_flux_scheme, & - & add_gusts, & - & duu10n, & - & ugust_out, & - & u10res, & - & ustar_sv ,re_sv ,ssq_sv, & - & missval) - - ! !USES: - use water_isotopes, only: wiso_flxoce !subroutine used to calculate water isotope fluxes. - - implicit none - - ! !INPUT/OUTPUT PARAMETERS: - - !--- input arguments -------------------------------- - integer ,intent(in) :: logunit - integer(IN),intent(in) :: nMax ! data vector length - integer(IN),intent(in) :: mask (nMax) ! ocn domain mask 0 <=> out of domain - integer(IN),intent(in) :: ocn_surface_flux_scheme - logical ,intent(in) :: add_gusts - real(R8) ,intent(in) :: zbot (nMax) ! atm level height (m) - real(R8) ,intent(in) :: ubot (nMax) ! atm u wind (m/s) - real(R8) ,intent(in) :: vbot (nMax) ! atm v wind (m/s) - real(R8) ,intent(in) :: thbot(nMax) ! atm potential T (K) - real(R8) ,intent(in) :: qbot (nMax) ! atm specific humidity (kg/kg) - real(R8) ,intent(in) :: rainc(nMax) ! atm precip for convective gustiness (kg/m^3) - RBN 24Nov2008/MDF 31Jan2022 - real(R8) ,intent(in) :: s16O (nMax) ! atm H216O tracer conc. (kg/kg) - real(R8) ,intent(in) :: sHDO (nMax) ! atm HDO tracer conc. (kg/kg) - real(R8) ,intent(in) :: s18O (nMax) ! atm H218O tracer conc. (kg/kg) - real(R8) ,intent(in) :: r16O (nMax) ! ocn H216O tracer ratio/Rstd - real(R8) ,intent(in) :: rHDO (nMax) ! ocn HDO tracer ratio/Rstd - real(R8) ,intent(in) :: r18O (nMax) ! ocn H218O tracer ratio/Rstd - real(R8) ,intent(in) :: rbot (nMax) ! atm air density (kg/m^3) - real(R8) ,intent(in) :: tbot (nMax) ! atm T (K) - real(R8) ,intent(in) :: pslv (nMax) ! atm sea level pressure(Pa) - real(R8) ,intent(in) :: us (nMax) ! ocn u-velocity (m/s) - real(R8) ,intent(in) :: vs (nMax) ! ocn v-velocity (m/s) - real(R8) ,intent(in) :: ts (nMax) ! ocn temperature (K) - real(R8) ,intent(in) :: seq_flux_atmocn_minwind ! minimum wind speed for atmocn (m/s) - - !--- output arguments ------------------------------- - real(R8),intent(out) :: sen (nMax) ! heat flux: sensible (W/m^2) - real(R8),intent(out) :: lat (nMax) ! heat flux: latent (W/m^2) - real(R8),intent(out) :: lwup (nMax) ! heat flux: lw upward (W/m^2) - real(R8),intent(out) :: evap (nMax) ! water flux: evap ((kg/s)/m^2) - real(R8),intent(out) :: evap_16O (nMax) ! water flux: evap ((kg/s/m^2) - real(R8),intent(out) :: evap_HDO (nMax) ! water flux: evap ((kg/s)/m^2) - real(R8),intent(out) :: evap_18O (nMax) ! water flux: evap ((kg/s/m^2) - real(R8),intent(out) :: taux (nMax) ! surface stress, zonal (N) - real(R8),intent(out) :: tauy (nMax) ! surface stress, maridional (N) - real(R8),intent(out) :: tref (nMax) ! diag: 2m ref height T (K) - real(R8),intent(out) :: qref (nMax) ! diag: 2m ref humidity (kg/kg) - real(R8),intent(out) :: duu10n(nMax) ! diag: 10m wind speed squared (m/s)^2 - real(R8),intent(out) :: ugust_out(nMax) ! diag: gustiness addition to U10 (m/s) - real(R8),intent(out) :: u10res(nMax) ! diag: gustiness addition to U10 (m/s) - - real(R8),intent(out),optional :: ustar_sv(nMax) ! diag: ustar - real(R8),intent(out),optional :: re_sv (nMax) ! diag: sqrt of exchange coefficient (water) - real(R8),intent(out),optional :: ssq_sv (nMax) ! diag: sea surface humidity (kg/kg) - - real(R8),intent(in) ,optional :: missval ! masked value - - !--- local constants -------------------------------- - real(R8),parameter :: zref = 10.0_R8 ! reference height (m) - real(R8),parameter :: ztref = 2.0_R8 ! reference height for air T (m) - !!++ Large only - !real(R8),parameter :: cexcd = 0.0346_R8 ! ratio Ch(water)/CD - !real(R8),parameter :: chxcds = 0.018_R8 ! ratio Ch(heat)/CD for stable case - !real(R8),parameter :: chxcdu = 0.0327_R8 ! ratio Ch(heat)/CD for unstable case - !!++ COARE only - real(R8),parameter :: zpbl =700.0_R8 ! PBL depth [m] for gustiness parametriz. - - !--- local variables -------------------------------- - integer(IN) :: n ! vector loop index - integer(IN) :: iter - real(R8) :: vmag ! surface wind magnitude (m/s) - real(R8) :: ssq ! sea surface humidity (kg/kg) - real(R8) :: delt ! potential T difference (K) - real(R8) :: delq ! humidity difference (kg/kg) - real(R8) :: stable ! stability factor - real(R8) :: rdn ! sqrt of neutral exchange coeff (momentum) - real(R8) :: rhn ! sqrt of neutral exchange coeff (heat) - real(R8) :: ren ! sqrt of neutral exchange coeff (water) - real(R8) :: rd ! sqrt of exchange coefficient (momentum) - real(R8) :: rh ! sqrt of exchange coefficient (heat) - real(R8) :: re ! sqrt of exchange coefficient (water) - real(R8) :: ustar ! ustar - real(r8) :: ustar_prev - real(R8) :: qstar ! qstar - real(R8) :: tstar ! tstar - real(R8) :: hol ! H (at zbot) over L - real(R8) :: xsq ! ? - real(R8) :: xqq ! ? - !!++ Large only - real(R8) :: psimh ! stability function at zbot (momentum) - real(R8) :: psixh ! stability function at zbot (heat and water) - real(R8) :: psix2 ! stability function at ztref reference height - real(R8) :: alz ! ln(zbot/zref) - real(R8) :: al2 ! ln(zref/ztref) - real(R8) :: u10n ! 10m neutral wind - real(R8) :: tau ! stress at zbot - real(R8) :: cp ! specific heat of moist air - real(R8) :: fac ! vertical interpolation factor - real(R8) :: spval ! local missing value - real(R8) :: wind0 ! resolved large-scale 10m wind (no gust added) - !!++ COARE only - real(R8) :: zo,zot,zoq ! roughness lengths - real(R8) :: hsb,hlb ! sens & lat heat flxs at zbot - real(R8) :: trf,qrf,urf,vrf ! reference-height quantities - - - !--- local functions -------------------------------- - real(R8) :: qsat ! function: the saturation humididty of air (kg/m^3) - !!++ Large only (formula v*=[c4/U10+c5+c6*U10]*U10 in Large et al. 1994) - real(R8) :: cdn ! function: neutral drag coeff at 10m - !!++ Large only (stability functions) - real(R8) :: psimhu ! function: unstable part of psimh - real(R8) :: psixhu ! function: unstable part of psimx - real(R8) :: Umps ! dummy arg ~ wind velocity (m/s) - real(R8) :: Tk ! dummy arg ~ temperature (K) - real(R8) :: xd ! dummy arg ~ ? - !--- for cold air outbreak calc -------------------------------- - real(R8) :: tdiff(nMax) ! tbot - ts - real(R8) :: vscl - - real(R8) :: ugust ! function: gustiness as a function of convective rainfall. - real(R8) :: gprec ! convective rainfall argument for ugust - - ! Large and Yeager 2009 - cdn(Umps) = 0.0027_R8 / min(33.0000_R8,Umps) + 0.000142_R8 + & - 0.0000764_R8 * min(33.0000_R8,Umps) - 3.14807e-13_r8 * min(33.0000_R8,Umps)**6 - ! Capped Large and Pond by wind - ! cdn(Umps) = 0.0027_R8 / min(30.0_R8,Umps) + 0.000142_R8 + 0.0000764_R8 * min(30.0_R8,Umps) - ! Capped Large and Pond by Cd - ! cdn(Umps) = min(0.0025_R8, (0.0027_R8 / Umps + 0.000142_R8 + 0.0000764_R8 * Umps )) - ! Large and Pond - ! cdn(Umps) = 0.0027_R8 / Umps + 0.000142_R8 + 0.0000764_R8 * Umps - - psimhu(xd) = log((1.0_R8+xd*(2.0_R8+xd))*(1.0_R8+xd*xd)/8.0_R8) - 2.0_R8*atan(xd) + 1.571_R8 - psixhu(xd) = 2.0_R8 * log((1.0_R8 + xd*xd)/2.0_R8) - - ! Convective gustiness appropriate for input precipitation. - ! Following Regelsperger et al. (2000, J. Clim) - ! Ug = log(1.0+6.69R-0.476R^2) - ! Coefficients X by 8640 for mm/s (from cam) -> cm/day (for above forumla) - ugust(gprec) = log(1._R8+57801.6_r8*gprec-3.55332096e7_r8*(gprec**2)) - - - !--- formats ---------------------------------------- - character(*),parameter :: subName = '(flux_atmOcn) ' - character(*),parameter :: F00 = "('(flux_atmOcn) ',4a)" - - !------------------------------------------------------------------------------- - ! PURPOSE: - ! computes atm/ocn surface fluxes - ! - ! NOTES: - ! o all fluxes are positive downward - ! o net heat flux = net sw + lw up + lw down + sen + lat - ! o here, tstar = /U*, and qstar = /U*. - ! o wind speeds should all be above a minimum speed (eg. 1.0 m/s) - ! - ! ASSUMPTIONS: - ! Large: - ! o Neutral 10m drag coeff: cdn = .0027/U10 + .000142 + .0000764 U10 - ! o Neutral 10m stanton number: ctn = .0327 sqrt(cdn), unstable - ! ctn = .0180 sqrt(cdn), stable - ! o Neutral 10m dalton number: cen = .0346 sqrt(cdn) - ! o The saturation humidity of air at T(K): qsat(T) (kg/m^3) - ! COARE: - ! o use COAREv3.0 function (tht 22/11/2013) - !------------------------------------------------------------------------------- - - if (debug > 0) write(logunit,F00) "enter" - - if (present(missval)) then - spval = missval - else - spval = shr_const_spval - endif - u10n = spval - rh = spval - psixh = spval - hol=spval - - !--- for cold air outbreak calc -------------------------------- - tdiff= tbot - ts - - !!................................................................. - !! ocn_surface_flux_scheme = 0 : Default CESM1.2 - !! = 1 : COARE algorithm - !! = 2 : UA algorithm (separate subroutine) - !!................................................................. - - ! Default flux scheme. - if (ocn_surface_flux_scheme .eq. 0) then - - al2 = log(zref/ztref) - DO n=1,nMax - if (mask(n) /= 0) then - - !--- compute some needed quantities --- - if (add_gusts) then - vmag = max(seq_flux_atmocn_minwind, sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2 + (1.0_R8*ugust(min(rainc(n),6.94444e-4_r8))**2)) ) - ugust_out(n) = ugust(min(rainc(n),6.94444e-4_r8)) - else - vmag = max(seq_flux_atmocn_minwind, sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2) ) - ugust_out(n) = 0.0_r8 - end if - wind0 = max(seq_flux_atmocn_minwind, sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2) ) - - if (use_coldair_outbreak_mod) then - ! Cold Air Outbreak Modification: - ! Increase windspeed for negative tbot-ts - ! based on Mahrt & Sun 1995,MWR - - if (tdiff(n).lt.td0) then - ! if add_gusts wind0 and vmag are different, both need this factor. - vscl=min((1._R8+alpha*(abs(tdiff(n)-td0)**0.5_R8/abs(vmag))),maxscl) - vmag=vmag*vscl - vscl=min((1._R8+alpha*(abs(tdiff(n)-td0)**0.5_R8/abs(wind0))),maxscl) - wind0=wind0*vscl - endif - endif - call shr_wv_sat_qsat_liquid(ts(n), pslv(n), qsat, ssq) - ssq = 0.98_R8 * ssq ! sea surf hum (kg/kg) - delt = thbot(n) - ts(n) ! pot temp diff (K) - delq = qbot(n) - ssq ! spec hum dif (kg/kg) - alz = log(zbot(n)/zref) - cp = loc_cpdair*(1.0_R8 + loc_cpvir*ssq) - - !------------------------------------------------------------ - ! first estimate of Z/L and ustar, tstar and qstar - !------------------------------------------------------------ - !--- neutral coefficients, z/L = 0.0 --- - stable = 0.5_R8 + sign(0.5_R8 , delt) - rdn = sqrt(cdn(vmag)) - rhn = (1.0_R8-stable) * 0.0327_R8 + stable * 0.018_R8 - !(1.0_R8-stable) * chxcdu + stable * chxcds - ren = 0.0346_R8 !cexcd - - !--- ustar, tstar, qstar --- - ustar = rdn * vmag - tstar = rhn * delt - qstar = ren * delq - ustar_prev = ustar*2.0_R8 - iter = 0 - do while( abs((ustar - ustar_prev)/ustar) > flux_con_tol .and. iter < flux_con_max_iter) - iter = iter + 1 - ustar_prev = ustar - !--- compute stability & evaluate all stability functions --- - hol = loc_karman*loc_g*zbot(n)* & - (tstar/thbot(n)+qstar/(1.0_R8/loc_zvir+qbot(n)))/ustar**2 - hol = sign( min(abs(hol),10.0_R8), hol ) - stable = 0.5_R8 + sign(0.5_R8 , hol) - xsq = max(sqrt(abs(1.0_R8 - 16.0_R8*hol)) , 1.0_R8) - xqq = sqrt(xsq) - psimh = -5.0_R8*hol*stable + (1.0_R8-stable)*psimhu(xqq) - psixh = -5.0_R8*hol*stable + (1.0_R8-stable)*psixhu(xqq) - - !--- shift wind speed using old coefficient --- - rd = rdn / (1.0_R8 + max(rdn/loc_karman*(alz-psimh), -0.5_r8)) - u10n = vmag * rd / rdn - - !--- update transfer coeffs at 10m and neutral stability --- - rdn = sqrt(cdn(u10n)) - ren = 0.0346_R8 !cexcd - rhn = (1.0_R8-stable)*0.0327_R8 + stable * 0.018_R8 - !(1.0_R8-stable) * chxcdu + stable * chxcds - - !--- shift all coeffs to measurement height and stability --- - rd = rdn / (1.0_R8 + rdn/loc_karman*(alz-psimh)) - rh = rhn / (1.0_R8 + rhn/loc_karman*(alz-psixh)) - re = ren / (1.0_R8 + ren/loc_karman*(alz-psixh)) - - !--- update ustar, tstar, qstar using updated, shifted coeffs -- - ustar = rd * vmag - tstar = rh * delt - qstar = re * delq - enddo - if (iter < 1) then - write(logunit,*) ustar,ustar_prev,flux_con_tol,flux_con_max_iter - call shr_sys_abort('No iterations performed in flux_atmocn_mod') - end if - !------------------------------------------------------------ - ! compute the fluxes - !------------------------------------------------------------ - - tau = rbot(n) * ustar * ustar - - !--- momentum flux --- - taux(n) = tau * (ubot(n)-us(n)) / vmag - tauy(n) = tau * (vbot(n)-vs(n)) / vmag - - !--- heat flux --- - sen (n) = cp * tau * tstar / ustar - lat (n) = loc_latvap * tau * qstar / ustar - lwup(n) = -loc_stebol * ts(n)**4 - - !--- water flux --- - evap(n) = lat(n)/loc_latvap - - !---water isotope flux --- - - call wiso_flxoce(2,rbot(n),zbot(n),s16O(n),ts(n),r16O(n),ustar,re,ssq,evap_16O(n), & - qbot(n),evap(n)) - call wiso_flxoce(3,rbot(n),zbot(n),sHDO(n),ts(n),rHDO(n),ustar,re,ssq, evap_HDO(n),& - qbot(n),evap(n)) - call wiso_flxoce(4,rbot(n),zbot(n),s18O(n),ts(n),r18O(n),ustar,re,ssq, evap_18O(n), & - qbot(n),evap(n)) - - !------------------------------------------------------------ - ! compute diagnositcs: 2m ref T & Q, 10m wind speed squared - !------------------------------------------------------------ - hol = hol*ztref/zbot(n) - xsq = max( 1.0_R8, sqrt(abs(1.0_R8-16.0_R8*hol)) ) - xqq = sqrt(xsq) - psix2 = -5.0_R8*hol*stable + (1.0_R8-stable)*psixhu(xqq) - fac = (rh/loc_karman) * (alz + al2 - psixh + psix2 ) - tref(n) = thbot(n) - delt*fac - tref(n) = tref(n) - 0.01_R8*ztref ! pot temp to temp correction - fac = (re/loc_karman) * (alz + al2 - psixh + psix2 ) - qref(n) = qbot(n) - delq*fac - - duu10n(n) = u10n*u10n ! 10m wind speed squared - u10res(n) = u10n * (wind0/vmag) ! resolved 10m wind - - !------------------------------------------------------------ - ! optional diagnostics, needed for water tracer fluxes (dcn) - !------------------------------------------------------------ - if (present(ustar_sv)) ustar_sv(n) = ustar - if (present(re_sv )) re_sv(n) = re - if (present(ssq_sv )) ssq_sv(n) = ssq - - else - !------------------------------------------------------------ - ! no valid data here -- out of domain - !------------------------------------------------------------ - - sen (n) = spval ! sensible heat flux (W/m^2) - lat (n) = spval ! latent heat flux (W/m^2) - lwup (n) = spval ! long-wave upward heat flux (W/m^2) - evap (n) = spval ! evaporative water flux ((kg/s)/m^2) - evap_16O (n) = spval !water tracer flux (kg/s)/m^2) - evap_HDO (n) = spval !HDO tracer flux (kg/s)/m^2) - evap_18O (n) = spval !H218O tracer flux (kg/s)/m^2) - taux (n) = spval ! x surface stress (N) - tauy (n) = spval ! y surface stress (N) - tref (n) = spval ! 2m reference height temperature (K) - qref (n) = spval ! 2m reference height humidity (kg/kg) - duu10n(n) = spval ! 10m wind speed squared (m/s)^2 - ugust_out(n) = spval ! gustiness addition (m/s) - u10res(n) = spval ! 10m resolved wind (no gusts) (m/s) - - if (present(ustar_sv)) ustar_sv(n) = spval - if (present(re_sv )) re_sv (n) = spval - if (present(ssq_sv )) ssq_sv (n) = spval - endif - ENDDO - - else if (ocn_surface_flux_scheme .eq. 1) then - !!................................. - !! use COARE algorithm - !!................................. - - - DO n=1,nMax - if (mask(n) /= 0) then - - !--- compute some needed quantities --- - vmag = max(seq_flux_atmocn_minwind, sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2) ) - - if (use_coldair_outbreak_mod) then - ! Cold Air Outbreak Modification: - ! Increase windspeed for negative tbot-ts - ! based on Mahrt & Sun 1995,MWR - - if (tdiff(n).lt.td0) then - vscl=min((1._R8+alpha*(abs(tdiff(n)-td0)**0.5_R8/abs(vmag))),maxscl) - vmag=vmag*vscl - endif - endif - call shr_wv_sat_qsat_liquid(ts(n), pslv(n), qsat, ssq) - ssq = 0.98_R8 * ssq ! sea surf hum (kg/kg) - - call cor30a(ubot(n),vbot(n),tbot(n),qbot(n),rbot(n) & ! in atm params - & ,us(n),vs(n),ts(n),ssq & ! in surf params - & ,zpbl,zbot(n),zbot(n),zref,ztref,ztref & ! in heights - & ,tau,hsb,hlb & ! out: fluxes - & ,zo,zot,zoq,hol,ustar,tstar,qstar & ! out: ss scales - & ,rd,rh,re & ! out: exch. coeffs - & ,trf,qrf,urf,vrf) ! out: reference-height params - - ! for the sake of maintaining same defs - hol=zbot(n)/hol - rd=sqrt(rd) - rh=sqrt(rh) - re=sqrt(re) - - !--- momentum flux --- - taux(n) = tau * (ubot(n)-us(n)) / vmag - tauy(n) = tau * (vbot(n)-vs(n)) / vmag - - !--- heat flux --- - sen (n) = hsb - lat (n) = hlb - lwup(n) = -shr_const_stebol * ts(n)**4 - - !--- water flux --- - evap(n) = lat(n)/shr_const_latvap - - !---water isotope flux --- - call wiso_flxoce(2,rbot(n),zbot(n),s16O(n),ts(n),r16O(n),ustar,re,ssq, evap_16O(n), & - qbot(n),evap(n)) - call wiso_flxoce(3,rbot(n),zbot(n),sHDO(n),ts(n),rHDO(n),ustar,re,ssq, evap_HDO(n),& - qbot(n),evap(n)) - call wiso_flxoce(4,rbot(n),zbot(n),s18O(n),ts(n),r18O(n),ustar,re,ssq, evap_18O(n), & - qbot(n),evap(n)) - - !------------------------------------------------------------ - ! compute diagnositcs: 2m ref T & Q, 10m wind speed squared - !------------------------------------------------------------ - tref(n) = trf - qref(n) = qrf - duu10n(n) = urf**2+vrf**2 - - !------------------------------------------------------------ - ! optional diagnostics, needed for water tracer fluxes (dcn) - !------------------------------------------------------------ - if (present(ustar_sv)) ustar_sv(n) = ustar - if (present(re_sv )) re_sv(n) = re - if (present(ssq_sv )) ssq_sv(n) = ssq - - u10res(n) = sqrt(duu10n(n)) - ugust_out(n) = 0._r8 - - else - !------------------------------------------------------------ - ! no valid data here -- out of domain - !------------------------------------------------------------ - sen (n) = spval ! sensible heat flux (W/m^2) - lat (n) = spval ! latent heat flux (W/m^2) - lwup (n) = spval ! long-wave upward heat flux (W/m^2) - evap (n) = spval ! evaporative water flux ((kg/s)/m^2) - evap_16O (n) = spval ! water tracer flux (kg/s)/m^2) - evap_HDO (n) = spval ! HDO tracer flux (kg/s)/m^2) - evap_18O (n) = spval ! H218O tracer flux (kg/s)/m^2) - taux (n) = spval ! x surface stress (N) - tauy (n) = spval ! y surface stress (N) - tref (n) = spval ! 2m reference height temperature (K) - qref (n) = spval ! 2m reference height humidity (kg/kg) - duu10n (n) = spval ! 10m wind speed squared (m/s)^2 - - u10res (n) = spval - ugust_out(n) = spval - - if (present(ustar_sv)) ustar_sv(n) = spval - if (present(re_sv )) re_sv (n) = spval - if (present(ssq_sv )) ssq_sv (n) = spval - endif - ENDDO - - else if (ocn_surface_flux_scheme .eq. 2) then - - call flux_atmOcn_UA(logunit,& - nMax, zbot, ubot, vbot, thbot, & - qbot, s16O, sHDO, s18O, rbot, & - tbot, pslv, us, vs, & - ts, mask, sen, lat, lwup, & - r16O, rhdo, r18O, & - evap, evap_16O, evap_HDO, evap_18O, & - taux, tauy, tref, qref, & - duu10n, ustar_sv, re_sv, ssq_sv, & - missval) - do n=1,nMax - if (mask(n) /= 0) then - u10res(n) = sqrt(duu10n(n)) - ugust_out(n) = 0._r8 - else - u10res (n) = spval - ugust_out(n) = spval - end if - end do - else - - call shr_sys_abort(subName//" subroutine flux_atmOcn requires ocn_surface_flux_scheme = 0, 1 or 2") - - endif !! ocn_surface_flux_scheme - - END subroutine flux_atmOcn - - !=============================================================================== - ! !IROUTINE: flux_atmOcn_UA -- internal atm/ocn flux calculation - ! - ! !DESCRIPTION: - ! - ! Internal atm/ocn flux calculation - ! using University of Arizona method. - ! - ! Reference: - ! Zeng, X., M. Zhao, and R.E. Dickinson, 1998: Intercomparison of Bulk - ! Aerodynamic Algorithms for the Computation of Sea Surface Fluxes - ! Using TOGA COARE and TAO Data. J. Climate, 11, 2628–2644, - ! https://doi.org/10.1175/1520-0442(1998)011<2628%3AIOBAAF>2.0.CO%3B2 - ! - ! Equation numbers are from this paper. - ! - ! !REVISION HISTORY: - ! 2017-Aug-28 - J. Reeves Eyre - code re-written for E3SM - ! 2018-Oct-30 - J. Reeves Eyre - bug fix and add - ! convective gustiness. - ! 2019-May-08 - J. Reeves Eyre - remove convective gustiness - ! and add cold air outbreak modification. - !=============================================================================== - SUBROUTINE flux_atmOcn_UA(logunit, & - & nMax ,zbot ,ubot ,vbot ,thbot , & - & qbot ,s16O ,sHDO ,s18O ,rbot , & - & tbot , pslv ,us , vs , & - & ts ,mask ,sen ,lat ,lwup , & - & r16O, rhdo, r18O, & - & evap ,evap_16O, evap_HDO, evap_18O, & - & taux ,tauy ,tref ,qref , & - & duu10n, ustar_sv ,re_sv ,ssq_sv, & - & missval) - - - ! !USES: - use water_isotopes, only: wiso_flxoce !subroutine used to calculate water isotope fluxes. - - implicit none - - ! !INPUT/OUTPUT PARAMETERS: - - !--- input arguments -------------------------------- - integer ,intent(in) :: logunit - integer ,intent(in) :: nMax ! data vector length - integer ,intent(in) :: mask (nMax) ! ocn domain mask 0 <=> out of domain - real(R8) ,intent(in) :: zbot (nMax) ! atm level height (m) - real(R8) ,intent(in) :: ubot (nMax) ! atm u wind (m/s) - real(R8) ,intent(in) :: vbot (nMax) ! atm v wind (m/s) - real(R8) ,intent(in) :: thbot(nMax) ! atm potential T (K) - real(R8) ,intent(in) :: qbot (nMax) ! atm specific humidity (kg/kg) - real(R8) ,intent(in) :: s16O (nMax) ! atm H216O tracer conc. (kg/kg) - real(R8) ,intent(in) :: sHDO (nMax) ! atm HDO tracer conc. (kg/kg) - real(R8) ,intent(in) :: s18O (nMax) ! atm H218O tracer conc. (kg/kg) - real(R8) ,intent(in) :: r16O (nMax) ! ocn H216O tracer ratio/Rstd - real(R8) ,intent(in) :: rHDO (nMax) ! ocn HDO tracer ratio/Rstd - real(R8) ,intent(in) :: r18O (nMax) ! ocn H218O tracer ratio/Rstd - real(R8) ,intent(in) :: rbot (nMax) ! atm air density (kg/m^3) - real(R8) ,intent(in) :: tbot (nMax) ! atm T (K) - real(R8) ,intent(in) :: pslv (nMax) ! sea level pressure (Pa) - real(R8) ,intent(in) :: us (nMax) ! ocn u-velocity (m/s) - real(R8) ,intent(in) :: vs (nMax) ! ocn v-velocity (m/s) - real(R8) ,intent(in) :: ts (nMax) ! ocn temperature (K) - - !--- output arguments ------------------------------- - real(R8),intent(out) :: sen (nMax) ! heat flux: sensible (W/m^2) - real(R8),intent(out) :: lat (nMax) ! heat flux: latent (W/m^2) - real(R8),intent(out) :: lwup (nMax) ! heat flux: lw upward (W/m^2) - real(R8),intent(out) :: evap (nMax) ! water flux: evap ((kg/s)/m^2) - real(R8),intent(out) :: evap_16O (nMax) ! water flux: evap ((kg/s/m^2) - real(R8),intent(out) :: evap_HDO (nMax) ! water flux: evap ((kg/s)/m^2) - real(R8),intent(out) :: evap_18O (nMax) ! water flux: evap ((kg/s/m^2) - real(R8),intent(out) :: taux (nMax) ! surface stress, zonal (N) - real(R8),intent(out) :: tauy (nMax) ! surface stress, maridional (N) - real(R8),intent(out) :: tref (nMax) ! diag: 2m ref height T (K) - real(R8),intent(out) :: qref (nMax) ! diag: 2m ref humidity (kg/kg) - real(R8),intent(out) :: duu10n(nMax) ! diag: 10m wind speed squared (m/s)^2 - - real(R8),intent(out),optional :: ustar_sv(nMax) ! diag: ustar - real(R8),intent(out),optional :: re_sv (nMax) ! diag: sqrt of exchange coefficient (water) - real(R8),intent(out),optional :: ssq_sv (nMax) ! diag: sea surface humidity (kg/kg) - - real(R8),intent(in) ,optional :: missval ! masked value - - !--- local constants -------------------------------- - real(R8),parameter :: zetam = -1.574_R8 ! Very unstable zeta cutoff for momentum (-) - real(R8),parameter :: zetat = -0.465_R8 ! Very unstable zeta cutoff for T/q (-) - real(R8),parameter :: umin = 0.1_R8 ! minimum wind speed (m/s) - real(R8),parameter :: zref = 10.0_R8 ! reference height (m) - real(R8),parameter :: ztref = 2.0_R8 ! reference height for air T (m) - real(R8),parameter :: beta = 1.0_R8 ! constant used in W* calculation (-) - real(R8),parameter :: zpbl = 1000.0_R8 ! PBL height used in W* calculation (m) - real(R8),parameter :: gamma = 0.0098_R8 ! Dry adiabatic lapse rate (K/m) - real(R8),parameter :: onethird = 1.0_R8/3.0_R8 ! Used repeatedly. - - !--- local variables -------------------------------- - integer(IN) :: n ! vector loop index - integer(IN) :: i ! iteration loop index - real(R8) :: vmag_abs ! surface wind magnitude (m s-1) - real(R8) :: vmag_rel ! surface wind magnitude relative to - ! surface current (m s-1) - real(R8) :: vmag ! surface wind magnitude with large - ! eddy correction and minimum value (m s-1) - ! (This can change on each iteration.) - real(R8) :: thv ! virtual temperature (K) - real(R8) :: ssq ! sea surface humidity (kg/kg) - real(R8) :: delth ! potential T difference (K) - real(R8) :: delthv ! virtual potential T difference (K) - real(R8) :: delq ! humidity difference (kg/kg) - real(R8) :: ustar ! friction velocity (m s-1) - real(R8) :: qstar ! humidity scaling parameter (kg/kg) - real(R8) :: tstar ! temperature scaling parameter (K) - real(R8) :: thvstar ! virtual temperature scaling parameter (K) - real(R8) :: wstar ! convective velocity scale (m s-1) - real(R8) :: zeta ! dimensionless height (z / Obukhov length) - real(R8) :: obu ! Obukhov length (m) - real(R8) :: tau ! magnitude of wind stress (N m-2) - real(R8) :: cp ! specific heat of moist air (J kg-1 K-1) - real(R8) :: xlv ! Latent heat of vaporization (J kg-1) - real(R8) :: visa ! Kinematic viscosity of dry air (m2 s-1) - real(R8) :: tbot_oC ! Temperature used in visa (deg C) - real(R8) :: rb ! Bulk Richardson number (-) - real(R8) :: zo ! Roughness length for momentum (m) - real(R8) :: zoq ! Roughness length for moisture (m) - real(R8) :: zot ! Roughness length for heat (m) - real(R8) :: u10 ! 10-metre wind speed (m s-1) - real(R8) :: re ! Moisture exchange coefficient for compatibility - ! with default algorithm. - real(R8) :: spval ! local missing value - real(R8) :: loc_epsilon ! Ratio of gas constants (-) - - !--- for cold air outbreak calc -------------------------------- - real(R8) :: tdiff(nMax) ! tbot - ts - real(R8) :: vscl - - !--- formats ---------------------------------------- - character(*),parameter :: subName = '(flux_atmOcn) ' - character(*),parameter :: F00 = "('(flux_atmOcn) ',4a)" - - !----- - ! Straight from original subroutine. - if (debug > 0) write(logunit,F00) "enter" - - if (present(missval)) then - spval = missval - else - spval = shr_const_spval - endif - !----- - - ! Evaluate loc_epsilon. - loc_epsilon = 1.0_R8 / (1.0_R8 + loc_zvir) - - !--- for cold air outbreak calc -------------------------------- - tdiff = tbot - ts - - ! Loop over grid points. - DO n=1,nMax - if (mask(n) /= 0) then - - !-----Calculate some required near surface variables.--------- - vmag_abs = sqrt( ubot(n)**2 + vbot(n)**2 ) - vmag_rel = sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2 ) - - ! For Cold Air Outbreak Modification (based on Mahrt & Sun 1995,MWR): - if (use_coldair_outbreak_mod) then - ! Increase windspeed for negative tbot-ts - if (tdiff(n).lt.td0) then - vscl=min((1._R8+alpha*(abs(tdiff(n)-td0)**0.5_R8/abs(vmag_rel))),maxscl) - vmag_rel=vmag_rel*vscl - endif - endif - - delth = thbot(n) - ts(n) ! Pot. temp. difference with surface (K) - ! Note this is equivalent to Zeng et al - ! (1998) version = delt + 0.0098*zbot - thv = thbot(n)*(1.0_R8+0.61_R8*qbot(n)) ! Virtual potential temperature (K) - ! EQN (17): - !ssq = 0.98_R8 * qsat_ua(ts(n),ps, & ! Surface specific humidity (kg kg-1) - ! loc_epsilon) - ssq = 0.98_R8 * qsat_ua(ts(n),pslv(n), & ! Surface specific humidity (kg kg-1) - loc_epsilon) - delq = qbot(n) - ssq ! Difference to surface (kg kg-1) - delthv = delth*(1.0_R8+0.61_R8*qbot(n)) + & ! Difference of virtual potential - & 0.61_R8*thbot(n)*delq ! temperature with surface (K) - - xlv = 1.0e+6_R8 * & ! Latent heat of vaporization (J kg-1) - & (2.501_R8 - 0.00237_R8 * (ts(n) - loc_tkfrz)) - tbot_oC = tbot(n) - loc_tkfrz - visa = 1.326e-5_R8 * (1.0_R8 + & ! Kinematic viscosity of dry - & 6.542e-3_R8*tbot_oC + & ! air (m2 s-1) from Andreas (1989) - & 8.301e-6_R8*tbot_oC*tbot_oC - & ! CRREL Rep. 89-11 - & 4.84e-9_R8*tbot_oC*tbot_oC*tbot_oC) - cp = loc_cpdair*(1.0_R8 + loc_cpvir*ssq) ! specific heat of moist air (J kg-1 K-1) - - !-----Initial values of u* and convective velocity.----------- - ustar = 0.06_R8 - wstar = 0.5_R8 - ! Update wind speed if unstable regime. - if (delthv.lt.0.0_R8) then - ! EQN (19) - vmag = sqrt( vmag_rel**2 + beta*beta*wstar*wstar ) - else - ! EQN (18) - vmag = max(umin,vmag_rel) - endif - - !-----Iterate to compute new u* and z0.----------------------- - do i = 1,5 - ! EQN (24) - zo = 0.013_R8*ustar*ustar/loc_g + 0.11_R8*visa/ustar - ! EQN (9) assuming neutral - ustar = loc_karman*vmag/log(zbot(n)/zo) - enddo - - !-----Assess stability.--------------------------------------- - rb = loc_g*zbot(n)*delthv / (thv*vmag*vmag) ! bulk Richardson number - - if(rb.ge.0.0_R8) then - ! Neutral or stable: EQNs (4), (9), (13) and definition of rb. - zeta = rb*log(zbot(n)/zo) / & - & (1.0_R8 - 5.0_R8*min(rb,0.19_R8)) - else - ! Unstable: EQNs (4), (8), (12) and definition of rb. - zeta = rb*log(zbot(n)/zo) - endif - - obu = zbot(n)/zeta ! Obukhov length - obu = sign(max(zbot(n)/10.0_R8, abs(obu)), obu) - - !-----Main iterations (2-10 iterations would be fine).------- - do i=1,10 - - ! Update roughness lengths. - call rough_ua(zo,zot,zoq,ustar,visa) - - ! Wind variables. - zeta = zbot(n) / obu - if (zeta.lt.zetam) then - ! Very unstable regime - ! EQN (7) with extra z0 term. - ustar = loc_karman * vmag / (log(zetam*obu/zo) - & - & psi_ua(1_IN, zetam) + & - & psi_ua(1_IN, zo/obu) + & - & 1.14_R8 * ((-zeta)**onethird - (-zetam)**onethird) ) - else if (zeta.lt.0.0_R8) then - ! Unstable regime - ! EQN (8) with extra z0 term. - ustar = loc_karman * vmag / (log(zbot(n)/zo) - & - & psi_ua(1_IN,zeta) + psi_ua(1_IN,zo/obu) ) - else if (zeta.le.1.0_R8) then - ! Stable regime - ! EQN (9) with extra z0 term. - ustar = loc_karman * vmag / (log(zbot(n)/zo) + & - & 5.0_R8*zeta - 5.0_R8*zo/obu) - else - ! Very stable regime - ! EQN (10) with extra z0 term. - ustar = loc_karman * vmag / (log(obu/zo) + 5.0_R8 - & - & 5.0_R8*zo/obu + & - & (5.0_R8*log(zeta) + zeta - 1.0_R8) ) - endif - - ! Temperature variables. - if(zeta.lt.zetat) then - ! Very unstable regime - ! EQN (11) with extra z0 term. - tstar = loc_karman * delth / (log(zetat*obu/zot) - & - & psi_ua(2_IN, zetat) + & - & psi_ua(2_IN, zot/obu) + & - & 0.8_R8*((-zetat)**(-onethird) - (-zeta)**(-onethird)) ) - else if (zeta.lt.0.0_R8) then - ! Unstable regime - ! EQN (12) with extra z0 term. - tstar = loc_karman * delth / & - & (log(zbot(n)/zot) - psi_ua(2_IN,zeta) + psi_ua(2_IN,zot/obu)) - else if (zeta.le.1.0_R8) then - ! Stable regime - ! EQN (13) with extra z0 term. - tstar = loc_karman * delth / (log(zbot(n)/zot) + & - & 5.0_R8*zeta - 5.0_R8*zot/obu) - else - ! Very stable regime - ! EQN (14) with extra z0 term. - tstar = loc_karman * delth / (log(obu/zot) + & - & 5.0_R8 - 5.0_R8*zot/obu + & - & (5.0_R8*log(zeta) + zeta - 1.0_R8) ) - endif - - ! Humidity variables. - ! This is done with re to give variable to save out like - ! in old algorithm. - if (zeta.lt.zetat) then - ! Very unstable regime - ! EQN (11) with extra z0 term. - re = loc_karman / (log(zetat*obu/zoq) - psi_ua(2_IN,zetat) + & - & psi_ua(2_IN,zoq/obu) + & - & 0.8_R8*((-zetat)**(-onethird) - (-zeta)**(-onethird)) ) - else if (zeta.lt.0.0_R8) then - ! Unstable regime - ! EQN (12) with extra z0 term. - re = loc_karman / & - & (log(zbot(n)/zoq) - psi_ua(2_IN,zeta) + psi_ua(2_IN,zoq/obu)) - else if (zeta.le.1.0_R8) then - ! Stable regime - ! EQN (13) with extra z0 term. - re = loc_karman / & - & (log(zbot(n)/zoq) + 5.0_R8*zeta - 5.0_R8*zoq/obu) - else - ! Very stable regime - ! EQN (14) with extra z0 term. - re = loc_karman / & - & (log(obu/zoq) + 5.0_R8 - 5.0_R8*zoq/obu + & - & (5.0_R8*log(zeta) + zeta - 1.0_R8) ) - endif - qstar = re * delq - - ! Update Obukhov length. - thvstar = tstar*(1.0_R8 + 0.61_R8*qbot(n)) + 0.61_R8*thbot(n)*qstar - ! EQN (4) - obu = ustar*ustar * thv / (loc_karman*loc_g*thvstar) - obu = sign( max(zbot(n)/10.0_R8, abs(obu)) ,obu) - - ! Update wind speed if in unstable regime. - if (delthv.lt.0.0_R8) then - ! EQN (20) - wstar = beta * (-loc_g*ustar*thvstar*zpbl/thv)**onethird - ! EQN (19) - vmag = sqrt(vmag_rel**2 + wstar*wstar) - else - ! EQN (18) - vmag = max(umin,vmag_rel) - endif - - enddo ! End of iterations for ustar, tstar, qstar etc. - - - !-----Calculate fluxes and wind stress.--------------------- - - !--- momentum flux --- - ! This should ensure zero wind stress when (relative) wind speed is zero, - ! components are consistent with total, and we don't ever divide by zero. - ! EQN (21) - tau = rbot(n) * ustar * ustar - taux(n) = tau * (ubot(n)-us(n)) / max(umin, vmag_rel) - tauy(n) = tau * (vbot(n)-vs(n)) / max(umin, vmag_rel) - - !--- heat flux --- - ! EQNs (22) and (23) - sen (n) = cp * rbot(n) * tstar * ustar - lat (n) = xlv * rbot(n) * qstar * ustar - lwup(n) = -loc_stebol * ts(n)**4 - - !--- water flux --- - evap(n) = lat(n)/xlv - - !---water isotope flux --- - call wiso_flxoce(2,rbot(n),zbot(n),s16O(n),ts(n),r16O(n),ustar,re,ssq,evap_16O(n), & - qbot(n),evap(n)) - call wiso_flxoce(3,rbot(n),zbot(n),sHDO(n),ts(n),rHDO(n),ustar,re,ssq, evap_HDO(n),& - qbot(n),evap(n)) - call wiso_flxoce(4,rbot(n),zbot(n),s18O(n),ts(n),r18O(n),ustar,re,ssq, evap_18O(n), & - qbot(n),evap(n)) - - !------------------------------------------------------------ - ! compute diagnositcs: 2m ref T & Q, 10m wind speed squared - !------------------------------------------------------------ - - zeta = zbot(n) / obu - if (zeta.lt.zetat) then - if (zeta.lt.zetam) then - ! Very unstable regime for U. - ! EQN (7) - u10 = vmag_abs + (ustar/loc_karman) * & - & 1.14_R8 * ((-zref/obu)**onethird - (-zeta)**onethird) - else - ! Unstable regime for U. - ! EQN (8) - u10 = vmag_abs + (ustar/loc_karman) * & - & (log(zref/zbot(n)) - (psi_ua(1_IN,zref/obu) - psi_ua(1_IN,zeta)) ) - endif - ! Very unstable regime for T and q. - ! EQN (11) - tref(n) = thbot(n) + (tstar/loc_karman) * & - & 0.8_R8 * ((-zeta)**(-onethird) - (-ztref/obu)**(-onethird)) - qref(n) = qbot(n) + (qstar/loc_karman) * & - & 0.8_R8 * ((-zeta)**(-onethird) - (-ztref/obu)**(-onethird)) - - else if (zeta.lt.0.0_R8) then - ! Unstable regime. - ! EQN (8) - u10 = vmag_abs + (ustar/loc_karman) * & - & (log(zref/zbot(n)) - (psi_ua(1_IN,zref/obu) - psi_ua(1_IN,zeta)) ) - ! EQN (12) - tref(n) = thbot(n) + (tstar/loc_karman) * & - & (log(ztref/zbot(n)) - (psi_ua(2_IN,ztref/obu) - psi_ua(2_IN,zeta)) ) - qref(n) = qbot(n) + (qstar/loc_karman) * & - & (log(ztref/zbot(n)) - (psi_ua(2_IN,ztref/obu) - psi_ua(2_IN,zeta)) ) - else if (zeta.le.1.0_R8) then - ! Stable regime. - ! EQN (9) - u10 = vmag_abs + (ustar/loc_karman) * & - & (log(zref/zbot(n)) + 5.0_R8*zref/obu - 5.0_R8*zeta) - ! EQN (13) - tref(n) = thbot(n) + (tstar/loc_karman) * & - & (log(ztref/zbot(n)) + 5.0_R8*ztref/obu - 5.0_R8*zeta) - qref(n) = qbot(n) + (qstar/loc_karman) * & - & (log(ztref/zbot(n)) + 5.0_R8*ztref/obu - 5.0_R8*zeta) - else - ! Very stable regime. - ! EQN (10) - u10 = vmag_abs + (ustar/loc_karman) * & - & (5.0_R8*log(zref/zbot(n)) + zref/obu - zeta) - ! EQN (14) - tref(n) = thbot(n) + (tstar/loc_karman) * & - & (5.0_R8*log(ztref/zbot(n)) + ztref/obu - zeta) - qref(n) = qbot(n) + (qstar/loc_karman) * & - & (5.0_R8*log(ztref/zbot(n)) + ztref/obu - zeta) - - endif - - tref(n) = tref(n) - gamma*ztref ! pot. temp to temp correction - duu10n(n) = u10*u10 ! 10m wind speed squared - - !------------------------------------------------------------ - ! optional diagnostics, needed for water tracer fluxes (dcn) - !------------------------------------------------------------ - if (present(ustar_sv)) ustar_sv(n) = ustar - if (present(ssq_sv )) ssq_sv(n) = ssq - if (present(re_sv )) re_sv(n) = re - - else - - !------------------------------------------------------------ - ! no valid data here -- out of ocean domain - !------------------------------------------------------------ - sen (n) = spval ! sensible heat flux (W/m^2) - lat (n) = spval ! latent heat flux (W/m^2) - lwup (n) = spval ! long-wave upward heat flux (W/m^2) - evap (n) = spval ! evaporative water flux ((kg/s)/m^2) - evap_16O (n) = spval !water tracer flux (kg/s)/m^2) - evap_HDO (n) = spval !HDO tracer flux (kg/s)/m^2) - evap_18O (n) = spval !H218O tracer flux (kg/s)/m^2) - taux (n) = spval ! x surface stress (N) - tauy (n) = spval ! y surface stress (N) - tref (n) = spval ! 2m reference height temperature (K) - qref (n) = spval ! 2m reference height humidity (kg/kg) - duu10n(n) = spval ! 10m wind speed squared (m/s)^2 - - ! Optional diagnostics too: - if (present(ustar_sv)) ustar_sv(n) = spval - if (present(re_sv )) re_sv (n) = spval - if (present(ssq_sv )) ssq_sv (n) = spval - - endif - - ENDDO ! loop over grid points - - END subroutine flux_atmOcn_UA - - !=============================================================================== - ! Functions/subroutines used by UA surface flux scheme. - !=============================================================================== - - ! Stability function for rb < 0 - - real(R8) function psi_ua(k,zeta) - - implicit none - - !-----Input variables.---------- - integer(IN), intent(in) :: k ! Indicates whether this is for momentum (k=1) - ! or for heat/moisture (k=2) - real(R8), intent(in) :: zeta ! Dimensionless height (=z/L) - - !-----Local variables.---------- - real(R8) :: chik ! Function of zeta. - - ! EQN (16) - chik = (1.0_R8 - 16.0_R8*zeta)**0.25_R8 - - if(k.eq.1) then - ! EQN (15) for momentum - psi_ua = 2.0_R8 * log((1.0_R8 + chik)*0.5_R8) + & - & log((1.0_R8 + chik*chik)*0.5_R8) - & - & 2.0_R8 * atan(chik) + 2.0_R8 * atan(1.0_R8) - else - ! EQN (15) for heat/moisture - psi_ua = 2.0_R8 * log((1.0_R8 + chik*chik)*0.5_R8) - endif - - end function psi_ua - - !=============================================================================== - ! Uses Tetens' formula for saturation vapor pressure from - ! Buck(1981) JAM 20, 1527-1532 - - real(R8) function qsat_ua(t,p,loc_epsilon) - - implicit none - - !-----Input variables.---------- - real(R8), intent(in) :: t ! temperature (K) - real(R8), intent(in) :: p ! pressure (Pa) - real(R8), intent(in) :: loc_epsilon ! Ratio of gas constants (-) - - !-----Local variables.---------- - real(R8) :: esat ! saturated vapor pressure (hPa) - - ! Calculate saturated vapor pressure in hPa. - esat = (1.0007_R8 + 0.00000346_R8 * (p/100.0_R8)) * 6.1121_R8 * & - & exp(17.502_R8 * (t - loc_tkfrz) / (240.97_R8 + (t - loc_tkfrz))) - - ! Convert to specific humidity (kg kg-1). - qsat_ua = loc_epsilon * esat / ((p/100.0_R8) - (1.0_R8 - loc_epsilon)*esat) - - end function qsat_ua - - !=============================================================================== - ! Calculate roughness lengths: zo, zot, zoq. - - subroutine rough_ua(zo,zot,zoq,ustar,visa) - - implicit none - - !-----Input variables.---------- - real(R8), intent(in) :: ustar ! friction velocity (m s-1) - real(R8), intent(in) :: visa ! kinematic viscosity of dry air (m2 s-1) - - !-----Output variables.--------- - real(R8), intent(out) :: zo ! roughness length for momentum (m) - real(R8), intent(out) :: zot ! roughness length for heat (m) - real(R8), intent(out) :: zoq ! roughness length for water vapor (m) - - !-----Local variables.---------- - real(R8) :: re_rough ! Rougness Reynold's number (-) - real(R8) :: xq ! Logarithm of roughness length ratios (moisture) - real(R8) :: xt ! Logarithm of roughness length ratios (heat) - - zo = 0.013_R8*ustar*ustar/loc_g + 0.11_R8*visa/ustar ! EQN (24) - re_rough = ustar*zo/visa ! By definition. - xq = 2.67_R8*re_rough**0.25_R8 - 2.57_R8 ! EQN (25) - xt = xq ! EQN (26) - zoq = zo/exp(xq) ! By definition of xq - zot = zo/exp(xt) ! By definition of xt - - end subroutine rough_ua - - real(R8) elemental function cuberoot(a) - real(R8), intent(in) :: a - real(R8), parameter :: one_third = 1._R8/3._R8 - cuberoot = sign(abs(a)**one_third, a) - end function cuberoot - - !=============================================================================== - ! !IROUTINE: flux_atmOcn_diurnal -- internal atm/ocn flux calculation - ! - ! !DESCRIPTION: - ! - ! Internal atm/ocn flux calculation - ! - ! !REVISION HISTORY: - ! 2002-Jun-10 - B. Kauffman - code migrated from cpl5 to cpl6 - ! 2003-Apr-02 - B. Kauffman - taux & tauy now utilize ocn velocity - ! 2003-Apr-02 - B. Kauffman - tref,qref,duu10n mods as per Bill Large - ! 2006-Nov-07 - B. Kauffman - code migrated from cpl6 to share - !=============================================================================== - SUBROUTINE flux_atmOcn_diurnal & - (logunit, nMax ,zbot ,ubot ,vbot ,thbot , & - qbot ,s16O ,sHDO ,s18O ,rbot , & - tbot ,us ,vs , & - ts ,mask , seq_flux_atmocn_minwind, & - sen ,lat ,lwup , & - r16O ,rhdo ,r18O ,evap ,evap_16O, & - evap_HDO ,evap_18O, & - taux ,tauy ,tref ,qref , & - uGust, lwdn , swdn , swup, prec , & - swpen, ocnsal, ocn_prognostic, flux_diurnal, & - ocn_surface_flux_scheme, & - latt, long , warm , salt , speed, regime, & - warmMax, windMax, qSolAvg, windAvg, & - warmMaxInc, windMaxInc, qSolInc, windInc, nInc, & - tBulk, tSkin, tSkin_day, tSkin_night, & - cSkin, cSkin_night, secs ,dt, & - duu10n, ustar_sv ,re_sv ,ssq_sv, & - missval, cold_start ) - ! !USES: - - use water_isotopes, only: wiso_flxoce !subroutine used to calculate water isotope fluxes. - - implicit none - - ! !INPUT/OUTPUT PARAMETERS: - - !--- input arguments -------------------------------- - integer ,intent(in) :: logunit - integer(IN),intent(in) :: nMax ! data vector length - integer(IN),intent(in) :: mask (nMax) ! ocn domain mask 0 <=> out of domain - real(R8) ,intent(in) :: zbot (nMax) ! atm level height (m) - real(R8) ,intent(in) :: ubot (nMax) ! atm u wind (m/s) - real(R8) ,intent(in) :: vbot (nMax) ! atm v wind (m/s) - real(R8) ,intent(in) :: thbot(nMax) ! atm potential T (K) - real(R8) ,intent(in) :: qbot (nMax) ! atm specific humidity (kg/kg) - real(R8) ,intent(in) :: s16O (nMax) ! atm H216O tracer conc. (kg/kg) - real(R8) ,intent(in) :: sHDO (nMax) ! atm HDO tracer conc. (kg/kg) - real(R8) ,intent(in) :: s18O (nMax) ! atm H218O tracer conc. (kg/kg) - real(R8) ,intent(in) :: r16O (nMax) ! ocn H216O tracer ratio/Rstd - real(R8) ,intent(in) :: rHDO (nMax) ! ocn HDO tracer ratio/Rstd - real(R8) ,intent(in) :: r18O (nMax) ! ocn H218O tracer ratio/Rstd - real(R8) ,intent(in) :: rbot (nMax) ! atm air density (kg/m^3) - real(R8) ,intent(in) :: tbot (nMax) ! atm T (K) - real(R8) ,intent(in) :: us (nMax) ! ocn u-velocity (m/s) - real(R8) ,intent(in) :: vs (nMax) ! ocn v-velocity (m/s) - real(R8) ,intent(in) :: ts (nMax) ! ocn temperature (K) - - !--- new arguments ------------------------------- - real(R8),intent(inout) :: swpen (nMax) ! NEW - real(R8),intent(inout) :: ocnsal(nMax) ! NEW (kg/kg) - logical ,intent(in) :: ocn_prognostic ! NEW - logical ,intent(in) :: flux_diurnal ! NEW logical for diurnal on/off - integer(IN) ,intent(in) :: ocn_surface_flux_scheme - - real(R8),intent(in) :: uGust (nMax) ! NEW not used - real(R8),intent(in) :: lwdn (nMax) ! NEW - real(R8),intent(in) :: swdn (nMax) ! NEW - real(R8),intent(in) :: swup (nMax) ! NEW - real(R8),intent(in) :: prec (nMax) ! NEW - real(R8),intent(in) :: latt (nMax) ! NEW - real(R8),intent(in) :: long (nMax) ! NEW - real(R8),intent(inout) :: warm (nMax) ! NEW - real(R8),intent(inout) :: salt (nMax) ! NEW - real(R8),intent(inout) :: speed (nMax) ! NEW - real(R8),intent(inout) :: regime(nMax) ! NEW - real(R8),intent(out) :: warmMax(nMax) ! NEW - real(R8),intent(out) :: windMax(nMax) ! NEW - real(R8),intent(inout) :: qSolAvg(nMax) ! NEW - real(R8),intent(inout) :: windAvg(nMax) ! NEW - real(R8),intent(inout) :: warmMaxInc(nMax) ! NEW - real(R8),intent(inout) :: windMaxInc(nMax) ! NEW - real(R8),intent(inout) :: qSolInc(nMax) ! NEW - real(R8),intent(inout) :: windInc(nMax) ! NEW - real(R8),intent(inout) :: nInc(nMax) ! NEW - - real(R8),intent(out) :: tBulk (nMax) ! NEW - real(R8),intent(out) :: tSkin (nMax) ! NEW - real(R8),intent(out) :: tSkin_day (nMax) ! NEW - real(R8),intent(out) :: tSkin_night (nMax) ! NEW - real(R8),intent(out) :: cSkin (nMax) ! NEW - real(R8),intent(out) :: cSkin_night (nMax) ! NEW - integer(IN),intent(in) :: secs ! NEW elsapsed seconds in day (GMT) - integer(IN),intent(in) :: dt ! NEW - logical ,intent(in) :: cold_start ! cold start flag - real(R8),intent(in) :: seq_flux_atmocn_minwind ! minimum wind speed for atmocn (m/s) - - real(R8),intent(in) ,optional :: missval ! masked value - - !--- output arguments ------------------------------- - real(R8),intent(out) :: sen (nMax) ! heat flux: sensible (W/m^2) - real(R8),intent(out) :: lat (nMax) ! heat flux: latent (W/m^2) - real(R8),intent(out) :: lwup (nMax) ! heat flux: lw upward (W/m^2) - real(R8),intent(out) :: evap (nMax) ! water flux: evap ((kg/s)/m^2) - real(R8),intent(out) :: evap_16O (nMax) ! water flux: evap ((kg/s/m^2) - real(R8),intent(out) :: evap_HDO (nMax) ! water flux: evap ((kg/s)/m^2) - real(R8),intent(out) :: evap_18O (nMax) ! water flux: evap ((kg/s/m^2) - real(R8),intent(out) :: taux (nMax) ! surface stress, zonal (N) - real(R8),intent(out) :: tauy (nMax) ! surface stress, maridional (N) - real(R8),intent(out) :: tref (nMax) ! diag: 2m ref height T (K) - real(R8),intent(out) :: qref (nMax) ! diag: 2m ref humidity (kg/kg) - real(R8),intent(out) :: duu10n(nMax) ! diag: 10m wind speed squared (m/s)^2 - - real(R8),intent(out),optional :: ustar_sv(nMax) ! diag: ustar - real(R8),intent(out),optional :: re_sv (nMax) ! diag: sqrt of exchange coefficient (water) - real(R8),intent(out),optional :: ssq_sv (nMax) ! diag: sea surface humidity (kg/kg) - - - !--- local constants -------------------------------- - real(R8),parameter :: zref = 10.0_R8 ! reference height (m) - real(R8),parameter :: ztref = 2.0_R8 ! reference height for air T (m) - - real(R8),parameter :: lambdaC = 6.0_R8 - real(R8),parameter :: lambdaL = 0.0_R8 - real(R8),parameter :: doLMax = 1.0_R8 - real(R8),parameter :: pwr = 0.2_R8 - real(R8),parameter :: Rizero = 1.0_R8 - real(R8),parameter :: NUzero = 40.0e-4_R8 - real(R8),parameter :: Prandtl = 1.0_R8 - real(R8),parameter :: kappa0 = 0.2e-4_R8 - - real(R8),parameter :: F0 = 0.5_R8 - real(R8),parameter :: F1 = 0.15_R8 - real(R8),parameter :: R1 = 10.0_R8 - - real(R8),parameter :: Ricr = 0.30_R8 - real(R8),parameter :: tiny = 1.0e-12_R8 - real(R8),parameter :: tiny2 = 1.0e-6_R8 - real(R8),parameter :: pi = SHR_CONST_PI - - !!++ COARE only - real(R8),parameter :: zpbl =700.0_R8 ! PBL depth [m] for gustiness parametriz. - - !--- local variables -------------------------------- - integer(IN) :: n ! vector loop index - integer(IN) :: iter ! iteration loop index - integer(IN) :: lsecs ! local seconds elapsed - integer(IN) :: lonsecs ! incrememnt due to lon offset - real(R8) :: vmag ! surface wind magnitude (m/s) - real(R8) :: ssq ! sea surface humidity (kg/kg) - real(R8) :: delt ! potential T difference (K) - real(R8) :: delq ! humidity difference (kg/kg) - real(R8) :: stable ! stability factor - real(R8) :: rdn ! sqrt of neutral exchange coeff (momentum) - real(R8) :: rhn ! sqrt of neutral exchange coeff (heat) - real(R8) :: ren ! sqrt of neutral exchange coeff (water) - real(R8) :: rd ! sqrt of exchange coefficient (momentum) - real(R8) :: rh ! sqrt of exchange coefficient (heat) - real(R8) :: re ! sqrt of exchange coefficient (water) - real(R8) :: ustar ! ustar - real(R8) :: ustar_prev ! ustar - real(R8) :: qstar ! qstar - real(R8) :: tstar ! tstar - real(R8) :: hol ! H (at zbot) over L - real(R8) :: xsq ! ? - real(R8) :: xqq ! ? - real(R8) :: psimh ! stability function at zbot (momentum) - real(R8) :: psixh ! stability function at zbot (heat and water) - real(R8) :: psix2 ! stability function at ztref reference height - real(R8) :: alz ! ln(zbot/zref) - real(R8) :: al2 ! ln(zref/ztref) - real(R8) :: u10n ! 10m neutral wind - real(R8) :: tau ! stress at zbot - real(R8) :: cp ! specific heat of moist air - real(R8) :: fac ! vertical interpolation factor - real(R8) :: DTiter ! - real(R8) :: DSiter ! - real(R8) :: DViter ! - - real(R8) :: Dcool ! - real(R8) :: Qdel ! net cool skin heating - real(R8) :: Hd ! net heating above -z=d - real(R8) :: Hb ! net kinematic heating above -z = delta - real(R8) :: lambdaV ! - real(R8) :: Fd ! net fresh water forcing above -z=d - real(R8) :: ustarw ! surface wind forcing of layer above -z=d - - real(R8) :: Qsol ! solar heat flux (W/m2) - real(R8) :: Qnsol ! non-solar heat flux (W/m2) - - real(R8) :: SSS ! sea surface salinity - real(R8) :: alphaT ! - real(R8) :: betaS ! - - real(R8) :: doL ! ocean forcing stablity parameter - real(R8) :: Rid ! Richardson number at depth d - real(R8) :: Ribulk ! Bulk Richardson number at depth d - real(R8) :: FofRi ! Richardon number dependent diffusivity - real(R8) :: Smult ! multiplicative term based on regime - real(R8) :: Sfact ! multiplicative term based on regime - real(R8) :: Kdiff ! diffusive term based on regime - real(R8) :: Kvisc ! viscosity term based on regime - real(R8) :: rhocn ! - real(R8) :: rcpocn ! - real(R8) :: Nreset ! value for multiplicative reset factor - logical :: lmidnight - logical :: ltwopm - logical :: ltwoam - logical :: lfullday - integer :: nsum - real(R8) :: pexp ! eqn 19 - real(R8) :: AMP ! eqn 18 - real(R8) :: dif3 - real(R8) :: phid - real(R8) :: spval - - !!++ COARE only - real(R8) :: zo,zot,zoq ! roughness lengths - real(R8) :: hsb,hlb ! sens & lat heat flxs at zbot - real(R8) :: trf,qrf,urf,vrf ! reference-height quantities - - !--- local functions -------------------------------- - real(R8) :: qsat ! function: the saturation humididty of air (kg/m^3) - real(R8) :: cdn ! function: neutral drag coeff at 10m - real(R8) :: psimhu ! function: unstable part of psimh - real(R8) :: psixhu ! function: unstable part of psimx - real(R8) :: Umps ! dummy arg ~ wind velocity (m/s) - real(R8) :: Tk ! dummy arg ~ temperature (K) - real(R8) :: xd ! dummy arg ~ ? - real(R8) :: molvisc ! molecular viscosity - real(R8) :: molPr ! molecular Prandtl number - - !--- for cold air outbreak calc -------------------------------- - real(R8) :: tdiff(nMax) ! tbot - ts - real(R8) :: vscl - - ! note: this should use the shr_wv_sat_qsat_liquid as above if this routine is ever used in production - qsat(Tk) = 640380.0_R8 / exp(5107.4_R8/Tk) - cdn(Umps) = 0.0027_R8 / Umps + 0.000142_R8 + 0.0000764_R8 * Umps - psimhu(xd) = log((1.0_R8+xd*(2.0_R8+xd))*(1.0_R8+xd*xd)/8.0_R8) - 2.0_R8*atan(xd) + 1.571_R8 - psixhu(xd) = 2.0_R8 * log((1.0_R8 + xd*xd)/2.0_R8) - molvisc(Tk) = 1.623e-6_R8 * exp((-1.0_R8*(Tk-273.15_R8))/45.2_R8) - molPr(Tk) = 11.64_R8 * exp((-1.0_R8*(Tk-273.15_R8))/40.7_R8) - - !--- formats ---------------------------------------- - character(*),parameter :: subName = '(flux_atmOcn_diurnal) ' - character(*),parameter :: F00 = "('(flux_atmOcn_diurnal) ',4a)" - - !------------------------------------------------------------------------------- - ! PURPOSE: - ! computes atm/ocn surface fluxes - ! - ! NOTES: - ! o all fluxes are positive downward - ! o net heat flux = net sw + lw up + lw down + sen + lat - ! o here, tstar = /U*, and qstar = /U*. - ! o wind speeds should all be above a minimum speed (eg. 1.0 m/s) - ! - ! ASSUMPTIONS: - ! o Neutral 10m drag coeff: cdn = .0027/U10 + .000142 + .0000764 U10 - ! o Neutral 10m stanton number: ctn = .0327 sqrt(cdn), unstable - ! ctn = .0180 sqrt(cdn), stable - ! o Neutral 10m dalton number: cen = .0346 sqrt(cdn) - ! o The saturation humidity of air at T(K): qsat(T) (kg/m^3) - !------------------------------------------------------------------------------- - - if (debug > 0) write(logunit,F00) "enter" - - ! this is especially for flux_diurnal calculations - if (.not. flux_diurnal) then - write(logunit,F00) "ERROR: flux_diurnal must be true" - call shr_sys_abort(subName//"flux diurnal must be true") - endif - spval = shr_const_spval - rh = spval - dviter = spval - dtiter = spval - dsiter = spval - al2 = log(zref/ztref) - !--- for cold air outbreak calc -------------------------------- - tdiff= tbot - ts - - ! equations 18 and 19 - AMP = 1.0_R8/F0-1.0_R8 - pexp = log( (1.0_R8/F1-F0) / (1.0_R8-F0) ) / log(R1) - - if (.not. ocn_prognostic) then - ! Set swpen and ocean salinity from following analytic expressions - swpen(:) = 0.67_R8*(exp((-1._R8*shr_const_zsrflyr)/1.0_R8)) + & - 0.33_R8*exp((-1._R8*shr_const_zsrflyr)/17.0_R8) - ocnsal(:) = shr_const_ocn_ref_sal/1000.0_R8 - else - ! use swpen and ocnsal from input argument - endif - - if (cold_start) then - write(logunit,F00) "Initialize diurnal cycle fields" - warm (:) = 0.0_R8 - salt (:) = 0.0_R8 - speed (:) = 0.0_R8 - regime (:) = 0.0_R8 - qSolAvg (:) = 0.0_R8 - windAvg (:) = 0.0_R8 - warmMax (:) = 0.0_R8 - windMax (:) = 0.0_R8 - warmMaxInc (:) = 0.0_R8 - windMaxInc (:) = 0.0_R8 - qSolInc (:) = 0.0_R8 - windInc (:) = 0.0_R8 - nInc (:) = 0.0_R8 - tSkin_day (:) = ts(:) - tSkin_night(:) = ts(:) - cSkin_night(:) = 0.0_R8 - endif - u10n = 0.0_r8 - stable = 0.0_r8 - DO n=1,nMax - - if (mask(n) /= 0) then - - !--- compute some initial and useful flux quantities --- - - vmag = max(seq_flux_atmocn_minwind, sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2) ) - if (use_coldair_outbreak_mod) then - ! Cold Air Outbreak Modification: - ! Increase windspeed for negative tbot-ts - ! based on Mahrt & Sun 1995,MWR - - if (tdiff(n).lt.td0) then - vscl=min((1._R8+alpha*(abs(tdiff(n)-td0)**0.5_R8/abs(vmag))),maxscl) - vmag=vmag*vscl - endif - endif - alz = log(zbot(n)/zref) - hol = 0.0 - psimh = 0.0 - psixh = 0.0 - rdn = sqrt(cdn(vmag)) - - tBulk(n) = ts(n)+warm(n) ! first guess for tBulk from read in ts,warm - tSkin(n) = tBulk(n) - Qsol = swdn(n) + swup(n) - SSS = 1000.0_R8*ocnsal(n)+salt(n) - lambdaV = lambdaC - - alphaT = 0.000297_R8*(1.0_R8+0.0256_R8*(ts(n)-298.15_R8)+0.003_R8*(SSS - 35.0_R8)) - betaS = 0.000756_R8*(1.0_R8-0.0016_R8*(ts(n)-298.15_R8)) - rhocn = 1023.342_R8*(1.0_R8-0.000297_R8*(ts(n)-298.15_R8)+0.000756_R8 * (SSS - 35.0_R8)) - rcpocn = rhocn * 3990.0_R8*(1.0_R8-0.0012_R8*(SSS - 35.0_R8)) - - Rid = shr_const_g * (alphaT*warm(n) - betaS*salt(n)) *pwr*shr_const_zsrflyr / & - ( pwr*MAX(tiny,speed(n)) )**2 - - Ribulk = 0.0 - - !---------------------------------------------------------- - ! convert elapsed time from GMT to local & - ! check elapsed time. reset warm if near lsecs = reset_sec - !---------------------------------------------------------- - Nreset = 1.0_R8 - - lonsecs = ceiling(long(n)/360.0_R8*86400.0) - lsecs = mod(secs + lonsecs,86400) - - lmidnight = (lsecs >= 0 .and. lsecs < dt) ! 0 = midnight - ltwopm = (lsecs >= 48600 .and. lsecs < 48600+dt) ! 48600 = 1:30pm - ltwoam = (lsecs >= 5400 .and. lsecs < 5400 +dt) ! 5400 = 1:30am - lfullday = (lsecs > 86400-dt .and. lsecs <= 86400) - nsum = nint(nInc(n)) - - if ( lmidnight ) then - Regime(n) = 1.0_R8 ! RESET DIURNAL - warm(n) = 0.0_R8 - salt(n) = 0.0_R8 - speed(n) = 0.0_R8 - endif - ! This should be changed to use the subroutine below - ssq = 0.98_R8 * qsat(tBulk(n)) / rbot(n) ! sea surf hum (kg/kg) - ! call shr_wv_sat_qsat_liquid(tBulk(n), pslv(n), qsat, ssq) - ! ssq = 0.98_R8 * ssq ! sea surf hum (kg/kg) - - delt = thbot(n) - tBulk(n) ! pot temp diff (K) - delq = qbot(n) - ssq ! spec hum dif (kg/kg) - cp = shr_const_cpdair*(1.0_R8 + shr_const_cpvir*ssq) - - !!................................................................. - !! ocn_surface_flux_scheme = 0 : Default E3SMv1 - !! = 1 : COARE algorithm - !!................................................................. - if (ocn_surface_flux_scheme .eq. 0) then! use Large algorithm - stable = 0.5_R8 + sign(0.5_R8 , delt) - - - !--- shift wind speed using old coefficient and stability function - - rd = rdn / (1.0_R8 + rdn/shr_const_karman*(alz-psimh)) - u10n = vmag * rd / rdn - - !--- initial neutral transfer coeffs at 10m - rdn = sqrt(cdn(u10n)) - rhn = (1.0_R8-stable) * 0.0327_R8 + stable * 0.018_R8 - ren = 0.0346_R8 - - !--- initial ustar, tstar, qstar --- - ustar = rdn * vmag - tstar = rhn * delt - qstar = ren * delq - - else if (ocn_surface_flux_scheme .eq. 1) then! use COARE algorithm - - call cor30a(ubot(n),vbot(n),tbot(n),qbot(n),rbot(n) & ! in atm params - & ,us(n),vs(n),tBulk(n),ssq & ! in surf params (NB ts -> tBulk) - & ,zpbl,zbot(n),zbot(n),zref,ztref,ztref & ! in heights - & ,tau,hsb,hlb & ! out: fluxes - & ,zo,zot,zoq,hol,ustar,tstar,qstar & ! out: ss scales - & ,rd,rh,re & ! out: exch. coeffs - & ,trf,qrf,urf,vrf) ! out: reference-height params - ! for the sake of maintaining same defs - hol=zbot(n)/hol - rd=sqrt(rd) - rh=sqrt(rh) - re=sqrt(re) - - ELSE ! N.B.: *no* valid ocn_surface_flux_scheme=2 option if diurnal=.true. - - call shr_sys_abort(subName//" flux_atmOcn_diurnal requires ocn_surface_flux_scheme = 0 or 1") - ENDIF - - ustar_prev = ustar * 2.0_R8 - iter = 0 - ! --- iterate --- - ! Originally this code did three iterations while the non-diurnal version did two - ! So in the new loop this is <= flux_con_max_iter instead of < so that the same defaults - ! will give the same answers in both cases. - do while( abs((ustar - ustar_prev)/ustar) > flux_con_tol .and. iter <= flux_con_max_iter) - iter = iter + 1 - ustar_prev = ustar - !------------------------------------------------------------ - ! iterate to converge on FLUXES Z/L, ustar, tstar and qstar - ! and on Rid in the DIURNAL CYCLE - !------------------------------------------------------------ - Smult = 0.0_R8 - Sfact = 0.0_R8 - Kdiff = 0.0_R8 - Kvisc = 0.0_R8 - dif3 = 0.0_R8 - - ustarw = ustar*sqrt(max(tiny,rbot(n)/rhocn)) - Qnsol = lwdn(n) - shr_const_stebol*(tSkin(n))**4 + & - rbot(n)*ustar*(cp*tstar + shr_const_latvap*qstar) - Hd = (Qnsol + Qsol*(1.0_R8-swpen(n)) ) / rcpocn - Fd = (prec(n) + rbot(n)*ustar*qstar ) * SSS / rhocn - - !--- COOL SKIN EFFECT --- - Dcool = lambdaV*molvisc(tBulk(n)) / ustarw - Qdel = Qnsol + Qsol * & - (0.137_R8 + 11.0_R8*Dcool - 6.6e-5/Dcool *(1.0_R8 - exp((-1.0_R8*Dcool)/8.0e-4))) - Hb = (Qdel/rcpocn)+(Fd*betaS/alphaT) - Hb = min(Hb , 0.0_R8) - - ! lambdaV = lambdaC*(1.0_R8 + ( (0.0_R8-Hb)*16.0_R8*molvisc(tBulk(n))* & - ! shr_const_g*alphaT*molPr(tBulk(n))**2/ustarw**4)**0.75)**(-1._R8/3._R8) - lambdaV = 6.5_R8 - cSkin(n) = MIN(0.0_R8, lambdaV * molPr(tBulk(n)) * Qdel / ustarw / rcpocn ) - - !--- REGIME --- - doL = shr_const_zsrflyr*shr_const_karman*shr_const_g* & - (alphaT*Hd + betaS*Fd ) / ustarw**3 - Rid = MAX(0.0_R8,Rid) - Smult = dt * (pwr+1.0_R8) / (shr_const_zsrflyr*pwr) - Sfact = dt * (pwr+1.0_R8) / (shr_const_zsrflyr)**2 - FofRi = 1.0_R8/(1.0_R8 + AMP*(Rid/Rizero)**pexp) - - if ( (doL.gt.0.0_R8) .and. (Qsol.gt.0.0) ) then - phid = MIN(1.0_R8 + 5.0_R8 * doL, 5.0_R8 + doL) - FofRi = 1.0_R8/(1.0_R8 + AMP*(Rid/Rizero)**pexp) - dif3 = (kappa0 + NUzero *FofRi) - - if ((doL.le.lambdaL).and.(NINT(regime(n)).le.2)) then - regime(n) = 2.0_R8 - Kdiff = shr_const_karman * ustarw * shr_const_zsrflyr / phid - Kvisc = Kdiff * (1.0_R8 - doL/lambdaL)**2 + & - dif3 * (doL/lambdaL)**2 * (3.0_R8 - 2.0_R8 * doL/lambdaL) - Kdiff = Kvisc - else - regime(n) = 3.0_R8 - Kdiff = kappa0 + NUzero * FofRi - Kvisc = Prandtl* kappa0 + NUzero * FofRi - endif - else - if (regime(n).eq.1.0_R8) then - Smult = 0.0_R8 - else - if (Ribulk .gt. Ricr) then - regime(n) = 3.0_R8 - Kdiff = kappa0 + NUzero * FofRi - Kvisc = Prandtl* kappa0 + NUzero * FofRi - else - regime(n) = 4.0_R8 - Kdiff = shr_const_karman*ustarw*shr_const_zsrflyr *cuberoot(1.0_R8-7.0_R8*doL) - Kvisc = Kdiff - endif - endif - - endif - - !--- IMPLICIT INTEGRATION --- - - DTiter = (warm(n) +(Smult*Hd)) /(1.+ Sfact*Kdiff) - DSiter = (salt(n) -(Smult*Fd)) /(1.+ Sfact*Kdiff) - DViter = (speed(n) +(Smult*ustarw*ustarw)) /(1.+ Sfact*Kvisc) - DTiter = MAX( 0.0_R8, DTiter) - DViter = MAX( 0.0_R8, DViter) - - Rid =(shr_const_g*(alphaT*DTiter-betaS*DSiter)*pwr*shr_const_zsrflyr) / & - (pwr*MAX(tiny,DViter))**2 - Ribulk = Rid * pwr - Ribulk = 0.0_R8 - tBulk(n) = ts(n) + DTiter - tSkin(n) = tBulk(n) + cskin(n) - - !--need to update ssq,delt,delq as function of tBulk ---- - - ! This should be changed to use the subroutine below - ssq = 0.98_R8 * qsat(tBulk(n)) / rbot(n) ! sea surf hum (kg/kg) - ! call shr_wv_sat_qsat_liquid(tBulk(n), pslv(n), qsat, ssq) - ! ssq = 0.98_R8 * ssq ! sea surf hum (kg/kg) - - delt = thbot(n) - tBulk(n) ! pot temp diff (K) - delq = qbot(n) - ssq ! spec hum dif (kg/kg) - - !--- UPDATE FLUX ITERATION --- - - !!................................................................. - !! ocn_surface_flux_scheme = 0 : Default CESM1.2 - !! = 1 : COARE algorithm - !!................................................................. - if (ocn_surface_flux_scheme .eq. 0) then! use Large algorithm - - !--- compute stability & evaluate all stability functions --- - hol = shr_const_karman*shr_const_g*zbot(n)* & - (tstar/thbot(n)+qstar/(1.0_R8/shr_const_zvir+qbot(n)))/ustar**2 - hol = sign( min(abs(hol),10.0_R8), hol ) - stable = 0.5_R8 + sign(0.5_R8 , hol) - xsq = max(sqrt(abs(1.0_R8 - 16.0_R8*hol)) , 1.0_R8) - xqq = sqrt(xsq) - psimh = -5.0_R8*hol*stable + (1.0_R8-stable)*psimhu(xqq) - psixh = -5.0_R8*hol*stable + (1.0_R8-stable)*psixhu(xqq) - - !--- shift wind speed using old coefficient and stability function --- - rd = rdn / (1.0_R8 + rdn/shr_const_karman*(alz-psimh)) - u10n = vmag * rd / rdn - - !--- update neutral transfer coeffs at 10m - rdn = sqrt(cdn(u10n)) - rhn = (1.0_R8-stable) * 0.0327_R8 + stable * 0.018_R8 - ren = 0.0346_R8 - - !--- shift all coeffs to measurement height and stability --- - rd = rdn / (1.0_R8 + rdn/shr_const_karman*(alz-psimh)) - rh = rhn / (1.0_R8 + rhn/shr_const_karman*(alz-psixh)) - re = ren / (1.0_R8 + ren/shr_const_karman*(alz-psixh)) - - ustar = rd * vmag - tstar = rh * delt - qstar = re * delq - - !--- heat flux --- - - tau = rbot(n) * ustar * ustar - sen (n) = cp * tau * tstar / ustar - lat (n) = shr_const_latvap * tau * qstar / ustar - - else if (ocn_surface_flux_scheme .eq. 1) then! use COARE algorithm - - call cor30a(ubot(n),vbot(n),tbot(n),qbot(n),rbot(n) & ! in atm params - & ,us(n),vs(n),tBulk(n),ssq & ! in surf params (NB ts -> tBulk) - & ,zpbl,zbot(n),zbot(n),zref,ztref,ztref & ! in heights - & ,tau,hsb,hlb & ! out: fluxes - & ,zo,zot,zoq,hol,ustar,tstar,qstar & ! out: ss scales - & ,rd,rh,re & ! out: exch. coeffs - & ,trf,qrf,urf,vrf) ! out: reference-height params - ! for the sake of maintaining same defs - hol=zbot(n)/hol - rd=sqrt(rd) - rh=sqrt(rh) - re=sqrt(re) - - !--- heat flux --- - - sen (n) = hsb - lat (n) = hlb - - else ! N.B.: NO ocn_surface_flux_scheme=2 option - call shr_sys_abort(subName//", flux_diurnal requires ocn_surface_flux_scheme = 0 or 1") - endif - - ENDDO ! end iteration loop - if (iter < 1) then - call shr_sys_abort('No iterations performed ') - end if - !--- COMPUTE FLUXES TO ATMOSPHERE AND OCEAN --- - - ! Now calculated further up in subroutine. - !tau = rbot(n) * ustar * ustar - !sen (n) = cp * tau * tstar / ustar - !lat (n) = shr_const_latvap * tau * qstar / ustar - - !--- momentum flux --- - taux(n) = tau * (ubot(n)-us(n)) / vmag - tauy(n) = tau * (vbot(n)-vs(n)) / vmag - - !--- LW radiation --- - lwup(n) = -shr_const_stebol * Tskin(n)**4 - - !--- water flux --- - evap(n) = lat(n)/shr_const_latvap - - !---water isotope flux --- - !!ZZZ bugfix to be done - call wiso_flxoce(2,rbot(n),zbot(n),s16O(n),ts(n),r16O(n),ustar,re,ssq, evap_16O(n),& - qbot(n),evap(n)) - call wiso_flxoce(3,rbot(n),zbot(n),sHDO(n),ts(n),rHDO(n),ustar,re,ssq, evap_HDO(n),& - qbot(n),evap(n)) - call wiso_flxoce(4,rbot(n),zbot(n),s18O(n),ts(n),r18O(n),ustar,re,ssq, evap_18O(n),& - qbot(n),evap(n)) - - !------------------------------------------------------------ - ! compute diagnostics: 2m ref T & Q, 10m wind speed squared - !------------------------------------------------------------ - - if (ocn_surface_flux_scheme .eq. 0) then ! use Large algorithm - - hol = hol*ztref/zbot(n) - xsq = max( 1.0_R8, sqrt(abs(1.0_R8-16.0_R8*hol)) ) - xqq = sqrt(xsq) - psix2 = -5.0_R8*hol*stable + (1.0_R8-stable)*psixhu(xqq) - fac = (rh/shr_const_karman) * (alz + al2 - psixh + psix2 ) - tref(n) = thbot(n) - delt*fac - tref(n) = tref(n) - 0.01_R8*ztref ! pot temp to temp correction - fac = (re/shr_const_karman) * (alz + al2 - psixh + psix2 ) - qref(n) = qbot(n) - delq*fac - - duu10n(n) = u10n*u10n ! 10m wind speed squared - - else if (ocn_surface_flux_scheme .eq. 1) then! use COARE algorithm - - tref(n) = trf - qref(n) = qrf - duu10n(n) = urf**2+vrf**2 - u10n = sqrt(duu10n(n)) - endif - - if (flux_diurnal) then - - !------------------------------------------------------------ - ! update new prognostic variables - !------------------------------------------------------------ - - warm (n) = DTiter - salt (n) = DSiter - speed (n) = DViter - - if (ltwopm) then - tSkin_day(n) = tSkin(n) - warmmax(n) = max(DTiter,0.0_R8) - endif - - if (ltwoam) then - tSkin_night(n) = tSkin(n) - cSkin_night(n) = cSkin(n) - endif - - if ((lmidnight).and.(lfullday)) then - qSolAvg(n) = qSolInc(n)/real(nsum+1,R8) - windAvg(n) = windInc(n)/real(nsum+1,R8) - ! warmMax(n) = max(DTiter,warmMaxInc(n)) - windMax(n) = max(u10n,windMaxInc(n)) - - nsum = 0 - - qSolInc(n) = Qsol - windInc(n) = u10n - - ! warmMaxInc(n) = 0.0_R8 - windMaxInc(n) = 0.0_R8 - - ! tSkin_night(n) = tSkin(n) - ! cSkin_night(n) = cSkin(n) - - else - - if ((lmidnight).and.(.not.(lfullday))) then - - nsum = 0 - - qSolInc(n) = Qsol - windInc(n) = u10n - - ! warmMaxInc(n) = 0.0_R8 - windMaxInc(n) = 0.0_R8 - - else - - nsum = nsum + 1 - - ! warmMaxInc (n) = max(DTiter,warmMaxInc(n)) - windMaxInc (n) = max(u10n, windMaxInc(n)) - ! windMaxInc (n) = max(Qsol, windMaxInc(n)) - qSolInc (n) = qSolInc(n)+Qsol - windInc (n) = windInc(n)+u10n - - endif - endif - - nInc(n) = real(nsum,R8) ! set nInc to incremented or reset nsum - - - if (present(ustar_sv)) ustar_sv(n) = ustar - if (present(re_sv )) re_sv (n) = re - if (present(ssq_sv )) ssq_sv (n) = ssq - - else ! mask = 0 - - !------------------------------------------------------------ - ! no valid data here -- out of domain - !------------------------------------------------------------ - warm (n) = spval ! NEW - salt (n) = spval ! NEW - speed (n) = spval ! NEW - regime (n) = spval ! NEW - tBulk (n) = spval ! NEW - tSkin (n) = spval ! NEW - tSkin_night(n) = spval ! NEW - tSkin_day (n) = spval ! NEW - cSkin (n) = spval ! NEW - cSkin_night(n) = spval ! NEW - warmMax (n) = spval ! NEW - windMax (n) = spval ! NEW - qSolAvg (n) = spval ! NEW - windAvg (n) = spval ! NEW - warmMaxInc (n) = spval ! NEW - windMaxInc (n) = spval ! NEW - qSolInc (n) = spval ! NEW - windInc (n) = spval ! NEW - nInc (n) = 0.0_R8 ! NEW - - sen (n) = spval ! sensible heat flux (W/m^2) - lat (n) = spval ! latent heat flux (W/m^2) - lwup (n) = spval ! long-wave upward heat flux (W/m^2) - evap (n) = spval ! evaporative water flux ((kg/s)/m^2) - evap_16O (n) = spval ! water tracer flux (kg/s)/m^2) - evap_HDO (n) = spval ! HDO tracer flux (kg/s)/m^2) - evap_18O (n) = spval ! H218O tracer flux (kg/s)/m^2) - taux (n) = spval ! x surface stress (N) - tauy (n) = spval ! y surface stress (N) - tref (n) = spval ! 2m reference height temperature (K) - qref (n) = spval ! 2m reference height humidity (kg/kg) - duu10n(n) = spval ! 10m wind speed squared (m/s)^2 - - if (present(ustar_sv)) ustar_sv(n) = spval - if (present(re_sv )) re_sv (n) = spval - if (present(ssq_sv )) ssq_sv (n) = spval - - endif ! mask - - endif ! flux diurnal logic - - ENDDO ! end n loop - - END subroutine flux_atmOcn_diurnal - - !=============================================================================== - ! !IROUTINE: shr_flux_MOstability -- Monin-Obukhov BL stability functions - ! - ! !DESCRIPTION: - ! - ! Monin-Obukhov boundary layer stability functions, two options: - ! turbulent velocity scales or gradient and integral functions - ! via option = shr_flux_MOwScales or shr_flux_MOfunctions - ! - ! !REVISION HISTORY: - ! 2007-Sep-19 - B. Kauffman, Bill Large - first version - !=============================================================================== - subroutine flux_MOstability(logunit,option,arg1,arg2,arg3,arg4,arg5) - - ! !USES: - - implicit none - - ! !INPUT/OUTPUT PARAMETERS: - integer ,intent(in) :: logunit - integer ,intent(in) :: option ! shr_flux_MOwScales or MOfunctions - real(R8) ,intent(in) :: arg1 ! scales: uStar (in) funct: zeta (in) - real(R8) ,intent(inout) :: arg2 ! scales: zkB (in) funct: phim (out) - real(R8) ,intent(out) :: arg3 ! scales: phim (out) funct: phis (out) - real(R8) ,intent(out) :: arg4 ! scales: phis (out) funct: psim (out) - real(R8) ,intent(out),optional :: arg5 ! scales: (unused) funct: psis (out) - - !----- local variables ----- - real(R8) :: zeta ! z/L - real(R8) :: uStar ! friction velocity - real(R8) :: zkB ! (height)*(von Karman)*(surface bouyancy flux) - real(R8) :: phim ! momentum gradient function or scale - real(R8) :: phis ! temperature gradient function or scale - real(R8) :: psim ! momentum integral function or scale - real(R8) :: psis ! temperature integral function or scale - real(R8) :: temp ! temporary-variable/partial calculation - - !----- local variables, stable case ----- - real(R8),parameter :: uStarMin = 0.001_R8 ! lower bound on uStar - real(R8),parameter :: a = 1.000_R8 ! constant from Holtslag & de Bruin, equation 12 - real(R8),parameter :: b = 0.667_R8 ! constant from Holtslag & de Bruin, equation 12 - real(R8),parameter :: c = 5.000_R8 ! constant from Holtslag & de Bruin, equation 12 - real(R8),parameter :: d = 0.350_R8 ! constant from Holtslag & de Bruin, equation 12 - - !----- local variables, unstable case ----- - real(R8),parameter :: a2 = 3.0_R8 ! constant from Wilson, equation 10 - - !----- formats ----- - character(*),parameter :: subName = '(shr_flux_MOstability) ' - character(*),parameter :: F00 = "('(shr_flux_MOstability) ',4a)" - character(*),parameter :: F01 = "('(shr_flux_MOstability) ',a,i5)" - - !------------------------------------------------------------------------------- - ! Notes:: - ! o this could be two routines, but are one to help keep them aligned - ! o the stable calculation is taken from... - ! A.A.M. HoltSlag and H.A.R. de Bruin, 1988: - ! "Applied Modeling of the Nighttime Surface Energy Balance over Land", - ! Journal of Applied Meteorology, Vol. 27, No. 6, June 1988, 659-704 - ! o the unstable calculation is taken from... - ! D. Keith Wilson, 2001: "An Alternative Function for the Wind and - ! Temperature Gradients in Unstable Surface Layers", - ! Boundary-Layer Meteorology, 99 (2001), 151-158 - !------------------------------------------------------------------------------- - - !----- check for consistancy between option and arguments ------------------ - if (debug > 1) then - if (debug > 2) write(logunit,F01) "enter, option = ",option - if ( option == shr_flux_MOwScales .and. present(arg5) ) then - write(logunit,F01) "ERROR: option1 must have four arguments" - call shr_sys_abort(subName//"option inconsistant with arguments") - else if ( option == shr_flux_MOfunctions .and. .not. present(arg5) ) then - write(logunit,F01) "ERROR: option2 must have five arguments" - call shr_sys_abort(subName//"option inconsistant with arguments") - else - write(logunit,F01) "invalid option = ",option - call shr_sys_abort(subName//"invalid option") - end if - end if - - !------ velocity scales option ---------------------------------------------- - if (option == shr_flux_MOwScales) then - - !--- input --- - uStar = arg1 - zkB = arg2 - - if (zkB >= 0.0_R8) then ! ----- stable ----- - zeta = zkB/(max(uStar,uStarMin)**3) - temp = exp(-d*zeta) - phim = uStar/(1.0_R8 + zeta*(a + b*(1.0_R8 + c - d*zeta)*temp)) - phis = phim - else ! ----- unstable ----- - temp = (zkB*zkB)**(1.0_R8/a2) ! note: zkB < 0, zkB*zkB > 0 - phim = sqrt(uStar**2 + shr_flux_MOgammaM*temp) - phis = sqrt(uStar**2 + shr_flux_MOgammaS*temp) - end if - - !--- output --- - arg3 = phim - arg4 = phis - ! arg5 = - - !------ stability function option ------------------------------------------- - else if (option == shr_flux_MOfunctions) then - - !--- input --- - zeta = arg1 - - if (zeta >= 0.0_R8) then ! ----- stable ----- - temp = exp(-d*zeta) - phim = 1.0_R8 + zeta*(a + b*(1.0_R8 + c - d*zeta)*temp) - phis = phim - psim = -a*zeta - b*(zeta - c/d)*temp - b*c/d - psis = psim - else ! ----- unstable ---- - temp = (zeta*zeta)**(1.0_R8/a2) ! note: zeta < 0, zeta*zeta > 0 - phim = 1.0_R8/sqrt(1.0_R8 + shr_flux_MOgammaM*temp) - phis = 1.0_R8/sqrt(1.0_R8 + shr_flux_MOgammaS*temp) - psim = a2*log(0.5_R8 + 0.5_R8/phim) - psis = a2*log(0.5_R8 + 0.5_R8/phis) - end if - - !--- output --- - arg2 = phim - arg3 = phis - arg4 = psim - arg5 = psis - !---------------------------------------------------------------------------- - else - write(logunit,F01) "invalid option = ",option - call shr_sys_abort(subName//"invalid option") - endif - - end subroutine flux_MOstability - - !=============================================================================== - ! !DESCRIPTION: - ! - ! COARE v3.0 parametrisation - ! - ! !REVISION HISTORY: - ! 2013-Nov-22: Thomas Toniazzo's adaptation of Chris Fairall's code, - ! downloaded from - ! ftp://ftp1.esrl.noaa.gov/users/cfairall/wcrp_wgsf/computer_programs/cor3_0/ - ! * no wave, standard coare 2.6 charnock - ! * skin parametrisation also off (would require radiative fluxes and - ! rainrate in input) - ! * added diagnostics, comments and references - !=============================================================================== - subroutine cor30a(ubt,vbt,tbt,qbt,rbt & ! in atm params - & ,uss,vss,tss,qss & ! in surf params - & ,zbl,zbu,zbt,zrfu,zrfq,zrft & ! in heights - & ,tau,hsb,hlb & ! out: fluxes - & ,zo,zot,zoq,L,usr,tsr,qsr & ! out: ss scales - & ,Cd,Ch,Ce & ! out: exch. coeffs - & ,trf,qrf,urf,vrf) ! out: reference-height params - - ! !USES: - - IMPLICIT NONE - - ! !INPUT/OUTPUT PARAMETERS: - - real(R8),intent(in) :: ubt,vbt,tbt,qbt,rbt,uss,vss,tss,qss - real(R8),intent(in) :: zbl,zbu,zbt,zrfu,zrfq,zrft - real(R8),intent(out):: tau,hsb,hlb,zo,zot,zoq,L,usr,tsr,qsr,Cd,Ch,Ce & - & ,trf,qrf,urf,vrf - - real(R8) ua,va,ta,q,rb,us,vs,ts,qs,zi,zu,zt,zq,zru,zrq,zrt ! internal vars - - real(R8):: cpa,rgas,grav,pi,von,beta ! phys. params - real(R8):: le,rhoa,cpv ! derived phys. params - real(R8):: t,visa,du,dq,dt ! params of problem - - real(R8):: u10,zo10,zot10,cd10,ch10,ct10,ct,cc,ribu,zetu,l10,charn ! init vars - real(R8):: zet,rr,bf,ug,ut ! loop iter vars - real(R8):: cdn_10,chn_10,cen_10 ! aux. output vars - - integer(IN):: i,nits ! iter loop counters - - integer(IN):: jcool ! aux. cool-skin vars - real(R8):: dter,wetc,dqer - - ua=ubt !wind components (m/s) at height zu (m) - va=vbt - ta=tbt !bulk air temperature (K), height zt - Q =qbt !bulk air spec hum (kg/kg), height zq - rb=rbt ! air density - us=uss !surface current components (m/s) - vs=vss - ts=tss !bulk water temperature (K) if jcool=1, interface water T if jcool=0 - qs=qss !bulk water spec hum (kg/kg) if jcool=1 etc - zi=zbl !PBL depth (m) - zu=zbu !wind speed measurement height (m) - zt=zbt !air T measurement height (m) - zq=zbt !air q measurement height (m) - zru=zrfu ! reference height for st.diagn.U - zrq=zrfq ! reference height for st.diagn.T,q - zrt=zrft ! reference height for st.diagn.T,q - - !**** constants - Beta= 1.2_R8 - von = 0.4_R8 - pi = 3.141593_R8 - grav= SHR_CONST_G - Rgas= SHR_CONST_RGAS - cpa = SHR_CONST_CPDAIR - - !*** physical parameters - Le = SHR_CONST_LATVAP -.00237e6_R8*(ts-273.16_R8) - ! cpv = shr_const_cpdair*(1.0_R8 + shr_const_cpvir*Qs) ! form in NCAR code - cpv = cpa*(1.0_R8+0.84_R8*Q) - ! rhoa= P/(Rgas*ta*(1+0.61*Q)) ! if input were pressure - rhoa= rb - - ! parametrisation for air kinematic viscosity (Andreas 1989,p.31) - t = ta-273.16_R8 - visa= 1.326e-5_R8*(1.0_R8+6.542e-3_R8*t+8.301e-6_R8*t*t-4.84e-9_R8*t*t*t) - - du = sqrt((ua-us)**2+(va-vs)**2) - dt = ts-ta -.0098_R8*zt - dq = Qs-Q - - !*** don't use cool-skin params for now, but assign values to Ter and Qer - jcool=0_IN - dter=0.3_R8 - wetc=0.622_R8*Le*Qs/(Rgas*ts**2) - dqer=wetc*dter - - !***************** Begin bulk-model calculations *************** - - !*************** first guess - ug=0.5_R8 - - ut = sqrt(du*du+ug*ug) - u10 = ut*log(10.0_R8/1.0e-4_R8)/log(zu/1.0e-4_R8) - usr = .035_R8*u10 - zo10 = 0.011_R8*usr*usr/grav+0.11_R8*visa/usr - Cd10 = (von/log(10.0_R8/zo10))**2 - Ch10 = 0.00115_R8 - Ct10 = Ch10/sqrt(Cd10) - zot10= 10.0_R8/exp(von/Ct10) - Cd =(von/log(zu/zo10))**2 - Ct = von/log(zt/zot10) - CC = von*Ct/Cd - - ! Bulk Richardson number - Ribu=-grav*zu/ta*((dt-dter*jcool)+.61_R8*ta*dq)/ut**2 - ! initial guess for stability parameter... - if (Ribu .LT. 0.0_R8) then - ! pbl-height dependent - zetu=CC*Ribu/( 1.0_R8 - (.004_R8*Beta**3*zi/zu) * Ribu ) - else - zetu=CC*Ribu*(1.0_R8 + 27.0_R8/9.0_R8*Ribu/CC) - endif - ! ...and MO length - L10=zu/zetu - - if (zetu .GT. 50.0_R8) then - nits=1_IN - else - nits=3_IN - endif - - usr = ut*von/(log(zu/zo10)-psiuo(zu/L10)) - tsr = (dt-dter*jcool)*von/(log(zt/zot10)-psit_30(zt/L10)) - qsr = (dq-dqer*jcool)*von/(log(zq/zot10)-psit_30(zq/L10)) - - ! parametrisation for Charney parameter (section 3c of Fairall et al. 2003) - charn=0.011_R8 - if (ut .GT. 10.0_R8) then - charn=0.011_R8+(ut-10.0_R8)/(18.0_R8-10.0_R8)*(0.018_R8-0.011_R8) - endif - if (ut .GT. 18.0_R8) then - charn=0.018_R8 - endif - - !*************** iteration loop ************ - do i=1, nits - - ! stability parameter - zet=-von*grav*zu/ta*(tsr*(1.0_R8+0.61_R8*Q)+.61_R8*ta*qsr)/(usr*usr)/(1.0_R8+0.61_R8*Q) - - ! momentum roughness length... - zo = charn*usr*usr/grav+0.11_R8*visa/usr - ! ...& MO length - L = zu/zet - - ! tracer roughness length - rr = zo*usr/visa - zoq= min(1.15e-4_R8,5.5e-5_R8/rr**.6_R8) - zot= zoq ! N.B. same for vapour and heat - - ! new surface-layer scales - usr = ut *von/(log(zu/zo )-psiuo(zu/L)) - tsr = (dt-dter*jcool)*von/(log(zt/zot)-psit_30(zt/L)) - qsr = (dq-dqer*jcool)*von/(log(zq/zoq)-psit_30(zq/L)) - - ! gustiness parametrisation - Bf=-grav/ta*usr*(tsr+.61_R8*ta*qsr) - if (Bf .GT. 0.0_R8) then - ug=Beta*(Bf*zi)**.333_R8 - else - ug=.2_R8 - endif - ut=sqrt(du*du+ug*ug) - - enddo - !*************** end loop ************ - - !******** fluxes @ measurement heights zu,zt,zq ******** - tau= rhoa*usr*usr*du/ut !stress magnitude - hsb=-rhoa*cpa*usr*tsr !heat downwards - hlb=-rhoa*Le*usr*qsr !wv downwards - - !****** transfer coeffs relative to ut @meas. hts ****** - Cd= tau/rhoa/ut/max(.1_R8,du) - if (tsr.ne.0._r8) then - Ch= usr/ut*tsr/(dt-dter*jcool) - else - Ch= usr/ut* von/(log(zt/zot)-psit_30(zt/L)) - endif - if (qsr.ne.0.0_R8) then - Ce= usr/ut*qsr/(dq-dqer*jcool) - else - Ce= usr/ut* von/(log(zq/zoq)-psit_30(zq/L)) - endif - - !********** 10-m neutral coeff relative to ut ********* - Cdn_10=von*von/log(10.0_R8/zo)/log(10.0_R8/zo) - Chn_10=von*von/log(10.0_R8/zo)/log(10.0_R8/zot) - Cen_10=von*von/log(10.0_R8/zo)/log(10.0_R8/zoq) - - !********** reference-height values for u,q,T ********* - urf=us+(ua-us)*(log(zru/zo)-psiuo(zru/L))/(log(zu/zo)-psiuo(zu/L)) - vrf=vs+(va-vs)*(log(zru/zo)-psiuo(zru/L))/(log(zu/zo)-psiuo(zu/L)) - qrf=qs-dq*(log(zrq/zoq)-psit_30(zrq/L))/(log(zq/zoq)-psit_30(zq/L)) - trf=ts-dt*(log(zrt/zot)-psit_30(zrt/L))/(log(zt/zot)-psit_30(zt/L)) - trf=trf+.0098_R8*zrt - - end subroutine cor30a - - !=============================================================================== - ! !IROUTINE: PSIUo - ! - ! !DESCRIPTION: - ! - ! momentum stability functions adopted in COARE v3.0 parametrisation. - ! Chris Fairall's code (see cor30a) - ! - ! !REVISION HISTORY: - ! 22/11/2013: Thomas Toniazzo: comments added - !=============================================================================== - - real (R8) function psiuo(zet) - ! !INPUT/OUTPUT PARAMETERS: - real(R8),intent(in) :: zet - real(R8) ::c,x,psik,psic,f - !----------------------------------------------------------------- - ! N.B.: z0/L always neglected compared to z/L and to 1 - !----------------------------------------------------------------- - if(zet>0.0_R8)then - ! Beljaars & Holtslag (1991) - c=min(50._R8,.35_R8*zet) - psiuo=-((1.0_R8+1.0_R8*zet)**1.0_R8+.667_R8*(zet-14.28_R8)/exp(c)+8.525_R8) - else - ! Dyer & Hicks (1974) for weak instability - x=(1.0_R8-15.0_R8*zet)**.25_R8 ! 15 instead of 16 - psik=2.0_R8*log((1.0_R8+x)/2.0_R8)+log((1.0_R8+x*x)/2.0_R8)-2.0_R8*atan(x)+2.0_R8*atan(1.0_R8) - ! Fairall et al. (1996) for strong instability (Eq.(13)) - x=(1.0_R8-10.15_R8*zet)**.3333_R8 - psic= 1.5_R8*log((1.0_R8+x+x*x)/3.0_R8)-sqrt(3.0_R8)*atan((1.0_R8+2.0_R8*x)/sqrt(3.0_R8)) & - & +4.0_R8*atan(1.0_R8)/sqrt(3.0_R8) - f=zet*zet/(1.0_R8+zet*zet) - psiuo=(1.0_R8-f)*psik+f*psic - endif - END FUNCTION psiuo - - !=============================================================================== - ! !IROUTINE: PSIT_30 - ! - ! !DESCRIPTION: - ! - ! momentum stability functions adopted in COARE v3.0 parametrisation. - ! Chris Fairall's code (see cor30a) - ! - ! !REVISION HISTORY: - ! 22/11/2013: Thomas Toniazzo: comments added - !=============================================================================== - real (R8) function psit_30(zet) - ! !INPUT/OUTPUT PARAMETERS: - real(R8),intent(in) :: zet - ! !EOP - real(R8) ::c,x,psik,psic,f - !----------------------------------------------------------------- - ! N.B.: z0/L always neglected compared to z/L and to 1 - !----------------------------------------------------------------- - if(zet>0.0_R8)then - ! Beljaars & Holtslag (1991) - c=min(50._R8,.35_R8*zet) - psit_30=-((1.0_R8+2.0_R8/3.0_R8*zet)**1.5_R8+.667_R8*(zet-14.28_R8)/exp(c)+8.525_R8) - else - ! Dyer & Hicks (1974) for weak instability - x=(1.0_R8-15.0_R8*zet)**.5_R8 ! 15 instead of 16 - psik=2.0_R8*log((1.0_R8+x)/2.0_R8) - ! Fairall et al. (1996) for strong instability - x=(1.0_R8-(34.15_R8*zet))**.3333_R8 - psic= 1.5_R8*log((1.0_R8+x+x*x)/3.0_R8)-sqrt(3.0_R8)*atan((1.0_R8+2.0_R8*x)/sqrt(3.0_R8)) & - & +4.0_R8*atan(1.0_R8)/sqrt(3.0_R8) - f=zet*zet/(1.0_R8+zet*zet) - psit_30=(1.0_R8-f)*psik+f*psic - endif - end FUNCTION psit_30 - end module shr_flux_mod From 9682c52fd73d143bfb8b190e7bc580250c2b5bce Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 17 Oct 2025 20:11:05 +0200 Subject: [PATCH 102/123] more updates to get code to compile successfully --- mediator/med_phases_aofluxes_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index 02b7de063..9417e2528 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -1047,7 +1047,7 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) !---------------------------------- #ifdef CESMCOUPLED - call flux_atmocn (logunit=logunit, & + call flux_atmocn_driver (logunit=logunit, & nMax=aoflux_in%lsize, & zbot=aoflux_in%zbot, ubot=aoflux_in%ubot, vbot=aoflux_in%vbot, thbot=aoflux_in%thbot, & qbot=aoflux_in%shum, rainc=aoflux_in%rainc, rbot=aoflux_in%dens, & From cc8f24e7b4fa9306d64f5b0870cae161cbc05258 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 17 Oct 2025 20:34:33 +0200 Subject: [PATCH 103/123] more compile fixes --- cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 | 3 --- cesm/flux_atmocn/flux_atmocn_Large.F90 | 2 -- 2 files changed, 5 deletions(-) diff --git a/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 b/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 index 46231bdf5..0c1a62b8e 100644 --- a/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 +++ b/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 @@ -115,9 +115,6 @@ subroutine flux_atmOcn_COARE( & real(R8) :: tdiff(nMax) ! tbot - ts real(R8) :: vscl - !--- functions --- - qsat(Tk) = 640380.0_R8 / exp(5107.4_R8/Tk) - !--- formats ---------------------------------------- character(*),parameter :: subName = '(flux_atmOcn_COARE) ' character(*),parameter :: F00 = "('(flux_atmOcn_COARE) ',4a)" diff --git a/cesm/flux_atmocn/flux_atmocn_Large.F90 b/cesm/flux_atmocn/flux_atmocn_Large.F90 index 85f95f716..d58d512ba 100644 --- a/cesm/flux_atmocn/flux_atmocn_Large.F90 +++ b/cesm/flux_atmocn/flux_atmocn_Large.F90 @@ -143,8 +143,6 @@ subroutine flux_atmOcn_large( & real(R8) :: gprec ! convective rainfall argument for ugust ! ------------------------------------------------------------------------- - qsat(Tk) = 640380.0_R8 / exp(5107.4_R8/Tk) - ! Large and Yeager 2009 cdn(Umps) = 0.0027_R8 / min(33.0000_R8,Umps) + 0.000142_R8 + & 0.0000764_R8 * min(33.0000_R8,Umps) - 3.14807e-13_r8 * min(33.0000_R8,Umps)**6 From 7442cb213f1e804a2bf119ae0cf7bd2474d4a455 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 17 Oct 2025 20:42:08 +0200 Subject: [PATCH 104/123] another compiler fix --- cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 b/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 index 0c1a62b8e..824d4097a 100644 --- a/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 +++ b/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 @@ -24,6 +24,7 @@ module flux_atmocn_COARE_mod use shr_flux_mod, only : loc_stebol, loc_latvap, loc_g, loc_cpdair use shr_flux_mod, only : td0, maxscl, alpha, use_coldair_outbreak_mod use shr_const_mod, only : shr_const_rgas + use shr_wv_sat_mod, only: shr_wv_sat_qsat_liquid ! use saturation calculation consistent with CAM implicit none private From 4a35ebe2bb74d2503cbb9dc6d40e1a26612759fc Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 19 Oct 2025 11:57:15 +0200 Subject: [PATCH 105/123] addressed issue raised in PR review --- cesm/flux_atmocn/flux_atmocn_driver_mod.F90 | 28 ++++++++++++++------- 1 file changed, 19 insertions(+), 9 deletions(-) diff --git a/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 b/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 index ea9f494d9..86ea6b2b9 100644 --- a/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 +++ b/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 @@ -2,6 +2,8 @@ module flux_atmocn_driver_mod use shr_kind_mod, only : R8=>SHR_KIND_R8, IN=>SHR_KIND_IN ! shared kinds use shr_const_mod, only : shr_const_spval + use shr_sys_mod, only : shr_sys_abort + use shr_strconvert_mod, only : toString use flux_atmocn_Large_mod, only : flux_atmocn_Large use flux_atmocn_COARE_mod, only : flux_atmocn_COARE use flux_atmocn_UA_mod, only : flux_atmocn_UA @@ -9,6 +11,10 @@ module flux_atmocn_driver_mod implicit none public + integer, private, parameter :: ocn_flux_scheme_large_and_pond = 0 + integer, private, parameter :: ocn_flux_scheme_coare = 1 + integer, private, parameter :: ocn_flux_scheme_ua = 2 + contains subroutine flux_atmOcn_driver(logunit, nMax, & @@ -65,20 +71,20 @@ subroutine flux_atmOcn_driver(logunit, nMax, & real(R8) :: spval ! local missing value !-------------------------------------------------------------------------------- - !!................................................................. - !! ocn_surface_flux_scheme = 0 : Large and Pond - !! = 1 : COARE algorithm - !! = 2 : UA algorithm - !!................................................................. - if (present(missval)) then spval = missval else spval = shr_const_spval endif + !!................................................................. + !! ocn_surface_flux_scheme = 0 : Large and Pond + !! = 1 : COARE algorithm + !! = 2 : UA algorithm + !!................................................................. + ! Default flux scheme. - if (ocn_surface_flux_scheme == 0) then + if (ocn_surface_flux_scheme == ocn_flux_scheme_large_and_pond) then call flux_atmOcn_Large( & logunit, spval, nMax, & @@ -91,7 +97,7 @@ subroutine flux_atmOcn_driver(logunit, nMax, & add_gusts, duu10n, ugust_out, u10res, & ustar_sv=ustar_sv, re_sv=re_sv, ssq_sv=ssq_sv) - else if (ocn_surface_flux_scheme == 1) then + else if (ocn_surface_flux_scheme == ocn_flux_scheme_coare) then call flux_atmOcn_COARE( & logunit, spval, nMax, & @@ -104,7 +110,7 @@ subroutine flux_atmOcn_driver(logunit, nMax, & duu10n, ugust_out, u10res, & ustar_sv=ustar_sv, re_sv=re_sv, ssq_sv=ssq_sv) - else if (ocn_surface_flux_scheme == 2) then + else if (ocn_surface_flux_scheme == ocn_flux_scheme_ua) then call flux_atmOcn_UA( & logunit, spval, nMax, & @@ -124,6 +130,10 @@ subroutine flux_atmOcn_driver(logunit, nMax, & end if end do + else + + call shr_sys_abort("ocn_srfuace_flux_scheme = "// toString(ocn_surface_flux_scheme)//" is not supported") + end if end subroutine flux_atmOcn_driver From 4e7bbe42cf9bbf6d91faa19c85107ee78fb55d7f Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 19 Oct 2025 12:42:57 +0200 Subject: [PATCH 106/123] updates for noresm workflows --- .github/workflows/bumpversion.yml | 19 -------- .github/workflows/extbuild.yml | 14 +++--- .github/workflows/srt.yml | 75 ++++++++++++++++++------------- 3 files changed, 52 insertions(+), 56 deletions(-) delete mode 100644 .github/workflows/bumpversion.yml diff --git a/.github/workflows/bumpversion.yml b/.github/workflows/bumpversion.yml deleted file mode 100644 index b17d491f0..000000000 --- a/.github/workflows/bumpversion.yml +++ /dev/null @@ -1,19 +0,0 @@ -name: Bump version -on: - push: - branches: - - main -jobs: - build: - runs-on: ubuntu-latest - steps: - - uses: actions/checkout@v2 - - name: Bump version and push tag - id: tag_version - uses: mathieudutour/github-tag-action@v5.5 - with: - github_token: ${{ secrets.GITHUB_TOKEN }} - create_annotated_tag: true - default_bump: patch - dry_run: false - tag_prefix: cmeps diff --git a/.github/workflows/extbuild.yml b/.github/workflows/extbuild.yml index 86ed1a533..c5569014f 100644 --- a/.github/workflows/extbuild.yml +++ b/.github/workflows/extbuild.yml @@ -5,9 +5,9 @@ name: extbuild # events but only for the main branch on: push: - branches: [ main ] + branches: [ noresm ] pull_request: - branches: [ main ] + branches: [ noresm ] # A workflow run is made up of one or more jobs that can run sequentially or in parallel jobs: @@ -23,8 +23,8 @@ jobs: ESMF_VERSION: v8.8.0 PNETCDF_VERSION: checkpoint.1.14.0 NETCDF_FORTRAN_VERSION: v4.6.1 - PIO_VERSION: pio2_6_4 - CDEPS_VERSION: cdeps1.0.64 + PIO_VERSION: pio2_6_5 + CDEPS_VERSION: cdeps1.0.80 steps: - uses: actions/checkout@v4 # Build the ESMF library, if the cache contains a previous build @@ -75,7 +75,7 @@ jobs: with: path: /homme/runner/work/CMEPS/CMEPS/build-cdeps key: ${{ runner.os }}-${{ env.CDEPS_VERSION }}.cdeps1 - + - name: checkout CDEPS uses: actions/checkout@v4 with: @@ -85,7 +85,7 @@ jobs: - name: get genf90 run: | cd cdeps-src - git submodule update --init + git submodule update --init - name: Build CDEPS if: steps.cache-cdeps.outputs.cache-hit != 'true' uses: ESCOMP/CDEPS/.github/actions/buildcdeps@cdeps1.0.26 @@ -95,7 +95,7 @@ jobs: src_root: ${GITHUB_WORKSPACE}/cdeps-src 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=$HOME/pio diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 2983dea6f..d4c54331e 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -6,9 +6,9 @@ name: scripts regression tests # events but only for the main branch on: push: - branches: [ main ] + branches: [ noresm ] pull_request: - branches: [ main ] + branches: [ noresm ] # A workflow run is made up of one or more jobs that can run sequentially or in parallel jobs: @@ -25,10 +25,10 @@ jobs: FC: mpifort CXX: mpicxx CPPFLAGS: "-I/usr/include -I/usr/local/include " - LDFLAGS: "-L/usr/lib/x86_64-linux-gnu -lnetcdf -lnetcdff -lpnetcdf" + LDFLAGS: "-L/usr/lib/x86_64-linux-gnu -lnetcdf -lnetcdff -lpnetcdf" # Versions of all dependencies can be updated here - ESMF_VERSION: v8.6.1 - PARALLELIO_VERSION: pio2_6_3 + ESMF_VERSION: v8.8.0 + PARALLELIO_VERSION: pio2_6_6 CIME_MODEL: cesm CIME_DRIVER: nuopc GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} @@ -40,9 +40,9 @@ jobs: id: load-env run: | set -x - sudo apt-get update + sudo apt-get update sudo apt-get install libxml2-utils - sudo apt-get install netcdf-bin + sudo apt-get install netcdf-bin sudo apt-get install libnetcdf-dev sudo apt-get install libnetcdff-dev sudo apt-get install pnetcdf-bin @@ -63,30 +63,30 @@ jobs: - run: echo "PyYAML" > requirements.txt - name: Install PyYAML run: pip install -r requirements.txt - # use the latest cesm main - - name: cesm checkout + # use the latest noresm main + - name: noresm checkout uses: actions/checkout@v4 with: - repository: ESCOMP/CESM - path: cesm + repository: NorESMhub/NorESM + path: noresm # this cmeps commit - name: cmeps checkout uses: actions/checkout@v4 with: - path: cesm/components/cmeps - - # Checkout cesm datamodels and support + path: noresm/components/cmeps + + # Checkout noresm datamodels and support # cpl7 is needed - i think that's a bug - name: checkout externals run: | git config --global user.name "${GITHUB_ACTOR}" git config --global user.email "${GITHUB_ACTOR_ID}+${GITHUB_ACTOR}@users.noreply.github.com" - pushd cesm + pushd noresm ./bin/git-fleximod update cime ccs_config cdeps share mct parallelio cd ccs_config - git checkout main + git checkout noresm cd ../cime - git checkout master + git checkout noresm git status if [[ ! -e "${PWD}/.gitmodules.bak" ]] then @@ -96,11 +96,11 @@ jobs: fi git submodule update --init cd ../components/cdeps - git checkout main + git checkout noresm git submodule update --init cd ../../share - git checkout main - + git checkout noresm + - name: Cache ESMF id: cache-esmf uses: actions/cache@v4 @@ -119,17 +119,17 @@ jobs: id: cache-inputdata uses: actions/cache@v4 with: - path: $HOME/cesm/inputdata + path: $HOME/noresm/inputdata key: inputdata - name: Build ParallelIO if: steps.cache-PARALLELIO.outputs.cache-hit != 'true' - uses: NCAR/ParallelIO/.github/actions/parallelio_cmake@05173a6556ea8d80eb34e3881a5014ea8f4b7543 + uses: NCAR/ParallelIO/.github/actions/parallelio_cmake@b38e34eeb9b75ce81ac94daf7c5245931de00b9d with: parallelio_version: ${{ env.ParallelIO_VERSION }} enable_fortran: True install_prefix: ${GITHUB_WORKSPACE}/pio - + - name: Install ESMF uses: esmf-org/install-esmf-action@v1 env: @@ -150,10 +150,10 @@ jobs: - name: PREP for scripts regression test run: | - mkdir -p $HOME/cesm/scratch - mkdir -p $HOME/cesm/inputdata - pushd $GITHUB_WORKSPACE/cesm/cime/CIME/tests - export SRCROOT=$GITHUB_WORKSPACE/cesm/ + mkdir -p $HOME/noresm/scratch + mkdir -p $HOME/noresm/inputdata + pushd $GITHUB_WORKSPACE/noresm/cime/CIME/tests + export SRCROOT=$GITHUB_WORKSPACE/noresm/ export CIME_TEST_PLATFORM=ubuntu-latest export PIO_INCDIR=$GITHUB_WORKSPACE/pio/include export PIO_LIBDIR=$GITHUB_WORKSPACE/pio/lib @@ -162,7 +162,7 @@ jobs: export NETCDF_PATH=/usr export PNETCDF_PATH=/usr export LD_LIBRARY_PATH=/usr/lib/libx86_64-linux-gnu/:$LD_LIBRARY_PATH - cat <> $GITHUB_WORKSPACE/cesm/ccs_config/machines/cmake_macros/ubuntu-latest.cmake + cat <> $GITHUB_WORKSPACE/noresm/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) EOF @@ -170,9 +170,24 @@ jobs: popd - name: scripts regression tests run: | - pushd $GITHUB_WORKSPACE/cesm/cime/CIME/tests - ./scripts_regression_tests.py --no-fortran-run --compiler gnu --mpilib openmpi --machine ubuntu-latest + pushd $GITHUB_WORKSPACE/noresm/cime/CIME/tests + ./scripts_regression_tests.py --no-fortran-run --compiler gnu --mpilib openmpi --machine ubuntu-latest --no-teardown popd + + # How to download artifacts: + # https://docs.github.com/en/actions/managing-workflow-runs/downloading-workflow-artifacts + +# - name: Upload test logs +# if: ${{ failure() }} +# steps: +# - name: Tar test logs +# run: tar zcf scratch-${{ matrix.python-version }}.tar.gz /home/runner/noresm/scratch +# - name: save artifact +# uses: actions/upload-artifact@v4 +# with: +# name: test-logs-${{ matrix.python-version }} +# path: scratch-${{ matrix.python-version }}.tar.gz +# retention-days: 4 # the following can be used by developers to login to the github server in case of errors # see https://github.com/marketplace/actions/debugging-with-tmate for further details # - name: Setup tmate session From 578607ab3d8830e56e69cf67e6cbd06726cef5d1 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 19 Oct 2025 14:15:27 +0200 Subject: [PATCH 107/123] changed comment --- mediator/med_phases_restart_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mediator/med_phases_restart_mod.F90 b/mediator/med_phases_restart_mod.F90 index 5b7f28bc3..4dc72c43a 100644 --- a/mediator/med_phases_restart_mod.F90 +++ b/mediator/med_phases_restart_mod.F90 @@ -457,7 +457,7 @@ subroutine med_phases_restart_write(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - ! Write ocn albedo field bundle (CESM only) + ! Write ocn albedo field bundle (CESM/NorESM only) if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o,rc=rc)) then nx = is_local%wrap%nx(compocn) ny = is_local%wrap%ny(compocn) From 38e4c74902dc18dfa89302d9567751de4c95f5bd Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 19 Oct 2025 14:17:11 +0200 Subject: [PATCH 108/123] fixed typo --- cesm/flux_atmocn/flux_atmocn_driver_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 b/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 index 86ea6b2b9..82a2b97d8 100644 --- a/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 +++ b/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 @@ -54,7 +54,7 @@ subroutine flux_atmOcn_driver(logunit, nMax, & real(R8),intent(out) :: lwup (nMax) ! heat flux: lw upward (W/m^2) real(R8),intent(out) :: evap (nMax) ! water flux: evap ((kg/s)/m^2) real(R8),intent(out) :: taux (nMax) ! surface stress, zonal (N) - real(R8),intent(out) :: tauy (nMax) ! surface stress, maridional (N) + real(R8),intent(out) :: tauy (nMax) ! surface stress, meridional (N) real(R8),intent(out) :: tref (nMax) ! diag: 2m ref height T (K) real(R8),intent(out) :: qref (nMax) ! diag: 2m ref humidity (kg/kg) real(R8),intent(out) :: duu10n(nMax) ! diag: 10m wind speed squared (m/s)^2 From bc50b6df2dbb7a1dce2c3c701e60df8a0767c3ce Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 19 Oct 2025 14:18:49 +0200 Subject: [PATCH 109/123] fixed comment --- cesm/flux_atmocn/flux_atmocn_driver_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 b/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 index 86ea6b2b9..82a2b97d8 100644 --- a/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 +++ b/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 @@ -54,7 +54,7 @@ subroutine flux_atmOcn_driver(logunit, nMax, & real(R8),intent(out) :: lwup (nMax) ! heat flux: lw upward (W/m^2) real(R8),intent(out) :: evap (nMax) ! water flux: evap ((kg/s)/m^2) real(R8),intent(out) :: taux (nMax) ! surface stress, zonal (N) - real(R8),intent(out) :: tauy (nMax) ! surface stress, maridional (N) + real(R8),intent(out) :: tauy (nMax) ! surface stress, meridional (N) real(R8),intent(out) :: tref (nMax) ! diag: 2m ref height T (K) real(R8),intent(out) :: qref (nMax) ! diag: 2m ref humidity (kg/kg) real(R8),intent(out) :: duu10n(nMax) ! diag: 10m wind speed squared (m/s)^2 From 1a9153bcff7f490d75fb5e141d819f2ad0cfb1b1 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 19 Oct 2025 14:29:48 +0200 Subject: [PATCH 110/123] minor formatting change --- cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 b/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 index 8ec49ebd5..824d4097a 100644 --- a/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 +++ b/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 @@ -144,6 +144,7 @@ subroutine flux_atmOcn_COARE( & vmag=vmag*vscl endif endif + call shr_wv_sat_qsat_liquid(ts(n), pslv(n), qsat, ssq) ssq = 0.98_R8 * ssq ! sea surf hum (kg/kg) From ed805ef26dde04b5979cbfe82f9079e704f26b3a Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 20 Oct 2025 10:24:38 +0200 Subject: [PATCH 111/123] update for history --- mediator/med_phases_history_mod.F90 | 77 ++++++++++------------------- 1 file changed, 27 insertions(+), 50 deletions(-) diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index b41aae099..5f3bba1e7 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -13,12 +13,12 @@ module med_phases_history_mod use ESMF , only : ESMF_Alarm, ESMF_AlarmIsRinging, ESMF_AlarmRingerOff, ESMF_AlarmGet use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO - use ESMF , only : ESMF_SUCCESS, ESMF_MAXSTR, ESMF_LOGERR_PASSTHRU + use ESMF , only : ESMF_SUCCESS, ESMF_MAXSTR, ESMF_LOGERR_PASSTHRU, ESMF_END_ABORT use ESMF , only : operator(-), operator(+) use NUOPC , only : NUOPC_CompAttributeGet use NUOPC_Model , only : NUOPC_ModelGet use med_utils_mod , only : chkerr => med_utils_ChkErr - use med_internalstate_mod , only : ncomps, compname, compocn, complnd + use med_internalstate_mod , only : ncomps, compname use med_internalstate_mod , only : InternalState, maintask, logunit use med_io_mod , only : med_io_write, med_io_wopen, med_io_enddef, med_io_close use perf_mod , only : t_startf, t_stopf @@ -34,13 +34,9 @@ module med_phases_history_mod public :: med_phases_history_write ! inst only - for all variables ! Public routines called from post phases - public :: med_phases_history_write_comp ! inst, avg, aux for component - public :: med_phases_history_write_med ! inst only, med aoflux and ocn albedoes - public :: med_phases_history_write_data2glc ! inst only, average (normally yearly) of - ! implnd->glc (on land grid), - ! impocn->glc (on ocn grid) and - ! inst only, average (normally yearly) of - ! export->glc (on glc grid) + public :: med_phases_history_write_comp ! inst, avg, aux for component + public :: med_phases_history_write_med ! inst only, med aoflux and ocn albedoes + public :: med_phases_history_write_lnd2glc ! inst only, yearly average of lnd->glc data on lnd grid ! Private routines private :: med_phases_history_write_comp_inst ! write instantaneous file for a given component @@ -533,21 +529,20 @@ subroutine med_phases_history_write_med(gcomp, rc) end subroutine med_phases_history_write_med !=============================================================================== - subroutine med_phases_history_write_data2glc(gcomp, fldbun_import, comp_import, fldbun_export, rc) + subroutine med_phases_history_write_lnd2glc(gcomp, fldbun_lnd, rc, fldbun_glc) ! Write yearly average of lnd -> glc fields on both land and glc grids - use med_internalstate_mod , only : compglc - use med_constants_mod , only : SecPerDay => med_constants_SecPerDay - use med_io_mod , only : med_io_write_time, med_io_define_time - use med_io_mod , only : med_io_date2yyyymmdd, med_io_sec2hms, med_io_ymd2date + use med_internalstate_mod, only : complnd, compglc + use med_constants_mod , only : SecPerDay => med_constants_SecPerDay + use med_io_mod , only : med_io_write_time, med_io_define_time + use med_io_mod , only : med_io_date2yyyymmdd, med_io_sec2hms, med_io_ymd2date ! input/output variables - type(ESMF_GridComp) , intent(in) :: gcomp - type(ESMF_FieldBundle) , optional , intent(in) :: fldbun_import ! land or ocean import field bundle - integer , optional , intent(in) :: comp_import ! either land or ocean component id - type(ESMF_FieldBundle) , optional , intent(in) :: fldbun_export(:) ! export field bundle array - integer , intent(out) :: rc + type(ESMF_GridComp) , intent(in) :: gcomp + type(ESMF_FieldBundle) , intent(in) :: fldbun_lnd + integer , intent(out) :: rc + type(ESMF_FieldBundle) , intent(in), optional :: fldbun_glc(:) ! local variables type(file_desc_t) :: io_file @@ -568,7 +563,7 @@ subroutine med_phases_history_write_data2glc(gcomp, fldbun_import, comp_import, character(len=CL) :: hist_file integer :: m,n logical :: isPresent - character(len=*), parameter :: subname='(med_phases_history_write_data2glc)' + character(len=*), parameter :: subname='(med_phases_history_write_lnd2glc)' !--------------------------------------- rc = ESMF_SUCCESS @@ -619,28 +614,15 @@ subroutine med_phases_history_write_data2glc(gcomp, fldbun_import, comp_import, call ESMF_TimeGet(nexttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return write(nexttime_str,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + write(hist_file, "(6a)") trim(case_name),'.cpl',trim(inst_tag),'.hx.1yr2glc.',trim(nexttime_str),'.nc' - if (present(comp_import)) then - if (.not. present(fldbun_import)) then - call shr_log_error(subname//'if comp_import is present, then fldbun_import must be present', rc=rc) - return - end if - if (comp_import == complnd) then - write(hist_file, "(6a)") trim(case_name),'.cpl',trim(inst_tag),'.hx.lnd2glc.',trim(nexttime_str),'.nc' - else if (comp_import == compocn) then - write(hist_file, "(6a)") trim(case_name),'.cpl',trim(inst_tag),'.hx.ocn2glc.',trim(nexttime_str),'.nc' - end if - else - write(hist_file, "(6a)") trim(case_name),'.cpl',trim(inst_tag),'.hx.exp2glc.',trim(nexttime_str),'.nc' - end if - - ! Open output file + ! Create history file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call med_io_wopen(hist_file, io_file, vm, rc, clobber=.true.) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Write data to file + ! Write data to history file do m = 1,2 if (whead(m)) then call ESMF_ClockGet(clock, calendar=calendar, rc=rc) @@ -653,23 +635,18 @@ subroutine med_phases_history_write_data2glc(gcomp, fldbun_import, comp_import, if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - if (present(fldbun_import)) then - ! import field bundle - call med_io_write(io_file, fldbun_import, whead(m), wdata(m), & - is_local%wrap%nx(comp_import), is_local%wrap%ny(comp_import), & - nt=1, pre=trim(compname(comp_import))//'Imp', rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else if (present(fldbun_export)) then - ! export field bundle - do n = 1,size(fldbun_export) - call med_io_write(io_file, fldbun_export(n), whead(m), wdata(m), & + call med_io_write(io_file, fldbun_lnd, whead(m), wdata(m), & + is_local%wrap%nx(complnd), is_local%wrap%ny(complnd), & + nt=1, pre=trim(compname(complnd))//'Imp', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (present(fldbun_glc)) then + do n = 1,size(fldbun_glc) + call med_io_write(io_file, fldbun_glc(n), whead(m), wdata(m), & is_local%wrap%nx(compglc(n)), is_local%wrap%ny(compglc(n)), & nt=1, pre=trim(compname(compglc(n)))//'Exp', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end do - else - call shr_log_error(subname//'either fldbun_import or fldbun_export must be present as arguments', rc=rc) - return end if end do ! end of loop over m @@ -678,7 +655,7 @@ subroutine med_phases_history_write_data2glc(gcomp, fldbun_import, comp_import, call med_io_close(io_file, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - end subroutine med_phases_history_write_data2glc + end subroutine med_phases_history_write_lnd2glc !=============================================================================== subroutine med_phases_history_write_comp(gcomp, compid, rc) From 9d636ecba9e015bef84ffdd654e951c3a4188ac4 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Mon, 20 Oct 2025 07:36:21 -0600 Subject: [PATCH 112/123] uncomment tmate to debug workflow --- .github/workflows/srt.yml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index d4c54331e..ebc3c8b29 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -27,7 +27,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.8.0 + ESMF_VERSION: v8.9.0 PARALLELIO_VERSION: pio2_6_6 CIME_MODEL: cesm CIME_DRIVER: nuopc @@ -190,6 +190,6 @@ jobs: # retention-days: 4 # the following can be used by developers to login to the github server in case of errors # see https://github.com/marketplace/actions/debugging-with-tmate for further details -# - name: Setup tmate session -# if: ${{ failure() }} -# uses: mxschmitt/action-tmate@v3 + - name: Setup tmate session + if: ${{ failure() }} + uses: mxschmitt/action-tmate@v3 From e9c9d564329ab7a639901d4c5382d8388b64d673 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Mon, 20 Oct 2025 07:38:52 -0600 Subject: [PATCH 113/123] uncomment tmate to debug workflow --- .github/workflows/srt.yml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 751b8d118..3afe2b7d1 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -190,6 +190,6 @@ jobs: # retention-days: 4 # the following can be used by developers to login to the github server in case of errors # see https://github.com/marketplace/actions/debugging-with-tmate for further details -# - name: Setup tmate session -# if: ${{ failure() }} -# uses: mxschmitt/action-tmate@v3 + - name: Setup tmate session + if: ${{ failure() }} + uses: mxschmitt/action-tmate@v3 From 801f2a2a04d943f4ada9ec6b171deed585637367 Mon Sep 17 00:00:00 2001 From: Michael Levy Date: Mon, 20 Oct 2025 14:34:57 -0600 Subject: [PATCH 114/123] Add one more barrier at end of run In CESM we ran into a funny issue where the ocean component was taking significantly longer to write output at the end of the run than the other components, and somehow the other components convinced the mediator that the model had finished successfully even though the ocean component was still doing stuff. This barrier makes everyone wait to catch up. --- cesm/driver/esm.F90 | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/cesm/driver/esm.F90 b/cesm/driver/esm.F90 index b2400a3ef..9a7bbf783 100644 --- a/cesm/driver/esm.F90 +++ b/cesm/driver/esm.F90 @@ -9,7 +9,7 @@ module ESM use shr_mem_mod , only : shr_mem_init use shr_log_mod , only : shr_log_setLogunit, shr_log_error use esm_utils_mod, only : logunit, maintask, dbug_flag, chkerr - use esmf , only : ESMF_FAILURE + use esmf , only : ESMF_FAILURE, ESMF_VMBARRIER implicit none private @@ -1557,6 +1557,9 @@ subroutine esm_finalize(driver, rc) call ESMF_VMGet(vm, mpiCommunicator=mpicomm, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMBarrier(vm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(driver, name="timing_dir",value=timing_dir, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return From 161b084041eb3043741795350be48f3e37bacdaa Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 21 Oct 2025 18:13:29 +0200 Subject: [PATCH 115/123] backed out changes for noresm --- cesm/nuopc_cap_share/shr_megan_mod.F90 | 12 ++-- mediator/med_phases_history_mod.F90 | 98 +++++++++++++++----------- 2 files changed, 62 insertions(+), 48 deletions(-) diff --git a/cesm/nuopc_cap_share/shr_megan_mod.F90 b/cesm/nuopc_cap_share/shr_megan_mod.F90 index d26b85814..57a218dd7 100644 --- a/cesm/nuopc_cap_share/shr_megan_mod.F90 +++ b/cesm/nuopc_cap_share/shr_megan_mod.F90 @@ -43,13 +43,13 @@ module shr_megan_mod integer :: index real(r8), pointer :: emis_factors(:) ! function of plant-function-type (PFT) integer :: class_number ! MEGAN class number + real(r8) :: coeff ! emissions component coeffecient real(r8) :: molec_weight ! molecular weight of the MEGAN compound (g/mole) type(shr_megan_megcomp_t), pointer :: next_megcomp ! points to next member in the linked list endtype shr_megan_megcomp_t type shr_megan_comp_ptr - type(shr_megan_megcomp_t), pointer :: ptr - real(r8) :: coeff ! emissions component coeffecient + type(shr_megan_megcomp_t), pointer :: ptr endtype shr_megan_comp_ptr ! chemical compound in CAM mechanism that has MEGAN emissions @@ -227,8 +227,7 @@ subroutine shr_megan_init( specifier) if (localPet==0) write(logunit,*) ' species : ', item%name do j = 1,item%n_terms if (localPet==0) write(logunit,'(f12.4,a,a)') item%coeffs(j),' * ', item%vars(j) - shr_megan_mechcomps(i)%megan_comps(j)%ptr => add_megan_comp( item%vars(j) ) - shr_megan_mechcomps(i)%megan_comps(j)%coeff = item%coeffs(j) + shr_megan_mechcomps(i)%megan_comps(j)%ptr => add_megan_comp( item%vars(j), item%coeffs(j) ) enddo shr_megan_mechcomps_n = shr_megan_mechcomps_n+1 @@ -244,9 +243,10 @@ end subroutine shr_megan_init !------------------------------------------------------------------------- - function add_megan_comp( name ) result(megan_comp) + function add_megan_comp( name, coeff ) result(megan_comp) character(len=16), intent(in) :: name + real(r8), intent(in) :: coeff type(shr_megan_megcomp_t), pointer :: megan_comp megan_comp => get_megan_comp_by_name(shr_megan_linkedlist, name) @@ -264,7 +264,7 @@ function add_megan_comp( name ) result(megan_comp) megan_comp%index = shr_megan_megcomps_n+1 megan_comp%name = trim(name) - + megan_comp%coeff = coeff nullify(megan_comp%next_megcomp) call add_megan_comp_to_list(megan_comp) diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 5f3bba1e7..3cd0b4fb2 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -13,12 +13,12 @@ module med_phases_history_mod use ESMF , only : ESMF_Alarm, ESMF_AlarmIsRinging, ESMF_AlarmRingerOff, ESMF_AlarmGet use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO - use ESMF , only : ESMF_SUCCESS, ESMF_MAXSTR, ESMF_LOGERR_PASSTHRU, ESMF_END_ABORT + use ESMF , only : ESMF_SUCCESS, ESMF_MAXSTR, ESMF_LOGERR_PASSTHRU use ESMF , only : operator(-), operator(+) use NUOPC , only : NUOPC_CompAttributeGet use NUOPC_Model , only : NUOPC_ModelGet use med_utils_mod , only : chkerr => med_utils_ChkErr - use med_internalstate_mod , only : ncomps, compname + use med_internalstate_mod , only : ncomps, compname, compocn, complnd use med_internalstate_mod , only : InternalState, maintask, logunit use med_io_mod , only : med_io_write, med_io_wopen, med_io_enddef, med_io_close use perf_mod , only : t_startf, t_stopf @@ -34,9 +34,13 @@ module med_phases_history_mod public :: med_phases_history_write ! inst only - for all variables ! Public routines called from post phases - public :: med_phases_history_write_comp ! inst, avg, aux for component - public :: med_phases_history_write_med ! inst only, med aoflux and ocn albedoes - public :: med_phases_history_write_lnd2glc ! inst only, yearly average of lnd->glc data on lnd grid + public :: med_phases_history_write_comp ! inst, avg, aux for component + public :: med_phases_history_write_med ! inst only, med aoflux and ocn albedoes + public :: med_phases_history_write_data2glc ! inst only, average (normally yearly) of + ! implnd->glc (on land grid), + ! impocn->glc (on ocn grid) and + ! inst only, average (normally yearly) of + ! export->glc (on glc grid) ! Private routines private :: med_phases_history_write_comp_inst ! write instantaneous file for a given component @@ -268,20 +272,14 @@ subroutine med_phases_history_write(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeGet(currtime,yy=yr, mm=mon, dd=day, s=sec, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if(yr .le. 9999) then - write(currtimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec - else - write(currtimestr,'(i6.6,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec - endif + write(currtimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + call ESMF_ClockGetNextTime(mclock, nextTime=nexttime, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeGet(nexttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if(yr .le. 9999) then - write(nexttimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec - else - write(nexttimestr,'(i6.6,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec - endif + write(nexttimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + if (maintask) then write(logunit,*) write(logunit,'(a,i8)') trim(subname)//" : history alarmname "//trim(alarmname)//& @@ -529,20 +527,21 @@ subroutine med_phases_history_write_med(gcomp, rc) end subroutine med_phases_history_write_med !=============================================================================== - subroutine med_phases_history_write_lnd2glc(gcomp, fldbun_lnd, rc, fldbun_glc) + subroutine med_phases_history_write_data2glc(gcomp, fldbun_import, comp_import, fldbun_export, rc) ! Write yearly average of lnd -> glc fields on both land and glc grids - use med_internalstate_mod, only : complnd, compglc - use med_constants_mod , only : SecPerDay => med_constants_SecPerDay - use med_io_mod , only : med_io_write_time, med_io_define_time - use med_io_mod , only : med_io_date2yyyymmdd, med_io_sec2hms, med_io_ymd2date + use med_internalstate_mod , only : compglc + use med_constants_mod , only : SecPerDay => med_constants_SecPerDay + use med_io_mod , only : med_io_write_time, med_io_define_time + use med_io_mod , only : med_io_date2yyyymmdd, med_io_sec2hms, med_io_ymd2date ! input/output variables - type(ESMF_GridComp) , intent(in) :: gcomp - type(ESMF_FieldBundle) , intent(in) :: fldbun_lnd - integer , intent(out) :: rc - type(ESMF_FieldBundle) , intent(in), optional :: fldbun_glc(:) + type(ESMF_GridComp) , intent(in) :: gcomp + type(ESMF_FieldBundle) , optional , intent(in) :: fldbun_import ! land or ocean import field bundle + integer , optional , intent(in) :: comp_import ! either land or ocean component id + type(ESMF_FieldBundle) , optional , intent(in) :: fldbun_export(:) ! export field bundle array + integer , intent(out) :: rc ! local variables type(file_desc_t) :: io_file @@ -563,7 +562,7 @@ subroutine med_phases_history_write_lnd2glc(gcomp, fldbun_lnd, rc, fldbun_glc) character(len=CL) :: hist_file integer :: m,n logical :: isPresent - character(len=*), parameter :: subname='(med_phases_history_write_lnd2glc)' + character(len=*), parameter :: subname='(med_phases_history_write_data2glc)' !--------------------------------------- rc = ESMF_SUCCESS @@ -614,15 +613,28 @@ subroutine med_phases_history_write_lnd2glc(gcomp, fldbun_lnd, rc, fldbun_glc) call ESMF_TimeGet(nexttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return write(nexttime_str,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec - write(hist_file, "(6a)") trim(case_name),'.cpl',trim(inst_tag),'.hx.1yr2glc.',trim(nexttime_str),'.nc' - ! Create history file + if (present(comp_import)) then + if (.not. present(fldbun_import)) then + call shr_log_error(subname//'if comp_import is present, then fldbun_import must be present', rc=rc) + return + end if + if (comp_import == complnd) then + write(hist_file, "(6a)") trim(case_name),'.cpl',trim(inst_tag),'.hx.lnd2glc.',trim(nexttime_str),'.nc' + else if (comp_import == compocn) then + write(hist_file, "(6a)") trim(case_name),'.cpl',trim(inst_tag),'.hx.ocn2glc.',trim(nexttime_str),'.nc' + end if + else + write(hist_file, "(6a)") trim(case_name),'.cpl',trim(inst_tag),'.hx.exp2glc.',trim(nexttime_str),'.nc' + end if + + ! Open output file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call med_io_wopen(hist_file, io_file, vm, rc, clobber=.true.) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Write data to history file + ! Write data to file do m = 1,2 if (whead(m)) then call ESMF_ClockGet(clock, calendar=calendar, rc=rc) @@ -635,18 +647,23 @@ subroutine med_phases_history_write_lnd2glc(gcomp, fldbun_lnd, rc, fldbun_glc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - call med_io_write(io_file, fldbun_lnd, whead(m), wdata(m), & - is_local%wrap%nx(complnd), is_local%wrap%ny(complnd), & - nt=1, pre=trim(compname(complnd))//'Imp', rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - if (present(fldbun_glc)) then - do n = 1,size(fldbun_glc) - call med_io_write(io_file, fldbun_glc(n), whead(m), wdata(m), & + if (present(fldbun_import)) then + ! import field bundle + call med_io_write(io_file, fldbun_import, whead(m), wdata(m), & + is_local%wrap%nx(comp_import), is_local%wrap%ny(comp_import), & + nt=1, pre=trim(compname(comp_import))//'Imp', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else if (present(fldbun_export)) then + ! export field bundle + do n = 1,size(fldbun_export) + call med_io_write(io_file, fldbun_export(n), whead(m), wdata(m), & is_local%wrap%nx(compglc(n)), is_local%wrap%ny(compglc(n)), & nt=1, pre=trim(compname(compglc(n)))//'Exp', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end do + else + call shr_log_error(subname//'either fldbun_import or fldbun_export must be present as arguments', rc=rc) + return end if end do ! end of loop over m @@ -655,7 +672,7 @@ subroutine med_phases_history_write_lnd2glc(gcomp, fldbun_lnd, rc, fldbun_glc) call med_io_close(io_file, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - end subroutine med_phases_history_write_lnd2glc + end subroutine med_phases_history_write_data2glc !=============================================================================== subroutine med_phases_history_write_comp(gcomp, compid, rc) @@ -1787,11 +1804,8 @@ subroutine med_phases_history_set_timeinfo(gcomp, hclock, alarmname, & call ESMF_TimeGet(nexttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if(yr .le. 9999) then - write(nexttime_str,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec - else - write(nexttime_str,'(i6.6,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec - endif + write(nexttime_str,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + if (trim(case_name) == 'unset') then call NUOPC_CompAttributeGet(gcomp, name='case_name', value=case_name, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return From 3489aefe24a0063c8a0b100a6703de76703b99b4 Mon Sep 17 00:00:00 2001 From: Chris Fischer Date: Fri, 24 Oct 2025 22:51:07 -0600 Subject: [PATCH 116/123] Fix ERR test. --- cime_config/namelist_definition_drv.xml | 1 + 1 file changed, 1 insertion(+) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 313b7f2ad..98851c7e3 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -2861,6 +2861,7 @@ .false. .false. .false. + .false. From ff9320571a09166b82bea6ed1ef0893af4f5947d Mon Sep 17 00:00:00 2001 From: mvertens Date: Fri, 31 Oct 2025 11:12:44 +0100 Subject: [PATCH 117/123] updated shr_megan_mod.F90 to cmeps1.1.23 --- cesm/nuopc_cap_share/shr_megan_mod.F90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/cesm/nuopc_cap_share/shr_megan_mod.F90 b/cesm/nuopc_cap_share/shr_megan_mod.F90 index 57a218dd7..d26b85814 100644 --- a/cesm/nuopc_cap_share/shr_megan_mod.F90 +++ b/cesm/nuopc_cap_share/shr_megan_mod.F90 @@ -43,13 +43,13 @@ module shr_megan_mod integer :: index real(r8), pointer :: emis_factors(:) ! function of plant-function-type (PFT) integer :: class_number ! MEGAN class number - real(r8) :: coeff ! emissions component coeffecient real(r8) :: molec_weight ! molecular weight of the MEGAN compound (g/mole) type(shr_megan_megcomp_t), pointer :: next_megcomp ! points to next member in the linked list endtype shr_megan_megcomp_t type shr_megan_comp_ptr - type(shr_megan_megcomp_t), pointer :: ptr + type(shr_megan_megcomp_t), pointer :: ptr + real(r8) :: coeff ! emissions component coeffecient endtype shr_megan_comp_ptr ! chemical compound in CAM mechanism that has MEGAN emissions @@ -227,7 +227,8 @@ subroutine shr_megan_init( specifier) if (localPet==0) write(logunit,*) ' species : ', item%name do j = 1,item%n_terms if (localPet==0) write(logunit,'(f12.4,a,a)') item%coeffs(j),' * ', item%vars(j) - shr_megan_mechcomps(i)%megan_comps(j)%ptr => add_megan_comp( item%vars(j), item%coeffs(j) ) + shr_megan_mechcomps(i)%megan_comps(j)%ptr => add_megan_comp( item%vars(j) ) + shr_megan_mechcomps(i)%megan_comps(j)%coeff = item%coeffs(j) enddo shr_megan_mechcomps_n = shr_megan_mechcomps_n+1 @@ -243,10 +244,9 @@ end subroutine shr_megan_init !------------------------------------------------------------------------- - function add_megan_comp( name, coeff ) result(megan_comp) + function add_megan_comp( name ) result(megan_comp) character(len=16), intent(in) :: name - real(r8), intent(in) :: coeff type(shr_megan_megcomp_t), pointer :: megan_comp megan_comp => get_megan_comp_by_name(shr_megan_linkedlist, name) @@ -264,7 +264,7 @@ function add_megan_comp( name, coeff ) result(megan_comp) megan_comp%index = shr_megan_megcomps_n+1 megan_comp%name = trim(name) - megan_comp%coeff = coeff + nullify(megan_comp%next_megcomp) call add_megan_comp_to_list(megan_comp) From a6505ae928e3df04ef315e563290d68f35069dfb Mon Sep 17 00:00:00 2001 From: mvertens Date: Sat, 1 Nov 2025 14:36:06 +0100 Subject: [PATCH 118/123] backed out cmeps1.1.23 changes to flux_atmocn_COARE_mod.F90 and flux_atmocn_Large.F90 --- cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 | 8 ++++---- cesm/flux_atmocn/flux_atmocn_Large.F90 | 6 +++--- 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 b/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 index 824d4097a..e98e79aea 100644 --- a/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 +++ b/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 @@ -24,7 +24,6 @@ module flux_atmocn_COARE_mod use shr_flux_mod, only : loc_stebol, loc_latvap, loc_g, loc_cpdair use shr_flux_mod, only : td0, maxscl, alpha, use_coldair_outbreak_mod use shr_const_mod, only : shr_const_rgas - use shr_wv_sat_mod, only: shr_wv_sat_qsat_liquid ! use saturation calculation consistent with CAM implicit none private @@ -116,6 +115,9 @@ subroutine flux_atmOcn_COARE( & real(R8) :: tdiff(nMax) ! tbot - ts real(R8) :: vscl + !--- functions --- + qsat(Tk) = 640380.0_R8 / exp(5107.4_R8/Tk) + !--- formats ---------------------------------------- character(*),parameter :: subName = '(flux_atmOcn_COARE) ' character(*),parameter :: F00 = "('(flux_atmOcn_COARE) ',4a)" @@ -144,9 +146,7 @@ subroutine flux_atmOcn_COARE( & vmag=vmag*vscl endif endif - - call shr_wv_sat_qsat_liquid(ts(n), pslv(n), qsat, ssq) - ssq = 0.98_R8 * ssq ! sea surf hum (kg/kg) + ssq = 0.98_R8 * qsat(ts(n)) / rbot(n) ! sea surf hum (kg/kg) call cor30a(ubot(n),vbot(n),tbot(n),qbot(n),rbot(n), & ! in atm params us(n),vs(n),ts(n),ssq, & ! in surf params diff --git a/cesm/flux_atmocn/flux_atmocn_Large.F90 b/cesm/flux_atmocn/flux_atmocn_Large.F90 index d58d512ba..8bfedaa9b 100644 --- a/cesm/flux_atmocn/flux_atmocn_Large.F90 +++ b/cesm/flux_atmocn/flux_atmocn_Large.F90 @@ -25,7 +25,6 @@ module flux_atmOcn_large_mod use shr_flux_mod, only: flux_con_tol, flux_con_max_iter use shr_flux_mod, only: alpha, maxscl, td0 use shr_sys_mod, only: shr_sys_abort - use shr_wv_sat_mod, only: shr_wv_sat_qsat_liquid ! use saturation calculation consistent with CAM implicit none public @@ -143,6 +142,8 @@ subroutine flux_atmOcn_large( & real(R8) :: gprec ! convective rainfall argument for ugust ! ------------------------------------------------------------------------- + qsat(Tk) = 640380.0_R8 / exp(5107.4_R8/Tk) + ! Large and Yeager 2009 cdn(Umps) = 0.0027_R8 / min(33.0000_R8,Umps) + 0.000142_R8 + & 0.0000764_R8 * min(33.0000_R8,Umps) - 3.14807e-13_r8 * min(33.0000_R8,Umps)**6 @@ -208,8 +209,7 @@ subroutine flux_atmOcn_large( & endif endif - call shr_wv_sat_qsat_liquid(ts(n), pslv(n), qsat, ssq) - ssq = 0.98_R8 * ssq ! sea surf hum (kg/kg) + ssq = 0.98_R8 * qsat(ts(n)) / rbot(n) ! sea surf hum (kg/kg) delt = thbot(n) - ts(n) ! pot temp diff (K) delq = qbot(n) - ssq ! spec hum dif (kg/kg) alz = log(zbot(n)/zref) From 36e7fa8ed6f0307948eb3efa6c6b53fac471ca9b Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sat, 1 Nov 2025 20:21:13 +0100 Subject: [PATCH 119/123] removed unused variable is --- mediator/med_diag_mod.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index e07898624..85edea7c0 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -1751,7 +1751,7 @@ subroutine med_diag_print_atm(data, ip, date, tod) integer , intent(in) :: tod ! local variables - integer :: ic,nf,is ! data array indicies + integer :: ic,nf ! data array indicies integer :: ica,icl integer :: icn,ics,ico character(len=40) :: str ! string @@ -1873,7 +1873,7 @@ subroutine med_diag_print_lnd_ice_ocn(data, ip, date, tod) integer , intent(in) :: tod ! local variables - integer :: ic,nf,is ! data array indicies + integer :: ic,nf ! data array indicies integer :: icar,icas integer :: icxs,icxr character(len=40) :: str ! string @@ -1980,7 +1980,7 @@ subroutine med_diag_print_summary(data, ip, date, tod) integer , intent(in) :: tod ! local variables - integer :: nf,is ! data array indicies + integer :: nf ! data array index real(r8) :: atm_area, lnd_area, ocn_area real(r8) :: ice_area_nh, ice_area_sh real(r8) :: sum_area From e02828dd9a7ad6f4bc6ad5324ed3e5834aa87fef Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sat, 1 Nov 2025 20:40:47 +0100 Subject: [PATCH 120/123] removed unused variable --- mediator/med_phases_ocnalb_mod.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/mediator/med_phases_ocnalb_mod.F90 b/mediator/med_phases_ocnalb_mod.F90 index 39d6b6eea..25c691ca1 100644 --- a/mediator/med_phases_ocnalb_mod.F90 +++ b/mediator/med_phases_ocnalb_mod.F90 @@ -105,7 +105,6 @@ subroutine med_phases_ocnalb_init(gcomp, ocnalb, rc) logical :: use_min_ocnalb logical :: isPresent, isSet integer :: fieldCount - character(CL) :: msg type(ESMF_Field), pointer :: fieldlist(:) character(*), parameter :: subname = '(med_phases_ocnalb_init) ' !----------------------------------------------------------------------- From 1a04ba119e4e6473a961e55929907947f99f357e Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sat, 1 Nov 2025 21:02:57 +0100 Subject: [PATCH 121/123] removed unused variable --- mediator/med_phases_prep_atm_mod.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index 0f031831a..b9665f5a8 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -288,7 +288,6 @@ subroutine med_phases_prep_atm_enthalpy_correction (gcomp, hcorr, rc) type(InternalState) :: is_local integer :: n real(r8) :: local_htot_corr(1) - real(r8) :: local_hrof_corr(1) type(ESMF_VM) :: vm !--------------------------------------- From 0f14d678a35ba3cd23357b4abd9547e6a9e505a7 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 4 Nov 2025 17:40:50 +0100 Subject: [PATCH 122/123] made Taylor the default scheme for the ocean albedo calculation for NorESM --- cime_config/namelist_definition_drv.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index e5c96c77e..015169a92 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -934,7 +934,7 @@ 1 : Taylor et al. (1996) - 0 + 1 From b9abe257043306a408ffe2d49006bb627898c95b Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 28 Nov 2025 12:50:43 +0100 Subject: [PATCH 123/123] added new timers in mapping --- mediator/med_map_mod.F90 | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index a3d50c5e4..daacdd4af 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -1045,6 +1045,7 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, use_data, field_ ! For mapconsf_uv3d do not use packed field bundles call med_map_uv_cart3d(FBsrc, FBdst, routehandles, mapconsf_uv3d, map_stress=.true., rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + else ! ----------------------------------- @@ -1314,6 +1315,7 @@ subroutine med_map_field_normalized(field_src, field_dst, routehandles, maptype, character(len=*), parameter :: subname=' (med_map_mod:med_map_field_normalized) ' !----------------------------------------------------------- + call t_startf('MED:'//subname) rc = ESMF_SUCCESS ! get a pointer (data_fracsrc) to the normalization array @@ -1390,6 +1392,8 @@ subroutine med_map_field_normalized(field_src, field_dst, routehandles, maptype, end if end do end if + + call t_stopf('MED:'//subname) end subroutine med_map_field_normalized !================================================================================ @@ -1534,6 +1538,7 @@ subroutine med_map_uv_cart3d(FBsrc, FBdst, routehandles, mapindex, map_stress, r character(len=*), parameter :: subname=' (med_map_mod:med_map_uv_cart3d) ' !------------------------------------------------------------------------------- + call t_startf('MED:'//subname) rc = ESMF_SUCCESS lmap_stress = .false. @@ -1659,6 +1664,7 @@ subroutine med_map_uv_cart3d(FBsrc, FBdst, routehandles, mapindex, map_stress, r deallocate(ownedElemCoords_src) deallocate(ownedElemCoords_dst) + call t_stopf('MED:'//subname) end subroutine med_map_uv_cart3d end module med_map_mod