From 868c4e50f03c048eef05fc68d0eaa7d4a83997d2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=C3=98yvind=20Seland?= Date: Sat, 14 Jun 2025 19:21:06 +0200 Subject: [PATCH 01/13] Added options for enthalpy correction programmed by indicate Peter Lauritzen (NCAR) and Thomas Toniazzo (Bjerknes Centre / NORCE) --- mediator/esmFldsExchange_cesm_mod.F90 | 62 ++++++++- mediator/fd_cesm.yaml | 30 ++++- mediator/med_diag_mod.F90 | 33 ++++- mediator/med_phases_prep_atm_mod.F90 | 64 ++++++++- mediator/med_phases_prep_ocn_mod.F90 | 183 +++++++++++++++++++++----- 5 files changed, 329 insertions(+), 43 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index b3b305668..8254d7631 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -1312,9 +1312,29 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if end if +! logic below weird because of absurdity of global-mean ocean-points-only material enthalpy flux + if (phase == 'advertise') then + call addfld_to(compatm, 'Faxx_goef') + else ! fill with sensible heat here, will be overwritten (globally) in med_phases_prep_atm + 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 addmrg_to(compatm , 'Faxx_goef', & + 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 addmrg_to(compatm , 'Faxx_goef', & + mrg_from=compice, mrg_fld='Faii_sen', mrg_type='merge', mrg_fracname='ifrac') + end if + if (fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_sen', rc=rc)) then + call addmrg_to(compatm , 'Faxx_goef', & + mrg_from=compmed, mrg_fld='Faox_sen', mrg_type='merge', mrg_fracname='ofrac') + end if + end if + end if if (phase == 'advertise') then call addfld_to(compatm, 'Faxx_evap') + call addfld_to(compatm, 'Faox_evap') !+tht call addfld_from(complnd, 'Fall_evap') call addfld_from(compice, 'Faii_evap') call addfld_aoflux( 'Faox_evap') @@ -1336,6 +1356,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if call addmrg_to(compatm , 'Faxx_evap', & mrg_from=compmed, mrg_fld='Faox_evap', mrg_type='merge', mrg_fracname='ofrac') +!+tht unmerged aoflux-only for correct hevap to ocean in cam_out + call addmrg_to(compatm, 'Faox_evap', mrg_from=compmed, mrg_fld='Faox_evap', mrg_type='copy') +!-tht end if end if end if @@ -1892,6 +1915,33 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) mrg_from=compatm, mrg_fld='Faxa_swdn', mrg_type='copy') end if end if +!+tht --------------------------------------------------------------------- + ! to ocn: downward material enthalpy flux + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld_from(compatm, 'Faxa_hmat') + call addfld_to (compocn, 'Faxa_hmat') + call addfld_to (compocn, 'Faxa_hmat_oa') ! handled in prep_ocn + call addfld_from(compatm, 'Faxa_hlat') + call addfld_to (compocn, 'Faxa_hlat') + call addfld_to (compatm, 'Faxx_hrof') ! enthalpy of runoff, computed in med_phases_prep_ocn + else + if (fldchk(is_local%wrap%FBImp(compatm, compatm), 'Faxa_hmat', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_hmat', rc=rc)) then + call addmap_from(compatm, 'Faxa_hmat', compocn, mapconsf, 'one', atm2ocn_map) + call addmrg_to (compocn, 'Faxa_hmat', mrg_from=compatm ,mrg_fld='Faxa_hmat' & + , mrg_type='copy_with_weights', mrg_fracname='ofrac') + end if + if (fldchk(is_local%wrap%FBImp(compatm, compatm), 'Faxa_hlat', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_hlat', rc=rc)) then + call addmap_from(compatm, 'Faxa_hlat', compocn, mapconsf, 'one', atm2ocn_map) + call addmrg_to (compocn, 'Faxa_hlat', mrg_from=compatm ,mrg_fld='Faxa_hlat' & + , mrg_type='copy_with_weights', mrg_fracname='ofrac') + end if + !if (fldchk(is_local%wrap%FBExp(compatm),'Faxx_hrof', rc=rc)) & + ! call addmap_from(compocn, 'Faxx_hrof', compatm, mapconsf, 'one', atm2ocn_map) + end if +!-tht ! --------------------------------------------------------------------- ! to ocn: net shortwave radiation from med ! --------------------------------------------------------------------- @@ -1932,15 +1982,15 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if ! import sw from atm by bands - if ( fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swvdr', rc=rc) .and. & + if ((fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swvdr', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swvdf', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swndr', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swndr', rc=rc) .and. & - (fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet' , rc=rc)) .or. & - (fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdr', rc=rc) .and. & - fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdf', rc=rc) .and. & - fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idr', rc=rc) .and. & - fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idf', rc=rc))) then + fldchk(is_local%wrap%FBExp(compocn) , 'Foxx_swnet', rc=rc)) .or. & + (fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdr', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdf', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idr', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idf', rc=rc))) then call addmap_from(compatm, 'Faxa_swvdr', compocn, mapconsf, 'one', atm2ocn_map) call addmap_from(compatm, 'Faxa_swvdf', compocn, mapconsf, 'one', atm2ocn_map) call addmap_from(compatm, 'Faxa_swndr', compocn, mapconsf, 'one', atm2ocn_map) diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index e41c61dff..0ea8956d3 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -296,8 +296,26 @@ alias: mean_down_lw_flx canonical_units: W m-2 description: atm import to med - mean downward SW heat flux + mean downward LW heat flux + #+tht + - standard_name: Faxa_hmat + alias: mean_down_hmat + canonical_units: W m-2 + description: atm import to med + mean downward material enthalpy flux + # + - standard_name: Faxa_hlat + alias: mean_down_hlat + canonical_units: W m-2 + description: atm import to med + variable latent heat part of mat.enth.flx # + - standard_name: Faxa_hmat_oa + alias: mean_down_hmat_oa + canonical_units: W m-2 + description: med export to ocn + mean downw. mat. enth. flux, ocean average + #-tht - standard_name: Faxa_ndep canonical_units: kg(N)/m2/sec description: atm import to med - currently nhx and noy @@ -519,6 +537,11 @@ canonical_units: W m-2 description: atm export from med - merged sensible heat flux # + - standard_name: Faxx_goef + alias: wrong_fixer_busts_energy + canonical_units: W m-2 + description: atm export from med - wrong atm fixer for ocn mat.enthalpy + # - standard_name: Faxx_taux alias: mean_zonal_moment_flx canonical_units: N m-2 @@ -1012,6 +1035,11 @@ alias: heat_content_cond canonical_units: W m-2 description: med export to ocn heat content of condensation + #+tht + - standard_name: Faxx_hrof + alias: heat_content_rof + canonical_units: W m-2 + description: med export to atm gl.avg. of mat.enthalpy of runoff # - standard_name: Foxx_hrofl alias: heat_content_rofl diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index df0d4e351..b8675eb27 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 @@ -143,6 +143,10 @@ 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 +!+tht + integer :: f_heat_goef = unset_index ! heat : bad global ocean enthalpy fixer + integer :: f_heat_hmat = unset_index ! heat : surface material enthalpy flux +!-tht 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 @@ -325,14 +329,23 @@ subroutine med_diag_init(gcomp, rc) 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_sen ,'hsen' ) ! field heat : sensible +!+tht N.B. HMAT from atmo, GOEF from med; they shouldn't be both /=0. + call add_to_budget_diag(budget_diags%fields, f_heat_goef ,'goef' ) ! field heat : bad gl. ocn enth. fixer + call add_to_budget_diag(budget_diags%fields, f_heat_hmat ,'hmat' ) ! field heat : surf. mat. enthalpy flux +!-tht if (trim(budget_table_version) == 'v0') then f_heat_beg = f_heat_frz ! field first index for heat - f_heat_end = f_heat_sen ! field last index for heat +!+tht + !f_heat_end = f_heat_sen ! field last index for heat + f_heat_end = f_heat_hmat ! field last index for heat +!-tht 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 +!tht: N.B. if hmat/=0, all other terms here must be zero. + call add_to_budget_diag(budget_diags%fields, f_heat_hmat ,'hmat' ) !+tht: f.heat : surf. mat. enthalpy flux 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 @@ -516,6 +529,7 @@ subroutine med_diag_zero_mode(mode, rc) call shr_log_error(trim(subname)//' mode '//trim(mode)//& ' not recognized', & line=__LINE__, file=u_FILE_u, rc=rc) + return endif end subroutine med_diag_zero_mode @@ -761,6 +775,15 @@ subroutine med_phases_diag_atm(gcomp, rc) call diag_atm_send(is_local%wrap%FBExp(compatm), 'Faxx_sen', f_heat_sen, & areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return +!+tht + call diag_atm_send(is_local%wrap%FBExp(compatm), 'Faxx_goef', f_heat_goef, & + areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + !not sure about this + !call diag_atm_send(is_local%wrap%FBExp(compatm), 'Faxa_hmat', f_heat_hmat, & + ! areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) + !if (ChkErr(rc,__LINE__,u_FILE_u)) return +!-tht call diag_atm_send(is_local%wrap%FBExp(compatm), 'Faxx_evap', f_watr_evap, & areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1584,6 +1607,8 @@ subroutine med_phases_diag_ocn( gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if +!tht: some logic and code is required here to set correct ocn budget using surface material enthalpy +! fluxes computed in atmosphere and passed to med (Faxa_hmat) or its global-ocean average (Faxa_hmat_oa) 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) @@ -1596,6 +1621,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 + !I'm putting a placeholder here as a reminder -- for now as don't know how it's/should be used this is c'd out + !call diag_ocn(is_local%wrap%FBImp(compatm,compocn), 'Faxa_hmat', f_heat_hmat, ic, areas, ofrac, budget_local, rc=rc) + !if (ChkErr(rc,__LINE__,u_FILE_u)) return +!-tht 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_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index bcdf2ea42..30d6b40a3 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -29,8 +29,10 @@ module med_phases_prep_atm_mod public :: med_phases_prep_atm public :: med_phases_prep_atm_enthalpy_correction + public :: med_phases_prep_atm_enthalpy_runoff real(r8), public :: global_htot_corr(1) = 0._r8 ! enthalpy correction from med_phases_prep_ocn + real(r8), public :: global_hrof_corr(1) = 0._r8 ! enthalpy of run-off 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'/) @@ -230,14 +232,30 @@ subroutine med_phases_prep_atm(gcomp, rc) 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 - call FB_getfldptr(is_local%wrap%FBExp(compatm), 'Faxx_sen', dataptr1, rc=rc) +!+tht: Adding enthalpy correction to sensible heat is never appropriate + !if (FB_FldChk(is_local%wrap%FBExp(compatm), 'Faxx_sen', rc=rc)) then + ! call FB_getfldptr(is_local%wrap%FBExp(compatm), 'Faxx_sen', dataptr1, rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! do n = 1,size(dataptr1) + ! dataptr1(n) = dataptr1(n) + global_htot_corr(1) + ! end do + !end if + ! instead, pass extra coupling fiels to atmosphere and decide there to use it (NCAR code) or not (best) + if (FB_FldChk(is_local%wrap%FBExp(compatm), 'Faxx_goef', rc=rc)) then + call FB_getfldptr(is_local%wrap%FBExp(compatm), 'Faxx_goef', dataptr1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return do n = 1,size(dataptr1) - dataptr1(n) = dataptr1(n) + global_htot_corr(1) + dataptr1(n) = global_htot_corr(1) end do end if + if (FB_FldChk(is_local%wrap%FBExp(compatm), 'Faxx_hrof', rc=rc)) then + call FB_getfldptr(is_local%wrap%FBExp(compatm), 'Faxx_hrof', dataptr1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + do n = 1,size(dataptr1) + dataptr1(n) = global_hrof_corr(1) + end do + end if +!-tht ! Check for nans in fields export to atm call FB_check_for_nans(is_local%wrap%FBExp(compatm), maintask, logunit, rc=rc) @@ -273,6 +291,7 @@ 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 !--------------------------------------- @@ -295,4 +314,41 @@ subroutine med_phases_prep_atm_enthalpy_correction (gcomp, hcorr, rc) end subroutine med_phases_prep_atm_enthalpy_correction + !----------------------------------------------------------------------------- + subroutine med_phases_prep_atm_enthalpy_runoff (gcomp, hcorr, rc) + + use ESMF , only : ESMF_VMAllreduce, ESMF_GridCompGet, ESMF_REDUCE_SUM + use ESMF , only : ESMF_VM + + ! input/output variables + type(ESMF_GridComp) , intent(in) :: gcomp + real(r8) , intent(in) :: hcorr(:) + integer , intent(out) :: rc + + ! local variables + type(InternalState) :: is_local + integer :: n + real(r8) :: local_hrof_corr(1) + type(ESMF_VM) :: vm + !--------------------------------------- + + rc = ESMF_SUCCESS + + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (chkErr(rc,__LINE__,u_FILE_u)) return + + ! Determine sum of enthalpy correction for each hcorr index locally + local_hrof_corr(1) = 0._r8 + do n = 1,size(hcorr) + local_hrof_corr(1) = local_hrof_corr(1) + hcorr(n) + end do + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMAllreduce(vm, senddata=local_hrof_corr, recvdata=global_hrof_corr, count=1, & + reduceflag=ESMF_REDUCE_SUM, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine med_phases_prep_atm_enthalpy_runoff + end module med_phases_prep_atm_mod diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index e30c4ada5..b6736b5a2 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -33,6 +33,9 @@ module med_phases_prep_ocn_mod private :: med_phases_prep_ocn_custom + !+tht ocean surface enthalpy flux correction + real(r8), public :: ocean_htot_corr(1)=0._r8, ocean_atot_corr(1)=0._r8, oa_htot(1)=0._r8 + character(*), parameter :: u_FILE_u = & __FILE__ @@ -78,8 +81,9 @@ 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 med_constants_mod , only : shr_const_cpsw, shr_const_tkfrz, shr_const_pi + use med_constants_mod , only : shr_const_cpsw, shr_const_cpfw, shr_const_cpice, shr_const_tkfrz, shr_const_pi use med_phases_prep_atm_mod , only : med_phases_prep_atm_enthalpy_correction + use med_phases_prep_atm_mod , only : med_phases_prep_atm_enthalpy_runoff ! input/output variables type(ESMF_GridComp) :: gcomp @@ -98,8 +102,19 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) real(r8), pointer :: rofi(:), hrofi(:) real(r8), pointer :: rofl_glc(:), hrofl_glc(:) real(r8), pointer :: rofi_glc(:), hrofi_glc(:) + real(r8), allocatable :: hcorr(:), hrof(:) +!+tht real(r8), pointer :: areas(:) - real(r8), allocatable :: hcorr(:) + real(R8), pointer :: dataptr(:) + real(R8), pointer :: Faxa_hmat (:) + real(R8), pointer :: Faxa_hlat (:) +! if SEPARATE_VARLAT is T then +! do gl.oc.avg for hmat_oa only for the net-mass part, +! and pass in hmat only local variable latent heat correction part + !logical, parameter :: separate_varlat=.true. + logical, parameter :: separate_varlat=.false. ! set to F to regress to 20250609 + real(r8), allocatable :: acorr(:) +!-tht type(med_fldlist_type), pointer :: fldList character(len=*), parameter :: subname='(med_phases_prep_ocn_accum)' !--------------------------------------- @@ -160,62 +175,54 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) ! 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 - + 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 (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 @@ -227,12 +234,10 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) 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 + if (FB_fldchk(is_local%wrap%FBExp(compatm), 'Faxx_goef', rc=rc)) then !+tht goef allocate(hcorr(size(tocn))) glob_area_inv = 1._r8 / (4._r8 * shr_const_pi) areas => is_local%wrap%mesh_info(compocn)%areas @@ -244,9 +249,98 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return deallocate(hcorr) end if - end if +!+tht + if(FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_hmat', rc=rc) & + .and.FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_hlat', rc=rc)) then + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Faxa_hmat', Faxa_hmat, rc=rc) + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Faxa_hlat', Faxa_hlat, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBImp(compocn,compocn), 'So_t', tocn, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + areas => is_local%wrap%mesh_info(compocn)%areas + allocate(hcorr(size(tocn))) + allocate(acorr(size(tocn))) + allocate(hrof (size(tocn))) +if(separate_varlat) then + if(FB_fldchk(is_local%wrap%FBExp(compocn),'Foxx_rofl' ,rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn),'Foxx_rofi' ,rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn),'Forr_rofl_glc',rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn),'Forr_rofi_glc',rc=rc) & + ) then + call FB_GetFldPtr(is_local%wrap%FBExp(compocn),'Foxx_rofl' , rofl ,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),'Forr_rofl_glc', rofl_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 + do n = 1,size(tocn) + hrof(n) = shr_const_cpfw * (tocn(n) - shr_const_tkfrz) * rofl (n) & + + shr_const_cpice * (tocn(n) - shr_const_tkfrz) * rofi (n) & + + shr_const_cpfw * (tocn(n) - shr_const_tkfrz) * rofl_glc(n) & + + shr_const_cpice * (tocn(n) - shr_const_tkfrz) * rofi_glc(n) + enddo + else + do n = 1,size(tocn) + hrof(n) = 0._r8 + enddo + endif + do n = 1,size(tocn) +!hrof(n)=0._r8 ! sanity check (regression to blomfx02, no run-off contributions -> OK) + hcorr(n) = areas(n) *(Faxa_hmat(n)-Faxa_hlat(n)+hrof(n)) + acorr(n) = areas(n) + end do + if (FB_fldchk(is_local%wrap%FBExp(compatm), 'Faxx_hrof', rc=rc)) then !+tht goef + hrof(:) = hrof(:)*areas(:) / (4._r8 * shr_const_pi) + call med_phases_prep_atm_enthalpy_runoff(gcomp, hrof, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + deallocate(hrof) + end if +else + do n = 1,size(tocn) + hcorr(n) = areas(n) * Faxa_hmat(n) + acorr(n) = areas(n) + end do +endif + call med_oa_integral(gcomp, hcorr, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ocean_htot_corr(1)=oa_htot(1) + oa_htot(1)=0._r8 + call med_oa_integral(gcomp, acorr, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ocean_atot_corr(1)=oa_htot(1) + !oa_hrof(1)=0._r8 + !call med_oa_integral(gcomp, hrof , rc) + !if (ChkErr(rc,__LINE__,u_FILE_u)) return + !ocean_hrof_corr(1)=oa_hrof(1) + !deallocate(hrof ) + deallocate(hcorr) + deallocate(acorr) + call FB_getfldptr(is_local%wrap%FBExp(compocn), 'Faxa_hmat_oa', dataptr, rc=rc) + if(ocean_atot_corr(1).gt.0._r8) & + dataptr(:) = ocean_htot_corr(1)/ocean_atot_corr(1) +!print*,'global ocn htflx corr:',dataptr(1) +!!!!!!! if(FB_fldchk(is_local%wrap%FBExp(compatm),'Foxx_ihrof',rc=rc) & +!!!!!!! call FB_getfldptr(is_local%wrap%FBExp(compatm), 'Foxx_hrof' , dataptr, rc=rc) +!!!!!!! dataptr(:) = ocean_rof_corr(1)/(4._r8*shr_const_pi) +!!!!!!!print*,'glob.avg. hrof to atm:',dataptr(1) +! hack: replace full mat.enth.flux with variable lat.heats part only in pointer to ocean export +! might add another coupling field later but may not be strictly necessary +if(separate_varlat) then + do n = 1,size(tocn) + Faxa_hmat(n)=Faxa_hlat(n) + end do +else + do n = 1,size(tocn) + Faxa_hmat(n)=0._r8 ! avoid applying twice in BLOM + end do +endif + endif +!-tht + ! custom merges to ocean call med_phases_prep_ocn_custom(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -657,4 +751,33 @@ subroutine med_phases_prep_ocn_custom(gcomp, rc) end subroutine med_phases_prep_ocn_custom + subroutine med_oa_integral (gcomp, hcorr, rc) + use ESMF , only : ESMF_VMAllreduce, ESMF_GridComp, ESMF_GridCompGet, ESMF_REDUCE_SUM, ESMF_SUCCESS + use ESMF , only : ESMF_VM + ! input/output variables + type(ESMF_GridComp) , intent(in) :: gcomp + real(r8) , intent(in) :: hcorr(:) + integer , intent(out) :: rc + ! local variables + type(InternalState) :: is_local + integer :: n + real(r8) :: local_htot(1) + type(ESMF_VM) :: vm + !--------------------------------------- + rc = ESMF_SUCCESS + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (chkErr(rc,__LINE__,u_FILE_u)) return + ! sum contributions to integral + local_htot(1) = 0._r8 + do n = 1,size(hcorr) + local_htot(1) = local_htot(1) + hcorr(n) + end do + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMAllreduce(vm, senddata=local_htot, recvdata=oa_htot, count=1, & + reduceflag=ESMF_REDUCE_SUM, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end subroutine med_oa_integral + end module med_phases_prep_ocn_mod From 5970f6583b44fe6bc5b199d1782bbebb49c6fa14 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 17 Aug 2025 21:26:32 +0200 Subject: [PATCH 02/13] refactor of enthalpy from cam --- cime_config/namelist_definition_drv.xml | 34 +++- mediator/esmFldsExchange_cesm_mod.F90 | 34 +--- mediator/fd_cesm.yaml | 11 +- mediator/med_diag_mod.F90 | 73 +++---- mediator/med_phases_prep_atm_mod.F90 | 25 +-- mediator/med_phases_prep_ocn_mod.F90 | 259 +++++++++++++++--------- 6 files changed, 243 insertions(+), 193 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index b980a2f47..0883f524a 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -663,6 +663,37 @@ + + + + + + logical + control + ALLCOMP_attributes + + if true, the mediator computes enthalpy associated with rain, + snow, etc to send to ocn (in this case MOM6) + + + .false. + .true. + + + + + logical + control + ALLCOMP_attributes + + if true, the atm (in this case cam) computes enthalpy to send to the ocn (in this case BLOM) + + + .true. + .true. + + + @@ -962,12 +993,13 @@ char budget MED_attributes - v0,v1 + v0,v1,v2 currently v0 refers to budgets using POP and v1 refers to budgets using MOM6 v0 + v2 v1 v0 diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 9ee6eadd6..15b1c3c9b 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -1312,32 +1312,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if end if -! logic below weird because of absurdity of global-mean ocean-points-only material enthalpy flux - if (phase == 'advertise') then - call addfld_to(compatm, 'Faxx_goef') - else ! fill with sensible heat here, will be overwritten (globally) in med_phases_prep_atm - 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 addmrg_to(compatm , 'Faxx_goef', & - 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 addmrg_to(compatm , 'Faxx_goef', & - mrg_from=compice, mrg_fld='Faii_sen', mrg_type='merge', mrg_fracname='ifrac') - end if - if (fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_sen', rc=rc)) then - call addmrg_to(compatm , 'Faxx_goef', & - mrg_from=compmed, mrg_fld='Faox_sen', mrg_type='merge', mrg_fracname='ofrac') - end if - end if - end if if (phase == 'advertise') then call addfld_to(compatm, 'Faxx_evap') - call addfld_to(compatm, 'Faox_evap') !+tht + call addfld_to(compatm, 'Faox_evap') call addfld_from(complnd, 'Fall_evap') call addfld_from(compice, 'Faii_evap') - call addfld_aoflux( 'Faox_evap') + call addfld_aoflux('Faox_evap') 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 @@ -1356,9 +1337,8 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if call addmrg_to(compatm , 'Faxx_evap', & mrg_from=compmed, mrg_fld='Faox_evap', mrg_type='merge', mrg_fracname='ofrac') -!+tht unmerged aoflux-only for correct hevap to ocean in cam_out + ! unmerged aoflux-only for correct hevap to ocean in cam_out call addmrg_to(compatm, 'Faox_evap', mrg_from=compmed, mrg_fld='Faox_evap', mrg_type='copy') -!-tht end if end if end if @@ -1915,8 +1895,8 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) mrg_from=compatm, mrg_fld='Faxa_swdn', mrg_type='copy') end if end if -!+tht --------------------------------------------------------------------- - ! to ocn: downward material enthalpy flux + !---------------------------------------------------------------------- + ! to ocn: downward material enthalpy flux from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then call addfld_from(compatm, 'Faxa_hmat') @@ -1924,7 +1904,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addfld_to (compocn, 'Faxa_hmat_oa') ! handled in prep_ocn call addfld_from(compatm, 'Faxa_hlat') call addfld_to (compocn, 'Faxa_hlat') - call addfld_to (compatm, 'Faxx_hrof') ! enthalpy of runoff, computed in med_phases_prep_ocn + call addfld_to (compatm, 'Faxx_hrof') ! enthalpy of runoff, computed in med_phases_prep_ocn else if (fldchk(is_local%wrap%FBImp(compatm, compatm), 'Faxa_hmat', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_hmat', rc=rc)) then @@ -1941,7 +1921,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) !if (fldchk(is_local%wrap%FBExp(compatm),'Faxx_hrof', rc=rc)) & ! call addmap_from(compocn, 'Faxx_hrof', compatm, mapconsf, 'one', atm2ocn_map) end if -!-tht + ! --------------------------------------------------------------------- ! to ocn: net shortwave radiation from med ! --------------------------------------------------------------------- diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index 8ed04fb44..9eff5c91e 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -301,7 +301,7 @@ canonical_units: W m-2 description: atm import to med mean downward LW heat flux - #+tht + # - standard_name: Faxa_hmat alias: mean_down_hmat canonical_units: W m-2 @@ -319,7 +319,7 @@ canonical_units: W m-2 description: med export to ocn mean downw. mat. enth. flux, ocean average - #-tht + # - standard_name: Faxa_ndep canonical_units: kg(N)/m2/sec description: atm import to med - currently nhx and noy @@ -541,11 +541,6 @@ canonical_units: W m-2 description: atm export from med - merged sensible heat flux # - - standard_name: Faxx_goef - alias: wrong_fixer_busts_energy - canonical_units: W m-2 - description: atm export from med - wrong atm fixer for ocn mat.enthalpy - # - standard_name: Faxx_taux alias: mean_zonal_moment_flx canonical_units: N m-2 @@ -1039,7 +1034,7 @@ alias: heat_content_cond canonical_units: W m-2 description: med export to ocn heat content of condensation - #+tht + # - standard_name: Faxx_hrof alias: heat_content_rof canonical_units: W m-2 diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index b8675eb27..16ba6b755 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -143,10 +143,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 -!+tht - integer :: f_heat_goef = unset_index ! heat : bad global ocean enthalpy fixer integer :: f_heat_hmat = unset_index ! heat : surface material enthalpy flux -!-tht 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 @@ -329,27 +326,22 @@ subroutine med_diag_init(gcomp, rc) 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_sen ,'hsen' ) ! field heat : sensible -!+tht N.B. HMAT from atmo, GOEF from med; they shouldn't be both /=0. - call add_to_budget_diag(budget_diags%fields, f_heat_goef ,'goef' ) ! field heat : bad gl. ocn enth. fixer - call add_to_budget_diag(budget_diags%fields, f_heat_hmat ,'hmat' ) ! field heat : surf. mat. enthalpy flux -!-tht if (trim(budget_table_version) == 'v0') then f_heat_beg = f_heat_frz ! field first index for heat -!+tht - !f_heat_end = f_heat_sen ! field last index for heat - f_heat_end = f_heat_hmat ! field last index for heat -!-tht + 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 -!tht: N.B. if hmat/=0, all other terms here must be zero. - call add_to_budget_diag(budget_diags%fields, f_heat_hmat ,'hmat' ) !+tht: f.heat : surf. mat. enthalpy flux 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 ! field last index for heat + else if (trim(budget_table_version) == 'v2') then + call add_to_budget_diag(budget_diags%fields, f_heat_hmat ,'hmat' ) ! field heat : surf. mat. enthalpy flux + f_heat_beg = f_heat_frz ! field first index for heat + f_heat_end = f_heat_hmat ! field last index for heat end if ! ----------------------------------------- @@ -732,6 +724,11 @@ subroutine med_phases_diag_atm(gcomp, rc) call diag_atm_recv(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowl', f_watr_snow, & areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (trim(budget_table_version) == 'v2') then + call diag_atm_recv(is_local%wrap%FBImp(compatm,compatm), 'Faxa_hmat', f_heat_hmat, & + areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if if (flds_wiso) then call diag_atm_wiso_recv(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainc_wiso', & @@ -775,15 +772,6 @@ subroutine med_phases_diag_atm(gcomp, rc) call diag_atm_send(is_local%wrap%FBExp(compatm), 'Faxx_sen', f_heat_sen, & areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return -!+tht - call diag_atm_send(is_local%wrap%FBExp(compatm), 'Faxx_goef', f_heat_goef, & - areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - !not sure about this - !call diag_atm_send(is_local%wrap%FBExp(compatm), 'Faxa_hmat', f_heat_hmat, & - ! areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return -!-tht call diag_atm_send(is_local%wrap%FBExp(compatm), 'Faxx_evap', f_watr_evap, & areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1607,24 +1595,29 @@ subroutine med_phases_diag_ocn( gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if -!tht: some logic and code is required here to set correct ocn budget using surface material enthalpy -! fluxes computed in atmosphere and passed to med (Faxa_hmat) or its global-ocean average (Faxa_hmat_oa) - 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) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hevap', f_heat_evap , ic, areas, sfrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hcond', f_heat_cond , 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', 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_hrofi', f_heat_rofi , ic, areas, sfrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - !I'm putting a placeholder here as a reminder -- for now as don't know how it's/should be used this is c'd out - !call diag_ocn(is_local%wrap%FBImp(compatm,compocn), 'Faxa_hmat', f_heat_hmat, ic, areas, ofrac, budget_local, rc=rc) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return -!-tht + if (trim(budget_table_version) == 'v1') then + 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) + + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hevap', f_heat_evap , ic, areas, sfrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hcond', f_heat_cond , 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', 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_hrofi', f_heat_rofi , ic, areas, sfrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + if (trim(budget_table_version) == 'v2') then + ! f_heat_hmat to ocean is sum of contribution from two terms + call diag_ocn(is_local%wrap%FBExp(compocn), 'Faxa_hmat', f_heat_hmat , ic, areas, sfrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call diag_ocn(is_local%wrap%FBExp(compocn), 'Faxa_hmat_oa', f_heat_hmat , ic, areas, sfrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if 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_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index 30d6b40a3..28363b86a 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -31,8 +31,8 @@ module med_phases_prep_atm_mod public :: med_phases_prep_atm_enthalpy_correction public :: med_phases_prep_atm_enthalpy_runoff - real(r8), public :: global_htot_corr(1) = 0._r8 ! enthalpy correction from med_phases_prep_ocn - real(r8), public :: global_hrof_corr(1) = 0._r8 ! enthalpy of run-off from med_phases_prep_ocn + real(r8) :: global_htot_corr(1) = 0._r8 ! enthalpy correction from med_phases_prep_ocn + real(r8) :: global_hrof_corr(1) = 0._r8 ! enthalpy of run-off 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'/) @@ -232,20 +232,14 @@ subroutine med_phases_prep_atm(gcomp, rc) end if end do -!+tht: Adding enthalpy correction to sensible heat is never appropriate - !if (FB_FldChk(is_local%wrap%FBExp(compatm), 'Faxx_sen', rc=rc)) then - ! call FB_getfldptr(is_local%wrap%FBExp(compatm), 'Faxx_sen', dataptr1, rc=rc) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! do n = 1,size(dataptr1) - ! dataptr1(n) = dataptr1(n) + global_htot_corr(1) - ! end do - !end if - ! instead, pass extra coupling fiels to atmosphere and decide there to use it (NCAR code) or not (best) - if (FB_FldChk(is_local%wrap%FBExp(compatm), 'Faxx_goef', rc=rc)) then - call FB_getfldptr(is_local%wrap%FBExp(compatm), 'Faxx_goef', dataptr1, rc=rc) + ! Only do the following correction if the mediator is computing the enthalpy to be sent to the ocean + ! from rain, snow, etc. + if ( FB_FldChk(is_local%wrap%FBExp(compatm), 'Faxx_sen' , rc=rc) .and. & + .not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_hmat', rc=rc)) then + call FB_getfldptr(is_local%wrap%FBExp(compatm), 'Faxx_sen', dataptr1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return do n = 1,size(dataptr1) - dataptr1(n) = global_htot_corr(1) + dataptr1(n) = dataptr1(n) + global_htot_corr(1) end do end if if (FB_FldChk(is_local%wrap%FBExp(compatm), 'Faxx_hrof', rc=rc)) then @@ -255,7 +249,6 @@ subroutine med_phases_prep_atm(gcomp, rc) dataptr1(n) = global_hrof_corr(1) end do end if -!-tht ! Check for nans in fields export to atm call FB_check_for_nans(is_local%wrap%FBExp(compatm), maintask, logunit, rc=rc) @@ -315,7 +308,7 @@ subroutine med_phases_prep_atm_enthalpy_correction (gcomp, hcorr, rc) end subroutine med_phases_prep_atm_enthalpy_correction !----------------------------------------------------------------------------- - subroutine med_phases_prep_atm_enthalpy_runoff (gcomp, hcorr, rc) + subroutine med_phases_prep_atm_enthalpy_runoff(gcomp, hcorr, rc) 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 b6736b5a2..d7e7a1453 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -4,6 +4,7 @@ module med_phases_prep_ocn_mod ! Mediator phases for preparing ocn export from mediator !----------------------------------------------------------------------------- + use shr_log_mod , only : shr_log_error 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 @@ -33,8 +34,8 @@ module med_phases_prep_ocn_mod private :: med_phases_prep_ocn_custom - !+tht ocean surface enthalpy flux correction - real(r8), public :: ocean_htot_corr(1)=0._r8, ocean_atot_corr(1)=0._r8, oa_htot(1)=0._r8 + logical :: med_computes_enthalpy_flux + logical :: atm_computes_enthalpy_flux character(*), parameter :: u_FILE_u = & __FILE__ @@ -45,6 +46,7 @@ module med_phases_prep_ocn_mod subroutine med_phases_prep_ocn_init(gcomp, rc) + use NUOPC , only : NUOPC_CompAttributeGet use ESMF , only : ESMF_GridComp, ESMF_SUCCESS use med_methods_mod , only : FB_Init => med_methods_FB_init @@ -54,6 +56,8 @@ subroutine med_phases_prep_ocn_init(gcomp, rc) ! local variables type(InternalState) :: is_local + character(len=CL) :: cvalue + logical :: isPresent, IsSet character(len=*),parameter :: subname=' (med_phases_prep_ocn_init) ' !--------------------------------------- @@ -74,6 +78,24 @@ subroutine med_phases_prep_ocn_init(gcomp, rc) call FB_reset(is_local%wrap%FBExpAccumOcn, value=czero, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(gcomp, name="med_computes_enthalpy_flux", value=cvalue, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) med_computes_enthalpy_flux + else + med_computes_enthalpy_flux = .false. + end if + + call NUOPC_CompAttributeGet(gcomp, name="atm_computes_enthalpy_flux", value=cvalue, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) atm_computes_enthalpy_flux + else + atm_computes_enthalpy_flux = .false. + end if + end subroutine med_phases_prep_ocn_init !----------------------------------------------------------------------------- @@ -103,18 +125,20 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) real(r8), pointer :: rofl_glc(:), hrofl_glc(:) real(r8), pointer :: rofi_glc(:), hrofi_glc(:) real(r8), allocatable :: hcorr(:), hrof(:) -!+tht real(r8), pointer :: areas(:) - real(R8), pointer :: dataptr(:) - real(R8), pointer :: Faxa_hmat (:) - real(R8), pointer :: Faxa_hlat (:) -! if SEPARATE_VARLAT is T then -! do gl.oc.avg for hmat_oa only for the net-mass part, -! and pass in hmat only local variable latent heat correction part - !logical, parameter :: separate_varlat=.true. - logical, parameter :: separate_varlat=.false. ! set to F to regress to 20250609 + real(r8), pointer :: dataptr(:) + real(r8), pointer :: Faxa_hmat (:) + real(r8), pointer :: Faxa_hlat (:) + real(r8), allocatable :: hrof2atm(:) + real(r8) :: ocean_htot_corr(1) + real(r8) :: ocean_atot_corr(1) + + ! if separate_varlat is true then do global ocean average for + ! hmat_oa only for the net-mass part, and pass in hmat only local + ! variable latent heat correction part + logical, parameter :: separate_varlat=.true. real(r8), allocatable :: acorr(:) -!-tht + type(med_fldlist_type), pointer :: fldList character(len=*), parameter :: subname='(med_phases_prep_ocn_accum)' !--------------------------------------- @@ -191,6 +215,10 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) 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 + ! Error check + if ( .not. med_computes_enthalpy_flux) then + call shr_log_error(trim(subname)//' ERROR: med_computes_enthalpy_flux must be true, aborting ', rc=rc) + end if 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) @@ -234,10 +262,10 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) 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_goef', rc=rc)) then !+tht goef + if (FB_fldchk(is_local%wrap%FBExp(compatm), 'Faxx_sen', rc=rc)) then + ! 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 allocate(hcorr(size(tocn))) glob_area_inv = 1._r8 / (4._r8 * shr_const_pi) areas => is_local%wrap%mesh_info(compocn)%areas @@ -249,97 +277,119 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return deallocate(hcorr) end if - end if + end if ! condition for using global energy fixer -!+tht - if(FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_hmat', rc=rc) & - .and.FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_hlat', rc=rc)) then + ! Newer enthalpy terms from atm + if( FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_hmat', rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_hlat', rc=rc)) then + if ( .not. atm_computes_enthalpy_flux) then + call shr_log_error(trim(subname)//' ERROR: atm_computes_enthalpy_flux must be true, aborting ', rc=rc) + end if call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Faxa_hmat', Faxa_hmat, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Faxa_hlat', Faxa_hlat, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call FB_GetFldPtr(is_local%wrap%FBImp(compocn,compocn), 'So_t', tocn, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + areas => is_local%wrap%mesh_info(compocn)%areas + + ! if separate_varlat is true then do global ocean average only for the + ! net-mass part, and pass in as hmat only the local variable latent heat correction part + if (separate_varlat) then + !----------------------- + ! Determine enthalpy due to ocean river input + !----------------------- + allocate(hrof (size(tocn))) + if ( FB_fldchk(is_local%wrap%FBExp(compocn),'Foxx_rofl' ,rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn),'Foxx_rofi' ,rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn),'Forr_rofl_glc',rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn),'Forr_rofi_glc',rc=rc) ) then + + call FB_GetFldPtr(is_local%wrap%FBExp(compocn),'Foxx_rofl' , rofl ,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),'Forr_rofl_glc', rofl_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 + do n = 1,size(tocn) + hrof(n) = shr_const_cpfw * (tocn(n) - shr_const_tkfrz) * rofl(n) & + + shr_const_cpice * (tocn(n) - shr_const_tkfrz) * rofi(n) & + + shr_const_cpfw * (tocn(n) - shr_const_tkfrz) * rofl_glc(n) & + + shr_const_cpice * (tocn(n) - shr_const_tkfrz) * rofi_glc(n) + enddo + else + do n = 1,size(tocn) + hrof(n) = 0._r8 + enddo + endif + + ! send back to atm if requested by atm + if (FB_fldchk(is_local%wrap%FBExp(compatm), 'Faxx_hrof', rc=rc)) then + allocate(hrof2atm(size(tocn))) + hrof2atm(:) = hrof(:)*areas(:) / (4._r8 * shr_const_pi) + + ! determine module variable global_hrof_corr in med_phases_prep_atm_mod + call med_phases_prep_atm_enthalpy_runoff(gcomp, hrof2atm, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end if + + !----------------------- + ! Compute Faxa_hmat_oa + !----------------------- + + ! Determine hcorr and acorr allocate(hcorr(size(tocn))) allocate(acorr(size(tocn))) - allocate(hrof (size(tocn))) -if(separate_varlat) then - if(FB_fldchk(is_local%wrap%FBExp(compocn),'Foxx_rofl' ,rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn),'Foxx_rofi' ,rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn),'Forr_rofl_glc',rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn),'Forr_rofi_glc',rc=rc) & - ) then - call FB_GetFldPtr(is_local%wrap%FBExp(compocn),'Foxx_rofl' , rofl ,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),'Forr_rofl_glc', rofl_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 - do n = 1,size(tocn) - hrof(n) = shr_const_cpfw * (tocn(n) - shr_const_tkfrz) * rofl (n) & - + shr_const_cpice * (tocn(n) - shr_const_tkfrz) * rofi (n) & - + shr_const_cpfw * (tocn(n) - shr_const_tkfrz) * rofl_glc(n) & - + shr_const_cpice * (tocn(n) - shr_const_tkfrz) * rofi_glc(n) - enddo + if (separate_varlat) then + do n = 1,size(tocn) + hcorr(n) = areas(n) *(Faxa_hmat(n) - Faxa_hlat(n) + hrof(n)) + acorr(n) = areas(n) + end do else - do n = 1,size(tocn) - hrof(n) = 0._r8 - enddo + do n = 1,size(tocn) + hcorr(n) = areas(n) * Faxa_hmat(n) + acorr(n) = areas(n) + end do endif - do n = 1,size(tocn) -!hrof(n)=0._r8 ! sanity check (regression to blomfx02, no run-off contributions -> OK) - hcorr(n) = areas(n) *(Faxa_hmat(n)-Faxa_hlat(n)+hrof(n)) - acorr(n) = areas(n) - end do - if (FB_fldchk(is_local%wrap%FBExp(compatm), 'Faxx_hrof', rc=rc)) then !+tht goef - hrof(:) = hrof(:)*areas(:) / (4._r8 * shr_const_pi) - call med_phases_prep_atm_enthalpy_runoff(gcomp, hrof, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - deallocate(hrof) - end if -else - do n = 1,size(tocn) - hcorr(n) = areas(n) * Faxa_hmat(n) - acorr(n) = areas(n) - end do -endif - call med_oa_integral(gcomp, hcorr, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ocean_htot_corr(1)=oa_htot(1) - oa_htot(1)=0._r8 - call med_oa_integral(gcomp, acorr, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ocean_atot_corr(1)=oa_htot(1) - !oa_hrof(1)=0._r8 - !call med_oa_integral(gcomp, hrof , rc) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return - !ocean_hrof_corr(1)=oa_hrof(1) - !deallocate(hrof ) + deallocate(hrof) + + ! Compute global integral of hcorr - ocean_oa_htot + call med_oa_integral(gcomp, hcorr, ocean_htot_corr, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return deallocate(hcorr) + + ! Compute global integral of acorr - ocean_atot_corr + call med_oa_integral(gcomp, acorr, ocean_atot_corr, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return deallocate(acorr) + + ! Set value of Faxa_hmat_oa to ratio of ocean_htot_corr and ocean_atot_corr call FB_getfldptr(is_local%wrap%FBExp(compocn), 'Faxa_hmat_oa', dataptr, rc=rc) - if(ocean_atot_corr(1).gt.0._r8) & - dataptr(:) = ocean_htot_corr(1)/ocean_atot_corr(1) -!print*,'global ocn htflx corr:',dataptr(1) -!!!!!!! if(FB_fldchk(is_local%wrap%FBExp(compatm),'Foxx_ihrof',rc=rc) & -!!!!!!! call FB_getfldptr(is_local%wrap%FBExp(compatm), 'Foxx_hrof' , dataptr, rc=rc) -!!!!!!! dataptr(:) = ocean_rof_corr(1)/(4._r8*shr_const_pi) -!!!!!!!print*,'glob.avg. hrof to atm:',dataptr(1) -! hack: replace full mat.enth.flux with variable lat.heats part only in pointer to ocean export -! might add another coupling field later but may not be strictly necessary -if(separate_varlat) then - do n = 1,size(tocn) - Faxa_hmat(n)=Faxa_hlat(n) - end do -else - do n = 1,size(tocn) - Faxa_hmat(n)=0._r8 ! avoid applying twice in BLOM - end do -endif + if (ocean_atot_corr(1) > 0._r8) then + dataptr(:) = ocean_htot_corr(1)/ocean_atot_corr(1) + end if + + !----------------------- + ! replace full material enthalpy flux with variable latent + ! heats part only in pointer to ocean export + !----------------------- + + ! might add another coupling field later but may not be strictly necessary + if (separate_varlat) then + do n = 1,size(tocn) + Faxa_hmat(n) = Faxa_hlat(n) + end do + else + do n = 1,size(tocn) + Faxa_hmat(n) = 0._r8 ! avoid applying twice for some ocean components such as BLOM + end do + endif + endif -!-tht ! custom merges to ocean call med_phases_prep_ocn_custom(gcomp, rc) @@ -751,31 +801,38 @@ subroutine med_phases_prep_ocn_custom(gcomp, rc) end subroutine med_phases_prep_ocn_custom - subroutine med_oa_integral (gcomp, hcorr, rc) - use ESMF , only : ESMF_VMAllreduce, ESMF_GridComp, ESMF_GridCompGet, ESMF_REDUCE_SUM, ESMF_SUCCESS - use ESMF , only : ESMF_VM + !----------------------------------------------------------------------------- + subroutine med_oa_integral (gcomp, local_array, global_integral, rc) + + use ESMF , only : ESMF_VMAllreduce, ESMF_GridComp, ESMF_GridCompGet, ESMF_REDUCE_SUM, ESMF_SUCCESS + use ESMF , only : ESMF_VM + ! input/output variables type(ESMF_GridComp) , intent(in) :: gcomp - real(r8) , intent(in) :: hcorr(:) + real(r8) , intent(in) :: local_array(:) + real(r8) , intent(out) :: global_integral(1) integer , intent(out) :: rc + ! local variables type(InternalState) :: is_local integer :: n - real(r8) :: local_htot(1) + real(r8) :: local_sum(1) type(ESMF_VM) :: vm !--------------------------------------- + rc = ESMF_SUCCESS + nullify(is_local%wrap) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (chkErr(rc,__LINE__,u_FILE_u)) return ! sum contributions to integral - local_htot(1) = 0._r8 - do n = 1,size(hcorr) - local_htot(1) = local_htot(1) + hcorr(n) + local_sum(1) = 0._r8 + do n = 1,size(local_array) + local_sum(1) = local_sum(1) + local_array(n) end do call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMAllreduce(vm, senddata=local_htot, recvdata=oa_htot, count=1, & + call ESMF_VMAllreduce(vm, senddata=local_sum, recvdata=global_integral, count=1, & reduceflag=ESMF_REDUCE_SUM, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end subroutine med_oa_integral From 84c3eb390e6e48082faee5ceeed99e19024ee5d6 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 1 Sep 2025 16:23:33 +0200 Subject: [PATCH 03/13] fixed budget calculations --- mediator/med_diag_mod.F90 | 41 ++++++++++++++++++++++++++------------- 1 file changed, 28 insertions(+), 13 deletions(-) diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index 16ba6b755..f924a9c62 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -143,13 +143,14 @@ 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_hmat = unset_index ! heat : surface material enthalpy flux 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_rofi = unset_index ! heat : heat content of ice runoff + integer :: f_heat_rofa = unset_index ! heat : total heat content of runoff to atm (v2) + integer :: f_heat_hmat = unset_index ! heat : surface material enthalpy flux (v2) integer :: f_watr_frz = unset_index ! water: freezing integer :: f_watr_melt = unset_index ! water: melting @@ -339,6 +340,7 @@ subroutine med_diag_init(gcomp, rc) f_heat_beg = f_heat_frz ! field first index for heat f_heat_end = f_heat_rofi ! field last index for heat else if (trim(budget_table_version) == 'v2') then + call add_to_budget_diag(budget_diags%fields, f_heat_rofa ,'hrofa' ) ! field heat : total enthalpy of runoff to atm call add_to_budget_diag(budget_diags%fields, f_heat_hmat ,'hmat' ) ! field heat : surf. mat. enthalpy flux f_heat_beg = f_heat_frz ! field first index for heat f_heat_end = f_heat_hmat ! field last index for heat @@ -724,6 +726,7 @@ subroutine med_phases_diag_atm(gcomp, rc) call diag_atm_recv(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowl', f_watr_snow, & areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (trim(budget_table_version) == 'v2') then call diag_atm_recv(is_local%wrap%FBImp(compatm,compatm), 'Faxa_hmat', f_heat_hmat, & areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) @@ -764,18 +767,24 @@ subroutine med_phases_diag_atm(gcomp, rc) end do call diag_atm_send(is_local%wrap%FBExp(compatm), 'Faxx_lwup', f_heat_lwup, & - areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) + areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, component_contribution=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call diag_atm_send(is_local%wrap%FBExp(compatm), 'Faxx_lat', f_heat_latvap, & - areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) + areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, component_contribution=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call diag_atm_send(is_local%wrap%FBExp(compatm), 'Faxx_sen', f_heat_sen, & - areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) + areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, component_contribution=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call diag_atm_send(is_local%wrap%FBExp(compatm), 'Faxx_evap', f_watr_evap, & - areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) + areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, component_contribution=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (trim(budget_table_version) == 'v2') then + call diag_atm_send(is_local%wrap%FBExp(compatm), 'Faxx_hrof', f_heat_rofa, & + areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, component_contribution=.false., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + ! water isotopes if (flds_wiso) then call diag_atm_wiso_send(is_local%wrap%FBImp(compatm,compatm), 'Faxa_evap_wiso', & @@ -823,7 +832,8 @@ subroutine diag_atm_recv(FB, fldname, nf, areas, lats, afrac, lfrac, ofrac, ifra end if end subroutine diag_atm_recv - subroutine diag_atm_send(FB, fldname, nf, areas, lats, afrac, lfrac, ofrac, ifrac, budget, rc) + subroutine diag_atm_send(FB, fldname, nf, areas, lats, afrac, lfrac, ofrac, ifrac, budget, & + component_contribution, rc) ! input/output variables type(ESMF_FieldBundle) , intent(in) :: FB character(len=*) , intent(in) :: fldname @@ -835,6 +845,7 @@ subroutine diag_atm_send(FB, fldname, nf, areas, lats, afrac, lfrac, ofrac, ifra real(r8) , intent(in) :: ofrac(:) real(r8) , intent(in) :: ifrac(:) real(r8) , intent(inout) :: budget(:,:,:) + logical , intent(in) :: component_contribution integer , intent(out) :: rc ! local variables integer :: n, ip @@ -847,14 +858,18 @@ subroutine diag_atm_send(FB, fldname, nf, areas, lats, afrac, lfrac, ofrac, ifra ip = period_inst do n = 1,size(data) budget(nf,c_atm_send,ip) = budget(nf,c_atm_send,ip) - areas(n)*data(n)*afrac(n) - budget(nf,c_lnd_asend,ip) = budget(nf,c_lnd_asend,ip) + areas(n)*data(n)*lfrac(n) - budget(nf,c_ocn_asend,ip) = budget(nf,c_ocn_asend,ip) + areas(n)*data(n)*ofrac(n) - if (lats(n) > 0.0_r8) then - budget(nf,c_inh_asend,ip) = budget(nf,c_inh_asend,ip) + areas(n)*data(n)*ifrac(n) - else - budget(nf,c_ish_asend,ip) = budget(nf,c_ish_asend,ip) + areas(n)*data(n)*ifrac(n) - end if end do + if (component_contribution) then + do n = 1,size(data) + budget(nf,c_lnd_asend,ip) = budget(nf,c_lnd_asend,ip) + areas(n)*data(n)*lfrac(n) + budget(nf,c_ocn_asend,ip) = budget(nf,c_ocn_asend,ip) + areas(n)*data(n)*ofrac(n) + if (lats(n) > 0.0_r8) then + budget(nf,c_inh_asend,ip) = budget(nf,c_inh_asend,ip) + areas(n)*data(n)*ifrac(n) + else + budget(nf,c_ish_asend,ip) = budget(nf,c_ish_asend,ip) + areas(n)*data(n)*ifrac(n) + end if + end do + end if end if end subroutine diag_atm_send From 6efc9956307d17797a4c6e33d896e2df701653cf Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 16 Sep 2025 14:40:18 +0200 Subject: [PATCH 04/13] scaling of hmat by ofrac in med_diag_mod.F90 --- mediator/med_diag_mod.F90 | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index f924a9c62..b97feaaa6 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -341,7 +341,7 @@ subroutine med_diag_init(gcomp, rc) f_heat_end = f_heat_rofi ! field last index for heat else if (trim(budget_table_version) == 'v2') then call add_to_budget_diag(budget_diags%fields, f_heat_rofa ,'hrofa' ) ! field heat : total enthalpy of runoff to atm - call add_to_budget_diag(budget_diags%fields, f_heat_hmat ,'hmat' ) ! field heat : surf. mat. enthalpy flux + call add_to_budget_diag(budget_diags%fields, f_heat_hmat ,'hmat' ) ! field heat : surface material enthalpy flux f_heat_beg = f_heat_frz ! field first index for heat f_heat_end = f_heat_hmat ! field last index for heat end if @@ -660,6 +660,7 @@ subroutine med_phases_diag_atm(gcomp, rc) real(r8), pointer :: ofrac(:) real(r8), pointer :: areas(:) real(r8), pointer :: lats(:) + real(r8), pointer :: data(:) character(*), parameter :: subName = '(med_phases_diag_atm) ' !------------------------------------------------------------------------------- @@ -728,9 +729,17 @@ subroutine med_phases_diag_atm(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (trim(budget_table_version) == 'v2') then - call diag_atm_recv(is_local%wrap%FBImp(compatm,compatm), 'Faxa_hmat', f_heat_hmat, & - areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) + ! call diag_atm_recv(is_local%wrap%FBImp(compatm,compatm), 'Faxa_hmat', f_heat_hmat, & + ! areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call fldbun_getdata1d(is_local%wrap%FBImp(compatm,compatm), 'Faxa_hmat', data, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + nf = f_heat_hmat + do n = 1,size(data) + !budget_local(nf,c_atm_recv,ip) = budget_local(nf,c_atm_recv,ip) - areas(n)*data(n)*(ofrac(n)+ifrac(n)) + budget_local(nf,c_atm_recv,ip) = budget_local(nf,c_atm_recv,ip) - areas(n)*data(n)*ofrac(n) + end do end if if (flds_wiso) then From 4bdf713e9869669d1472784d8f79f1efa5b0d992 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sat, 4 Oct 2025 11:35:12 +0200 Subject: [PATCH 05/13] fixed budget tables for budget_table_version=v2 --- cime_config/namelist_definition_drv.xml | 1 - mediator/med_diag_mod.F90 | 14 +++++++------- 2 files changed, 7 insertions(+), 8 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 3450623b4..73f52730a 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -1005,7 +1005,6 @@ v0 v2 v1 - v0 diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index b97feaaa6..600b7a5c0 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -351,19 +351,19 @@ subroutine med_diag_init(gcomp, rc) ! ----------------------------------------- ! Note that this order is important here to determine f_watr_beg and f_watr_end - if (trim(budget_table_version) == 'v0') then + if (trim(budget_table_version) == 'v0' .or. trim(budget_table_version) == 'v2') then !BLOM for v2 call add_to_budget_diag(budget_diags%fields, f_watr_frz ,'wfreeze' ) ! field water: freezing end if call add_to_budget_diag(budget_diags%fields, f_watr_melt ,'wmelt' ) ! field water: melting call add_to_budget_diag(budget_diags%fields, f_watr_rain ,'wrain' ) ! field water: precip, liquid call add_to_budget_diag(budget_diags%fields, f_watr_snow ,'wsnow' ) ! field water: precip, frozen call add_to_budget_diag(budget_diags%fields, f_watr_evap ,'wevap' ) ! field water: evaporation - if (trim(budget_table_version) == 'v0') then + if (trim(budget_table_version) == 'v0' .or. trim(budget_table_version) == 'v2') then !BLOM for v2 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_ioff ,'wfrzrof' ) ! field water: frozen runoff - if (trim(budget_table_version) == 'v0') then + if (trim(budget_table_version) == 'v0' .or. trim(budget_table_version) == 'v2') then f_watr_beg = f_watr_frz ! field firs index for water else f_watr_beg = f_watr_melt ! field firs index for water @@ -1527,7 +1527,7 @@ subroutine med_phases_diag_ocn( gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call diag_ocn(is_local%wrap%FBImp(compatm,compocn), 'Faxa_lwdn', f_heat_lwdn, ic, areas, ofrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - else ! POP + else ! BLOM call diag_ocn(is_local%wrap%FBMed_aoflux_o, 'Faox_lwup' , f_heat_lwup , ic, areas, ofrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call diag_ocn(is_local%wrap%FBExp(compocn), 'Faxa_lwdn' , f_heat_lwdn , ic, areas, sfrac, budget_local, rc=rc) @@ -1539,7 +1539,7 @@ subroutine med_phases_diag_ocn( gcomp, rc) call diag_ocn(is_local%wrap%FBMed_aoflux_o, 'Faox_evap', f_watr_evap , ic, areas, ofrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (fldbun_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_lat', rc=rc)) then ! POP + if (fldbun_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_lat', rc=rc)) then ! BLOM call diag_ocn(is_local%wrap%FBMed_aoflux_o, 'Faox_lat' , f_heat_latvap , ic, areas, ofrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else ! MOM6 @@ -1982,13 +1982,13 @@ 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 - if (trim(budget_table_version) == 'v0') then + if (trim(budget_table_version) == 'v0' .or. trim(budget_table_version) == 'v2') then !BLOM for v2 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 - if (trim(budget_table_version) == 'v0') then + if (trim(budget_table_version) == 'v0' .or. trim(budget_table_version) == 'v2') then !BLOM for v2 budget_local(f_watr_frz ,ic,ip) = budget_local(f_heat_frz ,ic,ip)*HFLXtoWFLX end if From af2c14cee424d061350db0fcc43d60d83366cf98 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sat, 4 Oct 2025 13:28:09 +0200 Subject: [PATCH 06/13] added new v2 logicals that were missing --- mediator/med_diag_mod.F90 | 2 +- mediator/med_phases_prep_ocn_mod.F90 | 6 ++++-- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index 600b7a5c0..27e88ef4b 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -363,7 +363,7 @@ subroutine med_diag_init(gcomp, rc) 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_ioff ,'wfrzrof' ) ! field water: frozen runoff - if (trim(budget_table_version) == 'v0' .or. trim(budget_table_version) == 'v2') then + if (trim(budget_table_version) == 'v0' .or. trim(budget_table_version) == 'v2') then !BLOM for v2 f_watr_beg = f_watr_frz ! field firs index for water else f_watr_beg = f_watr_melt ! field firs index for water diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index d7e7a1453..26be36bf2 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -217,7 +217,8 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) ) then ! Error check if ( .not. med_computes_enthalpy_flux) then - call shr_log_error(trim(subname)//' ERROR: med_computes_enthalpy_flux must be true, aborting ', rc=rc) + call shr_log_error(trim(subname)//' ERROR: med_computes_enthalpy_flux must be true', rc=rc) + return end if call FB_GetFldPtr(is_local%wrap%FBImp(compocn,compocn), 'So_t', tocn, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -283,7 +284,8 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) if( FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_hmat', rc=rc) .and. & FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_hlat', rc=rc)) then if ( .not. atm_computes_enthalpy_flux) then - call shr_log_error(trim(subname)//' ERROR: atm_computes_enthalpy_flux must be true, aborting ', rc=rc) + call shr_log_error(trim(subname)//' ERROR: atm_computes_enthalpy_flux must be true', rc=rc) + return end if call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Faxa_hmat', Faxa_hmat, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return From dd3e7694c4b57c97e357307dc597bfbe6dd85eca Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sat, 4 Oct 2025 16:23:38 +0200 Subject: [PATCH 07/13] changed default to false for atm_computes_enthalpy --- cime_config/buildnml | 7 +++++++ cime_config/namelist_definition_drv.xml | 9 +++------ 2 files changed, 10 insertions(+), 6 deletions(-) diff --git a/cime_config/buildnml b/cime_config/buildnml index 16dc6ac8b..960d2fd3d 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -261,6 +261,13 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): run_startdate = "".join(str(x) for x in case.get_value("RUN_STARTDATE").split("-")) nmlgen.set_value("start_ymd", value=run_startdate) + # -------------------------------- + # Overwrite: budget_table_version if atm computes enthalpy + # -------------------------------- + atm_computes_enthalpy_flux = nmlgen.get_value("atm_computes_enthalpy_flux") + if atm_computes_enthalpy_flux: + nmlgen.set_value("budget_table_version", value="v2") + # -------------------------------- # Overwrite: set tprof_option and tprof_n - if tprof_total is > 0 # -------------------------------- diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 73f52730a..f88acbaac 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -689,8 +689,7 @@ if true, the atm (in this case cam) computes enthalpy to send to the ocn (in this case BLOM) - .true. - .true. + .false. @@ -999,11 +998,10 @@ MED_attributes v0,v1,v2 - currently v0 refers to budgets using POP and v1 refers to budgets using MOM6 + currently v0 refers to budgets using BLOM and v1 refers to budgets using MOM6 v0 - v2 v1 @@ -2479,10 +2477,9 @@ expdef ALLCOMP_attributes - index of scalar containing epbal precipitation factor from ocn (only for POP) + index of scalar containing epbal precipitation factor from ocn (only for BLOM) - 4 4 0 From f2ba901b616839d4315b01d3ce26dfd4be3a2d1e Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 5 Oct 2025 19:09:57 +0200 Subject: [PATCH 08/13] added comment --- mediator/med_phases_prep_atm_mod.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index 28363b86a..eea9be483 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -242,6 +242,8 @@ subroutine med_phases_prep_atm(gcomp, rc) dataptr1(n) = dataptr1(n) + global_htot_corr(1) end do end if + ! Only do the following if the atmosphere is computing the enthalpy to be sent to the ocean + ! from rain, snow, etc. if (FB_FldChk(is_local%wrap%FBExp(compatm), 'Faxx_hrof', rc=rc)) then call FB_getfldptr(is_local%wrap%FBExp(compatm), 'Faxx_hrof', dataptr1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return From 6c90dd39b76846d245f37c148c57af0355a36150 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 10 Oct 2025 10:35:46 +0200 Subject: [PATCH 09/13] changed config variable to enable from cam versus computation in mediator --- cime_config/buildnml | 4 +-- cime_config/namelist_definition_drv.xml | 28 ++++++------------- mediator/med_diag_mod.F90 | 7 +---- mediator/med_phases_prep_ocn_mod.F90 | 37 ++++++++++--------------- 4 files changed, 27 insertions(+), 49 deletions(-) diff --git a/cime_config/buildnml b/cime_config/buildnml index 960d2fd3d..44c87d554 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -264,8 +264,8 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): # -------------------------------- # Overwrite: budget_table_version if atm computes enthalpy # -------------------------------- - atm_computes_enthalpy_flux = nmlgen.get_value("atm_computes_enthalpy_flux") - if atm_computes_enthalpy_flux: + component_computes_enthalpy_flux = nmlgen.get_value("component_computes_enthalpy_flux") + if 'atm' in component_computes_enthalpy_flux: nmlgen.set_value("budget_table_version", value="v2") # -------------------------------- diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index ec5a98751..7bbf0e9f4 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -664,32 +664,22 @@ - + - - logical - control - ALLCOMP_attributes - - if true, the mediator computes enthalpy associated with rain, - snow, etc to send to ocn (in this case MOM6) - - - .false. - .true. - - - - - logical + + char control ALLCOMP_attributes + none,atm,med - if true, the atm (in this case cam) computes enthalpy to send to the ocn (in this case BLOM) + if none, no enthaply flux is computed to send to the ocean, + if atm, the atm (in this case cam) computes enthalpy to send to the ocn (in this case BLOM) + if med, the mediator computes computes enthalpy to send to the ocn (in this case MOM6) - .false. + none + med diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index 27e88ef4b..8902901db 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -720,7 +720,7 @@ subroutine med_phases_diag_atm(gcomp, rc) call diag_atm_recv(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainl', f_watr_rain, & areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Note that passing f_watr_rain twice will just add up contributions from Faxa_snowc and Faxa_snowl + ! Note that passing f_watr_snow twice will just add up contributions from Faxa_snowc and Faxa_snowl call diag_atm_recv(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowc', f_watr_snow, & areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -729,15 +729,10 @@ subroutine med_phases_diag_atm(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (trim(budget_table_version) == 'v2') then - ! call diag_atm_recv(is_local%wrap%FBImp(compatm,compatm), 'Faxa_hmat', f_heat_hmat, & - ! areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbun_getdata1d(is_local%wrap%FBImp(compatm,compatm), 'Faxa_hmat', data, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return nf = f_heat_hmat do n = 1,size(data) - !budget_local(nf,c_atm_recv,ip) = budget_local(nf,c_atm_recv,ip) - areas(n)*data(n)*(ofrac(n)+ifrac(n)) budget_local(nf,c_atm_recv,ip) = budget_local(nf,c_atm_recv,ip) - areas(n)*data(n)*ofrac(n) end do end if diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index 26be36bf2..b4e6fc308 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -34,8 +34,7 @@ module med_phases_prep_ocn_mod private :: med_phases_prep_ocn_custom - logical :: med_computes_enthalpy_flux - logical :: atm_computes_enthalpy_flux + character(len=CS) :: component_computes_enthalpy_flux character(*), parameter :: u_FILE_u = & __FILE__ @@ -78,22 +77,13 @@ subroutine med_phases_prep_ocn_init(gcomp, rc) call FB_reset(is_local%wrap%FBExpAccumOcn, value=czero, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(gcomp, name="med_computes_enthalpy_flux", value=cvalue, & + call NUOPC_CompAttributeGet(gcomp, name="component_computes_enthalpy_flux", value=cvalue, & isPresent=isPresent, isSet=isSet, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (isPresent .and. isSet) then - read(cvalue,*) med_computes_enthalpy_flux + component_computes_enthalpy_flux = trim(cvalue) else - med_computes_enthalpy_flux = .false. - end if - - call NUOPC_CompAttributeGet(gcomp, name="atm_computes_enthalpy_flux", value=cvalue, & - isPresent=isPresent, isSet=isSet, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - read(cvalue,*) atm_computes_enthalpy_flux - else - atm_computes_enthalpy_flux = .false. + component_computes_enthalpy_flux = 'none' end if end subroutine med_phases_prep_ocn_init @@ -194,7 +184,7 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !--------------------------------------- - !--- custom calculations + !--- custom calculation - enthalpy flux computed in mediator !--------------------------------------- ! 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 @@ -216,8 +206,8 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrofi_glc' , rc=rc) & ) then ! Error check - if ( .not. med_computes_enthalpy_flux) then - call shr_log_error(trim(subname)//' ERROR: med_computes_enthalpy_flux must be true', rc=rc) + if (trim(component_computes_enthalpy_flux) /= 'med') then + call shr_log_error(trim(subname)//' ERROR: component_computes_enthalpy_flux must be set to med', rc=rc) return end if call FB_GetFldPtr(is_local%wrap%FBImp(compocn,compocn), 'So_t', tocn, rc=rc) @@ -280,11 +270,13 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) end if end if ! condition for using global energy fixer - ! Newer enthalpy terms from atm + !--------------------------------------- + !--- custom calculation - enthalpy flux obtained from atm + !--------------------------------------- if( FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_hmat', rc=rc) .and. & FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_hlat', rc=rc)) then - if ( .not. atm_computes_enthalpy_flux) then - call shr_log_error(trim(subname)//' ERROR: atm_computes_enthalpy_flux must be true', rc=rc) + if (trim(component_computes_enthalpy_flux) /= 'atm') then + call shr_log_error(trim(subname)//' ERROR: component_computes_enthalpy_flux must be set to atm', rc=rc) return end if call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Faxa_hmat', Faxa_hmat, rc=rc) @@ -342,7 +334,6 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) !----------------------- ! Compute Faxa_hmat_oa !----------------------- - ! Determine hcorr and acorr allocate(hcorr(size(tocn))) allocate(acorr(size(tocn))) @@ -393,7 +384,9 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) endif - ! custom merges to ocean + !--------------------------------------- + !--- custom merges to ocean + !--------------------------------------- call med_phases_prep_ocn_custom(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return From ce9bfd24c8857adf258edeb9c8f00be91cb1692b Mon Sep 17 00:00:00 2001 From: mvertens Date: Wed, 15 Oct 2025 10:11:51 +0200 Subject: [PATCH 10/13] fixed issue from PR review --- cime_config/buildnml | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/cime_config/buildnml b/cime_config/buildnml index 44c87d554..a82d2193a 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -267,6 +267,17 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): component_computes_enthalpy_flux = nmlgen.get_value("component_computes_enthalpy_flux") if 'atm' in component_computes_enthalpy_flux: nmlgen.set_value("budget_table_version", value="v2") + expect( + case.get_value("COMP_ATM") != "cam" and + case.get_value("COMP_OCN") == "mom6", + "Only CAM and BLOM are currently allowed if cam computes enthalpy flux" + ) + elif component_computes_enthalpy_flux == "med": + expect( + case.get_value("COMP_ATM") != "cam" and + case.get_value("COMP_OCN") != "mom6", + "Only CAM and MOM6 are currently allowed if medediator computes enthalpy flux" + ) # -------------------------------- # Overwrite: set tprof_option and tprof_n - if tprof_total is > 0 From 561efe78192218f109f48ef90ae2c6aeeceabd23 Mon Sep 17 00:00:00 2001 From: mvertens Date: Wed, 15 Oct 2025 10:56:07 +0200 Subject: [PATCH 11/13] fixed problem in how ocn2glc coupling was handled --- cime_config/buildnml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/buildnml b/cime_config/buildnml index a82d2193a..617a0e6e8 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -162,7 +162,7 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): # ---------------------------------------------------- # double check if ocn2glc_coupling is set correctly ocn2glc_coupling = nmlgen.get_value("ocn2glc_coupling") - if "ocn2glc_coupling" == ".true.": + if ocn2glc_coupling == ".true.": expect(case.get_value("COMP_OCN") == 'blom' or 'DOCN%MULTILEV' in case.get_value("COMPSET"), "ocn2glc_coupling is only allowed currently if the ocean component is BLOM or if DOCN%MULTILEV is in the compset") From 202528f7ecba24e1ad6265c963247c650a9a555f Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 15 Oct 2025 18:15:46 +0200 Subject: [PATCH 12/13] addressed more issues in the PR --- mediator/med_phases_prep_atm_mod.F90 | 12 +++++++++-- mediator/med_phases_prep_ocn_mod.F90 | 32 ++++++++++++++-------------- 2 files changed, 26 insertions(+), 18 deletions(-) diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index eea9be483..0f031831a 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -273,6 +273,8 @@ subroutine med_phases_prep_atm_enthalpy_correction (gcomp, hcorr, rc) ! 'Foxx_evap','Foxx_hevap','Foxx_hcond','Foxx_rofl', ! 'Foxx_hrofl','Foxx_rofi','Foxx_hrofi','Foxx_rofl_glc', ! 'Foxx_hrofl_glc','Foxx_rofi_glc','Foxx_hrofi_glc' + ! The result is added as a correction to the sensible heat flux sent back to the atm + ! in subroutine med_phases_prep_atm use ESMF , only : ESMF_VMAllreduce, ESMF_GridCompGet, ESMF_REDUCE_SUM use ESMF , only : ESMF_VM @@ -312,8 +314,14 @@ end subroutine med_phases_prep_atm_enthalpy_correction !----------------------------------------------------------------------------- subroutine med_phases_prep_atm_enthalpy_runoff(gcomp, hcorr, rc) - use ESMF , only : ESMF_VMAllreduce, ESMF_GridCompGet, ESMF_REDUCE_SUM - use ESMF , only : ESMF_VM + use ESMF , only : ESMF_VMAllreduce, ESMF_GridCompGet, ESMF_REDUCE_SUM + use ESMF , only : ESMF_VM + + ! Enthalpy of runoff calculated called by med_phases_prep_ocn_accum in + ! med_phases_prep_ocn_mod + ! Note that this is only called if the following fields are in FBExp(compocn) + ! - Faxa_hmat, Faxa_hlat + ! The result (Faxx_hrof) is sent back to the atm in subroutine med_phases_prep_atm ! input/output variables type(ESMF_GridComp) , intent(in) :: gcomp diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index b4e6fc308..1e028f877 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -189,22 +189,22 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) ! 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 + 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 ! Error check if (trim(component_computes_enthalpy_flux) /= 'med') then call shr_log_error(trim(subname)//' ERROR: component_computes_enthalpy_flux must be set to med', rc=rc) From f322cd01fd94d5edd85c31387f2bc3beea160842 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 16 Oct 2025 11:55:39 +0200 Subject: [PATCH 13/13] fixed typos --- cime_config/buildnml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cime_config/buildnml b/cime_config/buildnml index 617a0e6e8..e39153803 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -270,13 +270,13 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): expect( case.get_value("COMP_ATM") != "cam" and case.get_value("COMP_OCN") == "mom6", - "Only CAM and BLOM are currently allowed if cam computes enthalpy flux" + "Only CAM and BLOM are currently allowed if cam computes enthalpy fluxes" ) elif component_computes_enthalpy_flux == "med": expect( case.get_value("COMP_ATM") != "cam" and case.get_value("COMP_OCN") != "mom6", - "Only CAM and MOM6 are currently allowed if medediator computes enthalpy flux" + "Only CAM and MOM6 are currently allowed if mediator computes enthalpy fluxes" ) # --------------------------------