diff --git a/cime_config/buildnml b/cime_config/buildnml
index 16dc6ac8b..e39153803 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")
@@ -261,6 +261,24 @@ 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
+ # --------------------------------
+ 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 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 mediator computes enthalpy fluxes"
+ )
+
# --------------------------------
# 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 6c7a903c2..7bbf0e9f4 100644
--- a/cime_config/namelist_definition_drv.xml
+++ b/cime_config/namelist_definition_drv.xml
@@ -663,6 +663,26 @@
+
+
+
+
+
+ char
+ control
+ ALLCOMP_attributes
+ none,atm,med
+
+ 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)
+
+
+ none
+ med
+
+
+
@@ -980,14 +1000,13 @@
char
budget
MED_attributes
- v0,v1
+ 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
v1
- v0
@@ -2462,10 +2481,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
diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90
index d703fe87f..ae2d68932 100644
--- a/mediator/esmFldsExchange_cesm_mod.F90
+++ b/mediator/esmFldsExchange_cesm_mod.F90
@@ -1315,9 +1315,10 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc)
if (phase == 'advertise') then
call addfld_to(compatm, 'Faxx_evap')
+ 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
@@ -1336,6 +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')
+ ! 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')
end if
end if
end if
@@ -1892,6 +1895,33 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc)
mrg_from=compatm, mrg_fld='Faxa_swdn', mrg_type='copy')
end if
end if
+ !----------------------------------------------------------------------
+ ! to ocn: downward material enthalpy flux from atm
+ ! ---------------------------------------------------------------------
+ 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
+
! ---------------------------------------------------------------------
! to ocn: net shortwave radiation from med
! ---------------------------------------------------------------------
@@ -1932,15 +1962,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 93cad82d5..9eff5c91e 100644
--- a/mediator/fd_cesm.yaml
+++ b/mediator/fd_cesm.yaml
@@ -300,7 +300,25 @@
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
+ #
+ - 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
#
- standard_name: Faxa_ndep
canonical_units: kg(N)/m2/sec
@@ -1017,6 +1035,11 @@
canonical_units: W m-2
description: med export to ocn heat content of condensation
#
+ - 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
canonical_units: W m-2
diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90
index df0d4e351..8902901db 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
@@ -149,6 +149,8 @@ module med_diag_mod
integer :: f_heat_cond = unset_index ! heat : heat content of evaporation
integer :: f_heat_rofl = unset_index ! heat : heat content of liquid runoff
integer :: f_heat_rofi = unset_index ! heat : heat content of ice runoff
+ integer :: f_heat_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
@@ -337,6 +339,11 @@ subroutine med_diag_init(gcomp, rc)
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_rofa ,'hrofa' ) ! field heat : total enthalpy of runoff to atm
+ 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
! -----------------------------------------
@@ -344,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 !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
@@ -516,6 +523,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
@@ -652,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) '
!-------------------------------------------------------------------------------
@@ -711,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
@@ -719,6 +728,15 @@ subroutine med_phases_diag_atm(gcomp, rc)
areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
+ if (trim(budget_table_version) == 'v2') then
+ 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)
+ end do
+ end if
+
if (flds_wiso) then
call diag_atm_wiso_recv(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainc_wiso', &
f_watr_rain_16O, f_watr_rain_18O, f_watr_rain_HDO, areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc)
@@ -753,18 +771,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', &
@@ -812,7 +836,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
@@ -824,6 +849,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
@@ -836,14 +862,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
@@ -1492,7 +1522,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)
@@ -1504,7 +1534,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
@@ -1584,18 +1614,29 @@ subroutine med_phases_diag_ocn( gcomp, rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
end if
- call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hrain', f_heat_rain , ic, areas, sfrac, budget_local, rc=rc)
- if (ChkErr(rc,__LINE__,u_FILE_u)) return
- call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hsnow', f_heat_snow , ic, areas, sfrac, budget_local, rc=rc)
- 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
+ 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
@@ -1936,13 +1977,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
diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90
index bcdf2ea42..0f031831a 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) :: 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'/)
@@ -230,14 +232,25 @@ 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
+ ! 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) = 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
+ do n = 1,size(dataptr1)
+ dataptr1(n) = global_hrof_corr(1)
+ end do
+ end if
! Check for nans in fields export to atm
call FB_check_for_nans(is_local%wrap%FBExp(compatm), maintask, logunit, rc=rc)
@@ -260,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
@@ -273,6 +288,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 +311,47 @@ 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
+
+ ! 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
+ 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..1e028f877 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,6 +34,8 @@ module med_phases_prep_ocn_mod
private :: med_phases_prep_ocn_custom
+ character(len=CS) :: component_computes_enthalpy_flux
+
character(*), parameter :: u_FILE_u = &
__FILE__
@@ -42,6 +45,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
@@ -51,6 +55,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) '
!---------------------------------------
@@ -71,6 +77,15 @@ 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="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
+ component_computes_enthalpy_flux = trim(cvalue)
+ else
+ component_computes_enthalpy_flux = 'none'
+ end if
+
end subroutine med_phases_prep_ocn_init
!-----------------------------------------------------------------------------
@@ -78,8 +93,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 +114,21 @@ 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(:)
real(r8), pointer :: areas(:)
- real(r8), allocatable :: hcorr(:)
+ 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(:)
+
type(med_fldlist_type), pointer :: fldList
character(len=*), parameter :: subname='(med_phases_prep_ocn_accum)'
!---------------------------------------
@@ -155,67 +184,64 @@ 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
! 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)
+ 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
-
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 +253,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
+ ! 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
@@ -244,10 +268,125 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
deallocate(hcorr)
end if
+ end if ! condition for using global energy fixer
- end if
+ !---------------------------------------
+ !--- 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 (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)
+ 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
- ! custom merges to ocean
+ !-----------------------
+ ! Compute Faxa_hmat_oa
+ !-----------------------
+ ! Determine hcorr and acorr
+ allocate(hcorr(size(tocn)))
+ allocate(acorr(size(tocn)))
+ 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)
+ hcorr(n) = areas(n) * Faxa_hmat(n)
+ acorr(n) = areas(n)
+ end do
+ endif
+ 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) > 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
+
+ !---------------------------------------
+ !--- custom merges to ocean
+ !---------------------------------------
call med_phases_prep_ocn_custom(gcomp, rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
@@ -657,4 +796,40 @@ subroutine med_phases_prep_ocn_custom(gcomp, rc)
end subroutine med_phases_prep_ocn_custom
+ !-----------------------------------------------------------------------------
+ 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) :: local_array(:)
+ real(r8) , intent(out) :: global_integral(1)
+ integer , intent(out) :: rc
+
+ ! local variables
+ type(InternalState) :: is_local
+ integer :: n
+ 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_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_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
+
end module med_phases_prep_ocn_mod