diff --git a/.github/workflows/extbuild.yml b/.github/workflows/extbuild.yml index e1c69cd7..7f7dde3a 100644 --- a/.github/workflows/extbuild.yml +++ b/.github/workflows/extbuild.yml @@ -48,27 +48,31 @@ jobs: id: cache-ParallelIO uses: actions/cache@v4 with: - path: ~/pio + path: {GITHUB_WORKSPACE}/pio key: ${{ runner.os }}-${{ env.PIO_VERSION }}.pio - name: Build ParallelIO if: steps.cache-ParallelIO.outputs.cache-hit != 'true' - uses: NCAR/ParallelIO/.github/actions/parallelio_cmake@pio2_6_0 + uses: NCAR/ParallelIO/.github/actions/parallelio_cmake@pio2_6_2 with: parallelio_version: ${{ env.ParallelIO_VERSION }} enable_fortran: True - install_prefix: $HOME/pio - - name: Build ESMF - if: steps.cache-esmf.outputs.cache-hit != 'true' - uses: ESCOMP/CDEPS/.github/actions/buildesmf@cdeps1.0.15 + install_prefix: ${GITHUB_WORKSPACE}/pio + - 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: $HOME/ESMF - netcdf_c_path: /usr - netcdf_fortran_path: /usr - pnetcdf_path: /usr - parallelio_path: $HOME/pio + version: ${{ env.ESMF_VERSION }} + esmpy: false + cache: true - name: Cache CDEPS id: cache-cdeps uses: actions/cache@v4 @@ -90,8 +94,8 @@ jobs: if: steps.cache-cdeps.outputs.cache-hit != 'true' uses: ESCOMP/CDEPS/.github/actions/buildcdeps@cdeps1.0.26 with: - esmfmkfile: $HOME/ESMF/lib/libg/Linux.gfortran.64.openmpi.default/esmf.mk - pio_path: $HOME/pio + esmfmkfile: $ESMFMKFILE + pio_path: ${GITHUB_WORKSPACE}/pio 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 \"" diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index efec7ba8..95f7bbcd 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -172,6 +172,6 @@ jobs: popd # the following can be used by developers to login to the github server in case of errors # see https://github.com/marketplace/actions/debugging-with-tmate for further details - - name: Setup tmate session - if: ${{ failure() }} - uses: mxschmitt/action-tmate@v3 +# - name: Setup tmate session +# if: ${{ failure() }} +# uses: mxschmitt/action-tmate@v3 diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 222a15b2..47c7a830 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -696,6 +696,20 @@ .true. + + + logical + control + MED_attributes + + Compute energy of enthalpy + + + .false. + .true. + + + integer control @@ -929,7 +943,8 @@ default: ogrid - ogrid + xgrid + ogrid diff --git a/mediator/CMakeLists.txt b/mediator/CMakeLists.txt index 9630b5e2..031a2330 100644 --- a/mediator/CMakeLists.txt +++ b/mediator/CMakeLists.txt @@ -16,7 +16,8 @@ set(SRCFILES esmFldsExchange_cesm_mod.F90 med_fraction_mod.F90 med_phases_post_ocn_mod.F90 med_phases_ocnalb_mod.F90 med_phases_post_atm_mod.F90 med_phases_post_ice_mod.F90 med_phases_post_lnd_mod.F90 med_phases_post_glc_mod.F90 - med_phases_post_rof_mod.F90 med_phases_post_wav_mod.F90) + med_phases_post_rof_mod.F90 med_phases_post_wav_mod.F90 + med_enthalpy_mod.F90) foreach(FILE ${SRCFILES}) if(EXISTS "${CASEROOT}/SourceMods/src.cmeps/${FILE}") diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index a521deaa..3f76a50f 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -2206,7 +2206,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ocn: enthalpy from ice melt ! --------------------------------------------------------------------- ! Note - do not need to add addmap or addmrg for the following since they - ! will be computed directly in med_phases_prep_ocn + ! will be computed directly in med_enthalpy_mod if (phase == 'advertise') then call addfld_to(compocn, 'Foxx_hrain') call addfld_to(compocn, 'Foxx_hsnow') diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index e41c61df..7985059e 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -72,6 +72,21 @@ canonical_units: N m-2 description: med export - atm/ocn meridional surface stress computed in medidator # + + - standard_name: Faox_tauxa + alias: stress_on_air_ocn_zonal (atm) + canonical_units: N m-2 + description: mediator export + # + - standard_name: Faox_tauya + alias: stress_on_air_ocn_merid (atm) + canonical_units: N m-2 + description: mediator export + # + - 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 @@ -81,6 +96,7 @@ alias: mean_merid_moment_flx canonical_units: N m-2 description: wave import to med - meridional surface stress + # #----------------------------------- # section: lnd import to med @@ -298,6 +314,16 @@ description: atm import to med mean downward SW heat flux # + - standard_name: Faxa_wsxadj + canonical_units: Pa + description: (from) atmosphere export to flux_atmocn (for now) + mean wind-stess correction due to PBL iteration, zonal component + # + - standard_name: Faxa_wsyadj + canonical_units: Pa + description: (from) atmosphere export to flux_atmocn (for now) + mean wind-stess correction due to PBL iteration, meridional component + # - standard_name: Faxa_ndep canonical_units: kg(N)/m2/sec description: atm import to med - currently nhx and noy @@ -330,7 +356,12 @@ # - standard_name: Faxa_rainl_wiso canonical_units: kg m-2 s-1 - description: atm import to med + description: atmosphere export + # + - standard_name: Faxa_hrain + alias: mean_matentf_of_rain + canonical_units: W m-2 + description: atmosphere export # - standard_name: Faxa_snow alias: mean_fprec_rate @@ -355,6 +386,11 @@ # - standard_name: Faxa_snowl_wiso canonical_units: kg m-2 s-1 + description: atmosphere export + # + - standard_name: Faxa_hsnow + alias: mean_matentf_of_snow + canonical_units: W m-2 description: atm import to med # - standard_name: Faxa_swnet @@ -486,7 +522,13 @@ - standard_name: Faxa_lat alias: mean_laten_heat_flx_atm canonical_units: W m-2 + description: atmosphere export + # + - standard_name: Faxa_hevap + alias: mean_matentf_of_vapour + canonical_units: W m-2 description: atm import to med + # - standard_name: Faxa_sen alias: mean_sensi_heat_flx_atm @@ -1247,6 +1289,9 @@ 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) diff --git a/mediator/med.F90 b/mediator/med.F90 index 3133c7f8..a038570f 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -678,7 +678,8 @@ subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc) use esmFlds, only : med_fldlist_init1, med_fld_GetFldInfo, med_fldList_entry_type use med_phases_history_mod, only : med_phases_history_init use med_methods_mod , only : mediator_checkfornans - + use med_enthalpy_mod , only : mediator_compute_enthalpy + ! input/output variables type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState @@ -959,6 +960,24 @@ subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc) endif endif + + ! Should enthalpy be calculated + call NUOPC_CompAttributeGet(gcomp, name="compute_enthalpy", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if(isPresent .and. isSet) then + read(cvalue, *) mediator_compute_enthalpy + else + mediator_compute_enthalpy = .false. + endif + if(maintask) then + write(logunit,*) ' compute_enthalpy is ',mediator_compute_enthalpy + if(mediator_compute_enthalpy) then + write(logunit,*) ' Enthalpy calculation is ON' + else + write(logunit,*) ' Enthalpy calculation is OFF' + endif + endif + ! Should target component use all data for first time step? do ncomp = 1,ncomps if (ncomp /= compmed) then diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index 8bad9d5c..bbacce3e 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -144,6 +144,7 @@ module med_diag_mod integer :: f_heat_latf = unset_index ! heat : latent, fusion, snow integer :: f_heat_ioff = unset_index ! heat : latent, fusion, frozen runoff 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 @@ -409,7 +410,7 @@ subroutine med_diag_init(gcomp, rc) ! Salt fluxes budget terms (for v1 only) ! ----------------------------------------- - if (trim(budget_table_version) == 'v1') then + if (trim(budget_table_version) .ne. 'v0') then call add_to_budget_diag(budget_diags%fields, f_watr_salt ,'saltf') ! field water: salt flux f_salt_beg = f_watr_salt f_salt_end = f_watr_salt @@ -448,7 +449,6 @@ subroutine med_diag_init(gcomp, rc) allocate(budget_global (f_size , c_size , p_size)) ! global sum, valid only on root pe allocate(budget_counter (f_size , c_size , p_size)) ! counter, valid only on root pe allocate(budget_global_1d(f_size * c_size * p_size)) ! needed for ESMF_VMReduce call - end subroutine med_diag_init integer function get_diag_attribute(gcomp, name, rc) @@ -735,6 +735,25 @@ subroutine med_phases_diag_atm(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if + call diag_atm_recv(is_local%wrap%FBImp(compatm,compatm), 'Faxa_hrain', f_heat_rain, & + areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call diag_atm_recv(is_local%wrap%FBImp(compatm,compatm), 'Faxa_hsnow', f_heat_snow, & + areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call diag_atm_recv(is_local%wrap%FBImp(compatm,compatm), 'Faxa_hevap', f_heat_evap, & + areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call diag_atm_recv(is_local%wrap%FBImp(compatm,compatm), 'Faxa_hrofl', f_heat_rofl, & + areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call diag_atm_recv(is_local%wrap%FBImp(compatm,compatm), 'Faxa_hrofi', f_heat_rofi, & + areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! 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 @@ -2715,7 +2734,7 @@ subroutine med_diag_print_summary(data, ip, date, tod) ! write out net salt budgets ! ----------------------------- - if (trim(budget_table_version) == 'v1') then + if (trim(budget_table_version) .ne. 'v0') then write(diagunit,*) ' ' write(diagunit,FAH) subname,'NET SALT BUDGET (kg/m2s): period = ',& trim(budget_diags%periods(ip)%name), ': date = ',date,tod diff --git a/mediator/med_enthalpy_mod.F90 b/mediator/med_enthalpy_mod.F90 new file mode 100644 index 00000000..fd51baf7 --- /dev/null +++ b/mediator/med_enthalpy_mod.F90 @@ -0,0 +1,298 @@ +module med_enthalpy_mod + use ESMF, only : ESMF_SUCCESS, ESMF_GridComp, ESMF_VMAllreduce, ESMF_REDUCE_SUM, ESMF_FieldBundleGet, ESMF_Field + use shr_kind_mod, only : R8=>shr_kind_r8 + use shr_const_mod, only : tkfrz=>shr_const_tkfrz, cpfw=>shr_const_cpfw, cpice=>shr_const_cpice,& + cpwv=>shr_const_cpwv, cpsw=>shr_const_cpsw, pi=>shr_const_pi + use med_utils_mod , only : chkerr => med_utils_ChkErr + use med_methods_mod , only : FB_fldchk => med_methods_FB_FldChk + use med_methods_mod , only : FB_GetFldPtr => med_methods_FB_GetFldPtr + use med_methods_mod , only : fldbun_getdata1d => med_methods_FB_getdata1d + use med_internalstate_mod, only : compocn, compatm, comprof, InternalState + use med_internalstate_mod , only : logunit, maintask + use perf_mod, only : t_startf, t_stopf + + + implicit none + public :: med_compute_enthalpy + logical, public :: mediator_compute_enthalpy = .false. + + real(r8) :: global_htot_corr(1) = 0._r8 + character(*), parameter :: u_FILE_u = & + __FILE__ +contains + real(r8) function med_enthalpy_get_global_htot_corr() + ! Just return the latest global_htot_corr + med_enthalpy_get_global_htot_corr = global_htot_corr(1) + end function med_enthalpy_get_global_htot_corr + + subroutine med_compute_enthalpy(is_local, rc) + use med_map_mod, only : med_map_field + use med_internalstate_mod, only : mapconsf + type(InternalState), intent(in) :: is_local + integer, intent(out) :: rc + + ! local variables + type(ESMF_Field) :: fld_a, fld_o + real(r8), pointer :: tocn(:), rain(:), snow(:), rofl(:), rofi(:), evap(:) + real(r8), pointer :: rainl(:), rainc(:), tbot(:) + real(r8), pointer :: snowl(:), snowc(:), ofrac(:) + real(r8), pointer :: hrain(:), hsnow(:), hevap(:), hcond(:), hrofl(:), hrofi(:) + real(r8), pointer :: hrain_a(:), hevap_a(:), hsnow_a(:), hrofl_a(:), hrofi_a(:) + + real(r8), allocatable :: hcorr(:) + real(r8), pointer :: areas(:) + real(r8), parameter :: glob_area_inv = 1._r8 / (4._r8 * pi) + real(r8) :: local_htot_corr(1) + + integer :: n, nmax + character(len=*), parameter:: subname = "med_compute_enthalpy" + + call t_startf(subname) + rc = ESMF_SUCCESS + + call FB_GetFldPtr(is_local%wrap%FBImp(compocn,compocn), 'So_t', tocn, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + nmax = size(tocn) + + if (FB_fldchk(is_local%wrap%FBExp(compocn), 'Sa_tbot' , rc=rc)) then + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Sa_tbot', tbot, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call FB_GetFldPtr(is_local%wrap%FBImp(compatm, compocn), 'Sa_tbot', tbot, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + + if(FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_rain', rc)) then + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Faxa_rain' , rain, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call FB_GetFldPtr(is_local%wrap%FBImp(compatm, compatm), 'Faxa_rainl', rainl, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBImp(compatm, compatm), 'Faxa_rainl', rainc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(rain(nmax)) + rain = rainl + rainc + endif + + if(FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrain', rc)) then + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hrain', hrain, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + allocate(hrain(nmax)) + endif + + if(FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_evap', rc)) then + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_evap' , evap, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call FB_GetFldPtr(is_local%wrap%FBExp(compatm), 'Faxx_evap' , evap, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + + if(FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hevap', rc)) then + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hevap', hevap, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + allocate(hevap(nmax)) + endif + if(FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hcond', rc)) then + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hcond', hcond, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + allocate(hcond(nmax)) + endif + + if(FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_snow', rc)) then + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Faxa_snow' , snow, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowc' , snowc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowl' , snowl, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(snow(nmax)) + snow = snowc + snowl + endif + + if(FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hsnow', rc)) then + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hsnow', hsnow, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + allocate(hsnow(nmax)) + endif + + if(FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofl', rc)) then + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_rofl' , rofl, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call FB_GetFldPtr(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofl', rofl, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + if(FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrofl', rc)) then + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hrofl', hrofl, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + allocate(hrofl(nmax)) + endif + + if(FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofi', rc)) then + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_rofi' , rofi, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call FB_GetFldPtr(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofi', rofi, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + if(FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrofi', rc)) then + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hrofi', hrofi, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + allocate(hrofi(nmax)) + endif + + call FB_GetFldPtr(is_local%wrap%FBfrac(compocn), 'ofrac' , ofrac, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (FB_fldchk(is_local%wrap%FBImp(compatm,compocn), 'Faxa_hrain' , rc=rc)) then + call ESMF_FieldBundleGet(is_local%wrap%FBImp(compatm, compatm), 'Faxa_hrain', field=fld_a, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldBundleGet(is_local%wrap%FBImp(compatm, compocn), 'Faxa_hrain', field=fld_o, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call med_map_field(fld_a, fld_o, is_local%wrap%RH(compatm, compocn,:), mapconsf, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call FB_GetFldPtr(is_local%wrap%FBImp(compatm, compocn), 'Faxa_hrain', hrain_a, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + do n = 1,nmax + hrain(n) = (hrain_a(n) - tkfrz*rain(n)*cpfw) * ofrac(n) + enddo + else + if (FB_fldchk(is_local%wrap%FBExp(compocn), 'Sa_tbot' , rc=rc)) then + do n = 1,nmax + hrain(n) = max((tbot(n) - tkfrz), 0._r8) * rain(n) * cpfw * ofrac(n) + enddo + else + do n = 1,nmax + hrain(n) = max((tocn(n) - tkfrz), 0._r8) * rain(n) * cpfw * ofrac(n) + enddo + endif + hrain_a => hrain + endif + + if (FB_fldchk(is_local%wrap%FBImp(compatm, compocn), 'Faxa_hevap' , rc=rc)) then + call ESMF_FieldBundleGet(is_local%wrap%FBImp(compatm, compatm), 'Faxa_hevap', field=fld_a, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldBundleGet(is_local%wrap%FBImp(compatm, compocn), 'Faxa_hevap', field=fld_o, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call med_map_field(fld_a, fld_o, is_local%wrap%RH(compatm, compocn,:), mapconsf, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call FB_GetFldPtr(is_local%wrap%FBImp(compatm, compocn), 'Faxa_hevap', hevap_a, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + do n = 1,nmax + hevap(n) = (min(hevap_a(n),0._r8) - tkfrz * min(evap(n),0._r8) * cpwv) * ofrac(n) + hcond(n) = (max(hevap_a(n),0._r8) - tkfrz * max(evap(n),0._r8) * cpwv) * ofrac(n) + enddo + else + do n = 1,nmax + hevap(n) = (tocn(n) - tkfrz) * min(evap(n),0._r8) * cpwv * ofrac(n) + hcond(n) = (tocn(n) - tkfrz) * max(evap(n),0._r8) * cpwv * ofrac(n) + enddo + hevap_a => hevap + endif + + if (FB_fldchk(is_local%wrap%FBImp(compatm, compocn), 'Faxa_hsnow' , rc=rc)) then + call ESMF_FieldBundleGet(is_local%wrap%FBImp(compatm, compatm), 'Faxa_hsnow', field=fld_a, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldBundleGet(is_local%wrap%FBImp(compatm, compocn), 'Faxa_hsnow', field=fld_o, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call med_map_field(fld_a, fld_o, is_local%wrap%RH(compatm, compocn,:), mapconsf, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call FB_GetFldPtr(is_local%wrap%FBImp(compatm, compocn), 'Faxa_hsnow', hsnow_a, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + do n = 1,nmax + hsnow(n) = (hsnow_a(n) - tkfrz * snow(n) * cpice) * ofrac(n) + enddo + else + + if (FB_fldchk(is_local%wrap%FBExp(compocn), 'Sa_tbot' , rc=rc)) then + do n = 1,nmax + hsnow(n) = min((tbot(n) - tkfrz), 0._r8) * snow(n) * cpice * ofrac(n) + enddo + else + do n = 1,nmax + hsnow(n) = min((tocn(n) - tkfrz), 0._r8) * snow(n) * cpice * ofrac(n) + enddo + endif + hsnow_a => hsnow + endif + + allocate(hrofl_a(nmax)) + allocate(hrofi_a(nmax)) + do n=1,nmax + ! for F cases (docn) tocn is non-zero over land and so ofrac must be included + ! so that only ocean points are included in calculation + ! Need max to ensure that will not have an enthalpy contribution if the water is below 0C + + hrofl_a(n)= max( tocn(n) , tkfrz ) * rofl(n) * cpsw * ofrac(n) + hrofi_a(n)= min( tocn(n) , tkfrz ) * rofi(n) * cpsw * ofrac(n) + + hrofl(n) = max((tocn(n) - tkfrz), 0._r8) * rofl(n) * cpsw * ofrac(n) + hrofi(n) = min((tocn(n) - tkfrz), 0._r8) * rofi(n) * cpsw * ofrac(n) + end do + if(.not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_rain', rc)) deallocate(rain) + if(.not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_snow', rc)) deallocate(snow) + + + ! Determine enthalpy correction factor that will be added to the sensible heat flux sent to the atm + ! Areas here in radians**2 - this is an instantaneous snapshot that will be sent to the atm - only + ! need to calculate this if data is sent back to the atm + + if (FB_fldchk(is_local%wrap%FBExp(compatm), 'Faxx_sen', rc=rc)) then + allocate(hcorr(nmax)) + areas => is_local%wrap%mesh_info(compocn)%areas + do n = 1,nmax + hcorr(n) = (hrain_a(n) + hsnow_a(n) + hevap_a(n) + hrofl_a(n) + hrofi_a(n)) * & + areas(n) * glob_area_inv + + !hcorr(n) = (hrofl_a(n) + hrofi_a(n)) *areas(n) *glob_area_inv + end do + + ! Determine sum of enthalpy correction for each hcorr index locally + local_htot_corr(1) = 0._r8 + do n = 1,size(hcorr) + local_htot_corr(1) = local_htot_corr(1) + hcorr(n) + end do + call ESMF_VMAllreduce(is_local%wrap%vm, senddata=local_htot_corr, recvdata=global_htot_corr, count=1, & + reduceflag=ESMF_REDUCE_SUM, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (maintask) write(logunit, '(a,a,f21.13)') trim(subname),' global enthalpy correction: ',global_htot_corr(1) +#ifdef DEBUG + write(logunit, '(a,a,3f21.13)') trim(subname), ' hrain_a: ',minval(hrain_a),maxval(hrain_a),sum(hrain_a) + write(logunit, '(a,a,3f21.13)') trim(subname), ' hsnow_a: ',minval(hsnow_a),maxval(hsnow_a),sum(hsnow_a) + write(logunit, '(a,a,3f21.13)') trim(subname), ' hevap_a: ',minval(hevap_a),maxval(hevap_a),sum(hevap_a) + write(logunit, '(a,a,3f21.13)') trim(subname), ' hrofl_a: ',minval(hrofl_a),maxval(hrofl_a),sum(hrofl_a) + write(logunit, '(a,a,3f21.13)') trim(subname), ' hrofi_a: ',minval(hrofi_a),maxval(hrofi_a),sum(hrofi_a) +#endif + deallocate(hcorr) + endif + if(.not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hsnow', rc)) deallocate(hsnow) + if(.not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrofl', rc)) deallocate(hrofl) + if(.not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrofi', rc)) deallocate(hrofi) + if(.not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrain', rc)) deallocate(hrain) + if(.not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hevap', rc)) deallocate(hevap) + if(.not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hcond', rc)) deallocate(hcond) + deallocate(hrofl_a) + deallocate(hrofi_a) + call t_stopf(subname) + + end subroutine med_compute_enthalpy + +end module med_enthalpy_mod diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index d09903be..e2b43963 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -136,7 +136,8 @@ module med_internalstate_mod logical :: ocn2glc_coupling = .false. ! obtained from attribute logical :: lnd2glc_coupling = .false. logical :: accum_lnd2glc = .false. - + logical :: docn_present ! aoflux calc requires med_coupling_active true even for docn + ! so we need an additional flag ! Mediator vm type(ESMF_VM) :: vm @@ -350,8 +351,10 @@ subroutine med_internalstate_init(gcomp, rc) end if call NUOPC_CompAttributeGet(gcomp, name='OCN_model', value=ocn_name, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + is_local%wrap%docn_present = .false. if (isPresent .and. isSet) then if (trim(ocn_name) /= 'socn') is_local%wrap%comp_present(compocn) = .true. + if (trim(ocn_name) == 'docn') is_local%wrap%docn_present = .true. end if call NUOPC_CompAttributeGet(gcomp, name='ICE_model', value=ice_name, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/mediator/med_phases_ocnalb_mod.F90 b/mediator/med_phases_ocnalb_mod.F90 index 304d0c7f..840082b3 100644 --- a/mediator/med_phases_ocnalb_mod.F90 +++ b/mediator/med_phases_ocnalb_mod.F90 @@ -636,7 +636,7 @@ subroutine med_phases_ocnalb_orbital_update(clock, logunit, maintask, eccen, ob integer :: orb_year ! orbital year for current orbital computation character(len=CL) :: msgstr ! temporary logical :: lprint - logical :: first_time = .true. + logical, save :: first_time = .true. character(len=*) , parameter :: subname = "(med_phases_ocnalb_orbital_update)" !------------------------------------------- @@ -648,16 +648,12 @@ 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 + if(first_time) lprint = maintask else orb_year = orb_iyear - if (first_time) then - lprint = maintask - first_time = .false. - else - lprint = .false. - end if + if(first_time) lprint = maintask end if + first_time = .false. eccen = orb_eccen shr_log_unit = logunit diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index bcdf2ea4..a2734e94 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -7,7 +7,7 @@ module med_phases_prep_atm_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_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS use ESMF , only : ESMF_Field, ESMF_FieldGet, ESMF_FieldBundleGet - use ESMF , only : ESMF_GridComp, ESMF_GridCompGet + use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_FieldBundleIsCreated use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_utils_mod , only : memcheck => med_memcheck use med_utils_mod , only : chkerr => med_utils_ChkErr @@ -23,14 +23,12 @@ module med_phases_prep_atm_mod use perf_mod , only : t_startf, t_stopf use med_phases_aofluxes_mod, only : med_aofluxes_map_xgrid2agrid_output use med_phases_aofluxes_mod, only : med_aofluxes_map_ogrid2agrid_output + use med_enthalpy_mod, only : med_enthalpy_get_global_htot_corr, med_compute_enthalpy, mediator_compute_enthalpy implicit none private public :: med_phases_prep_atm - public :: med_phases_prep_atm_enthalpy_correction - - 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'/) @@ -231,11 +229,17 @@ subroutine med_phases_prep_atm(gcomp, rc) end do ! Add enthalpy correction to sensible heat if appropriate - if (FB_FldChk(is_local%wrap%FBExp(compatm), 'Faxx_sen', rc=rc)) then + if (Mediator_compute_enthalpy) then call FB_getfldptr(is_local%wrap%FBExp(compatm), 'Faxx_sen', dataptr1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! IF data ocn case compute first, otherwise computed in prep_ocn_mod + if(is_local%wrap%docn_present) then + call med_compute_enthalpy(is_local, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif do n = 1,size(dataptr1) - dataptr1(n) = dataptr1(n) + global_htot_corr(1) + dataptr1(n) = dataptr1(n) + med_enthalpy_get_global_htot_corr() end do end if @@ -263,7 +267,7 @@ subroutine med_phases_prep_atm_enthalpy_correction (gcomp, hcorr, rc) use ESMF , only : ESMF_VMAllreduce, ESMF_GridCompGet, ESMF_REDUCE_SUM use ESMF , only : ESMF_VM - + use med_enthalpy_mod, only : global_htot_corr ! input/output variables type(ESMF_GridComp) , intent(in) :: gcomp real(r8) , intent(in) :: hcorr(:) diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index 246ec586..a3b31154 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -7,9 +7,8 @@ module med_phases_prep_ocn_mod use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use med_constants_mod , only : czero =>med_constants_czero use med_constants_mod , only : dbug_flag => med_constants_dbug_flag - use med_internalstate_mod , only : InternalState, maintask, logunit + use med_internalstate_mod , only : InternalState, maintask, logunit, compocn, compatm, compice, coupling_mode use med_merge_mod , only : med_merge_auto, med_merge_field - use med_map_mod , only : med_map_field_packed use med_utils_mod , only : memcheck => med_memcheck use med_utils_mod , only : chkerr => med_utils_ChkErr use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose @@ -21,7 +20,6 @@ module med_phases_prep_ocn_mod use med_methods_mod , only : FB_reset => med_methods_FB_reset use med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans use esmFlds , only : med_fldList_GetfldListTo, med_fldlist_type - use med_internalstate_mod , only : compocn, compatm, compice, coupling_mode use perf_mod , only : t_startf, t_stopf implicit none @@ -79,15 +77,15 @@ 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 - + use med_enthalpy_mod , only : med_compute_enthalpy, mediator_compute_enthalpy + use med_map_mod , only : med_map_field_packed ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc ! local variables type(InternalState) :: is_local + integer :: n real(r8) :: glob_area_inv real(r8), pointer :: tocn(:) @@ -155,97 +153,9 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) FBMed1=is_local%wrap%FBMed_aoflux_o, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - !--------------------------------------- - !--- custom calculations - !--------------------------------------- - ! 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) .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 - - call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Faxa_rain' , rain, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hrain', hrain, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_evap' , evap, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hevap', hevap, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hcond', hcond, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Faxa_snow' , snow, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hsnow', hsnow, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_rofl' , rofl, rc=rc) + if(mediator_compute_enthalpy) then + call med_compute_enthalpy(is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hrofl', hrofl, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_rofi' , rofi, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - 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 - hsnow(n) = min((tocn(n) - shr_const_tkfrz), 0._r8) * snow(n) * shr_const_cpsw - hevap(n) = (tocn(n) - shr_const_tkfrz) * min(evap(n), 0._r8) * shr_const_cpsw - 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 - ! Areas here in radians**2 - this is an instantaneous snapshot that will be sent to the atm - only - ! need to calculate this if data is sent back to the atm - - if (FB_fldchk(is_local%wrap%FBExp(compatm), 'Faxx_sen', rc=rc)) then - allocate(hcorr(size(tocn))) - 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) + hrofl_glc(n) + hrofi_glc(n)) * & - areas(n) * glob_area_inv - end do - call med_phases_prep_atm_enthalpy_correction(gcomp, hcorr, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - deallocate(hcorr) - end if - end if ! custom merges to ocean