diff --git a/cime_config/config_component_cesm.xml b/cime_config/config_component_cesm.xml index ba4bb69c0..b3becd832 100644 --- a/cime_config/config_component_cesm.xml +++ b/cime_config/config_component_cesm.xml @@ -503,6 +503,8 @@ FALSE TRUE + TRUE + TRUE TRUE TRUE diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 9e41a2459..4ee15aba1 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -1305,6 +1305,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if end if + ! --------------------------------------------------------------------- ! to atm: merged surface temperature and unmerged temperatures from ice and ocn ! --------------------------------------------------------------------- @@ -1751,13 +1752,12 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (phase == 'advertise') then call addfld(fldListFr(compatm)%flds, 'Faxa_rainc') call addfld(fldListFr(compatm)%flds, 'Faxa_rainl') - call addfld(fldListFr(compatm)%flds, 'Faxa_rain' ) call addfld(fldListTo(compocn)%flds, 'Faxa_rain' ) call addfld(fldListFr(compatm)%flds, 'Faxa_snowc') call addfld(fldListFr(compatm)%flds, 'Faxa_snowl') - call addfld(fldListFr(compatm)%flds, 'Faxa_snow' ) call addfld(fldListTo(compocn)%flds, 'Faxa_snow' ) else + ! TODO: why are we not merging Faxa_rain and Faxa_snow if they are sent from atm wiht ofrac ! Note that the mediator atm/ocn flux calculation needs Faxa_rainc for the gustiness parameterization ! which by default is not actually used if ( fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainl', rc=rc) .and. & @@ -1767,10 +1767,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmap(fldListFr(compatm)%flds, 'Faxa_rainc', compocn, mapconsf, 'one', atm2ocn_map) call addmrg(fldListTo(compocn)%flds, 'Faxa_rain' , mrg_from=compatm, mrg_fld='Faxa_rainc:Faxa_rainl', & mrg_type='sum_with_weights', mrg_fracname='ofrac') - else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_rain', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rain', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_rain', compocn, mapconsf, 'one', atm2ocn_map) - call addmrg(fldListTo(compocn)%flds, 'Faxa_rain', mrg_from=compatm, mrg_fld='Faxa_rain', mrg_type='copy') end if if ( fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_snow' , rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowl', rc=rc) .and. & @@ -1779,10 +1775,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmap(fldListFr(compatm)%flds, 'Faxa_snowc', compocn, mapconsf, 'one', atm2ocn_map) call addmrg(fldListTo(compocn)%flds, 'Faxa_snow' , & mrg_from=compatm, mrg_fld='Faxa_snowc:Faxa_snowl', mrg_type='sum_with_weights', mrg_fracname='ofrac') - else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_snow', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snow', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_snow', compocn, mapconsf, 'one', atm2ocn_map) - call addmrg(fldListTo(compocn)%flds, 'Faxa_snow', mrg_from=compatm, mrg_fld='Faxa_snow', mrg_type='copy') end if end if @@ -1790,12 +1782,10 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (phase == 'advertise') then call addfld(fldListFr(compatm)%flds, 'Faxa_rainc_wiso') call addfld(fldListFr(compatm)%flds, 'Faxa_rainl_wiso') - call addfld(fldListFr(compatm)%flds, 'Faxa_rain_wiso' ) call addfld(fldListTo(compocn)%flds, 'Faxa_rain_wiso' ) call addfld(fldListFr(compatm)%flds, 'Faxa_snowc_wiso') call addfld(fldListFr(compatm)%flds, 'Faxa_snowl_wiso') call addfld(fldListFr(compatm)%flds, 'Faxa_snow_wiso' ) - call addfld(fldListTo(compocn)%flds, 'Faxa_snow_wiso' ) else ! Note that the mediator atm/ocn flux calculation needs Faxa_rainc for the gustiness parameterization ! which by default is not actually used @@ -1807,11 +1797,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmrg(fldListTo(compocn)%flds, 'Faxa_rain_wiso' , & mrg_from=compatm, mrg_fld=trim('Faxa_rainc_wiso')//':'//trim('Faxa_rainl_wiso'), & mrg_type='sum_with_weights', mrg_fracname='ofrac') - else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_rain_wiso', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rain_wiso', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_rain_wiso', compocn, mapconsf, 'one', atm2ocn_map) - call addmrg(fldListTo(compocn)%flds, 'Faxa_rain_wiso', & - mrg_from=compatm, mrg_fld='Faxa_rain_wiso', mrg_type='copy') end if if ( fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_snow_wiso', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowl_wiso', rc=rc) .and. & @@ -1821,11 +1806,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmrg(fldListTo(compocn)%flds, 'Faxa_snow_wiso', & mrg_from=compatm, mrg_fld=trim('Faxa_snowc_wiso')//':'//trim('Faxa_snowl_wiso'), & mrg_type='sum_with_weights', mrg_fracname='ofrac') - else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_snow_wiso', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snow_wiso', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_snow_wiso', compocn, mapconsf, 'one', atm2ocn_map) - call addmrg(fldListTo(compocn)%flds, 'Faxa_snow_wiso', & - mrg_from=compatm, mrg_fld='Faxa_snow_wiso', mrg_type='copy') end if end if end if @@ -1967,6 +1947,22 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if + ! --------------------------------------------------------------------- + ! to ocn: enthalpy from atm rain, snow, evaporation + ! to ocn: enthalpy from liquid and ice river runoff + ! to ocn: enthalpy from ice melt + ! --------------------------------------------------------------------- + ! Note - do not need to add addmap or addmrg for the following since they + ! will be computed directly in med_phases_prep_ocn + if (phase == 'advertise') then + call addfld(fldListTo(compocn)%flds, 'Foxx_hrain') + call addfld(fldListTo(compocn)%flds, 'Foxx_hsnow') + call addfld(fldListTo(compocn)%flds, 'Foxx_hevap') + call addfld(fldListTo(compocn)%flds, 'Foxx_hcond') + call addfld(fldListTo(compocn)%flds, 'Foxx_hrofl') + call addfld(fldListTo(compocn)%flds, 'Foxx_hrofi') + end if + ! --------------------------------------------------------------------- ! to ocn: merge zonal and meridional surface stress from ice and (atm or med) ! --------------------------------------------------------------------- diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index 689ee03ac..9196090d8 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -415,52 +415,52 @@ # - standard_name: Faxx_evap canonical_units: kg m-2 s-1 - description: atmosphere import + description: to atm merged water evaporation flux # - standard_name: Faxx_evap_wiso canonical_units: kg m-2 s-1 - description: atmosphere import + description: to atm merged water evaporation flux for 16O, 18O and HDO # - standard_name: Faxx_lat alias: mean_laten_heat_flx canonical_units: W m-2 - description: atmosphere import + description: to to atm merged latent heat flux # - standard_name: Faxx_lwup canonical_units: W m-2 - description: atmosphere import + description: to atm merged outgoing longwave radiation # - standard_name: Faxx_sen alias: mean_sensi_heat_flx canonical_units: W m-2 - description: atmosphere import + description: to atm merged sensible heat flux # - standard_name: Faxx_taux alias: mean_zonal_moment_flx canonical_units: N m-2 - description: atmosphere import - zonal component of momentum flux + description: to atm merged zonal surface stress # - standard_name: Faxx_tauy alias: mean_merid_moment_flx canonical_units: N m-2 - description: atmosphere import - meridional component of momentum flux + description: to atm merged meridional surface stress # - standard_name: Sx_anidf canonical_units: 1 description: atmosphere import + description: to atm merged surface diffuse albedo (near-infrared radiation) # - standard_name: Sx_anidr canonical_units: 1 - description: atmosphere import + description: to atm merged direct surface albedo (near-infrared radiation) # - standard_name: Sx_avsdf canonical_units: 1 - description: atmosphere import + description: to atm merged surface diffuse albedo (visible radation) # - standard_name: Sx_avsdr canonical_units: 1 - description: atmosphere import + description: to atm merged direct surface albedo (visible radiation) # - standard_name: Sx_qref canonical_units: kg kg-1 @@ -983,6 +983,36 @@ # section: ocean import #----------------------------------- # + - standard_name: Foxx_hrain + alias: heat_content_lprec + canonical_units: W m-2 + description: to ocn heat content of rain + # + - standard_name: Foxx_hsnow + alias: heat_content_fprec + canonical_units: W m-2 + description: to ocn heat content of snow + # + - standard_name: Foxx_hevap + alias: heat_content_evap + canonical_units: W m-2 + description: to ocn heat content of evaporation + # + - standard_name: Foxx_hcond + alias: heat_content_cond + canonical_units: W m-2 + description: to ocn heat content of condensation + # + - standard_name: Foxx_hrofl + alias: heat_content_rofl + canonical_units: W m-2 + description: to ocn heat content of liquid runoff + # + - standard_name: Foxx_hrofi + alias: heat_content_rofi + canonical_units: W m-2 + description: to ocn heat content of ice runoff + # - standard_name: Foxx_evap alias: mean_evap_rate canonical_units: kg m-2 s-1 diff --git a/mediator/med.F90 b/mediator/med.F90 index 4ac79c4cf..67b2785c8 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -35,7 +35,6 @@ module MED use med_methods_mod , only : FB_Init => med_methods_FB_init use med_methods_mod , only : FB_Init_pointer => med_methods_FB_Init_pointer use med_methods_mod , only : FB_Reset => med_methods_FB_Reset - use med_methods_mod , only : FB_FldChk => med_methods_FB_FldChk use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose use med_methods_mod , only : FB_getFieldN => med_methods_FB_getFieldN use med_methods_mod , only : clock_timeprint => med_methods_clock_timeprint diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index ca8583803..2792d0a26 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -142,6 +142,13 @@ module med_diag_mod integer :: f_heat_latf = unset_index ! heat : latent, fusion, snow integer :: f_heat_ioff = unset_index ! heat : latent, fusion, frozen runoff integer :: f_heat_sen = unset_index ! heat : sensible + integer :: f_heat_rain = unset_index ! heat : heat content of rain + integer :: f_heat_snow = unset_index ! heat : heat content of snow + integer :: f_heat_evap = unset_index ! heat : heat content of evaporation + 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_watr_frz = unset_index ! water: freezing integer :: f_watr_melt = unset_index ! water: melting integer :: f_watr_rain = unset_index ! water: precip, liquid @@ -264,6 +271,10 @@ subroutine med_diag_init(gcomp, rc) rc = ESMF_SUCCESS + if(mastertask) then + write(logunit,'(a)') ' Creating budget_diags%comps ' + end if + call NUOPC_CompAttributeGet(gcomp, name="budget_table_version", value=cvalue, & isPresent=isPresent, isSet=isSet, rc=rc) if (isPresent .and. isSet) then @@ -314,8 +325,19 @@ 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 - f_heat_beg = f_heat_frz ! field first index for heat - f_heat_end = f_heat_sen ! field last index for heat + 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 + else if (trim(budget_table_version) == 'v1') then + call add_to_budget_diag(budget_diags%fields, f_heat_rain ,'hrain' ) ! field heat : enthalpy of rain + call add_to_budget_diag(budget_diags%fields, f_heat_snow ,'hsnow' ) ! field heat : enthalpy of snow + call add_to_budget_diag(budget_diags%fields, f_heat_evap ,'hevap' ) ! field heat : enthalpy of evaporation + call add_to_budget_diag(budget_diags%fields, f_heat_cond ,'hcond' ) ! field heat : enthalpy of evaporation + call add_to_budget_diag(budget_diags%fields, f_heat_rofl ,'hrofl' ) ! field heat : enthalpy of liquid runoff + call add_to_budget_diag(budget_diags%fields, f_heat_rofi ,'hrofi' ) ! field heat : enthalpy of ice runoff + f_heat_beg = f_heat_frz ! field first index for heat + f_heat_end = f_heat_rofi ! field last index for heat + end if ! ----------------------------------------- ! Water fluxes budget terms @@ -1549,6 +1571,19 @@ 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 + 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 @@ -1897,12 +1932,16 @@ subroutine med_phases_diag_ice_med2ice( gcomp, rc) ic = c_inh_send budget_local(f_heat_latf,ic,ip) = -budget_local(f_watr_snow,ic,ip)*shr_const_latice budget_local(f_heat_ioff,ic,ip) = -budget_local(f_watr_ioff,ic,ip)*shr_const_latice - budget_local(f_watr_frz ,ic,ip) = budget_local(f_heat_frz ,ic,ip)*HFLXtoWFLX + if (trim(budget_table_version) == 'v0') then + budget_local(f_watr_frz ,ic,ip) = budget_local(f_heat_frz ,ic,ip)*HFLXtoWFLX + end if ic = c_ish_send budget_local(f_heat_latf,ic,ip) = -budget_local(f_watr_snow,ic,ip)*shr_const_latice budget_local(f_heat_ioff,ic,ip) = -budget_local(f_watr_ioff,ic,ip)*shr_const_latice - budget_local(f_watr_frz ,ic,ip) = budget_local(f_heat_frz ,ic,ip)*HFLXtoWFLX + if (trim(budget_table_version) == 'v0') then + budget_local(f_watr_frz ,ic,ip) = budget_local(f_heat_frz ,ic,ip)*HFLXtoWFLX + end if if (flds_wiso) then call diag_ice_send_wiso(is_local%wrap%FBExp(compice), 'Faxa_rain_wiso', & diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index d3af6163d..c2e9b4ef5 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -13,6 +13,7 @@ module med_phases_prep_atm_mod use med_utils_mod , only : chkerr => med_utils_ChkErr use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose use med_methods_mod , only : FB_fldchk => med_methods_FB_FldChk + use med_methods_mod , only : FB_getfldptr=> med_methods_FB_GetFldPtr use med_merge_mod , only : med_merge_auto use med_map_mod , only : med_map_field_packed use med_internalstate_mod , only : InternalState, mastertask @@ -26,6 +27,9 @@ module med_phases_prep_atm_mod private public :: med_phases_prep_atm + public :: med_phases_prep_atm_enthalpy_correction + + real(r8), public :: global_htot_corr(1) = 0._r8 ! enthalpy correction from med_phases_prep_ocn character(*), parameter :: u_FILE_u = & __FILE__ @@ -221,6 +225,15 @@ subroutine med_phases_prep_atm(gcomp, rc) end do end if + ! 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) + 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 + if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end if @@ -228,4 +241,48 @@ subroutine med_phases_prep_atm(gcomp, rc) end subroutine med_phases_prep_atm + !----------------------------------------------------------------------------- + subroutine med_phases_prep_atm_enthalpy_correction (gcomp, hcorr, rc) + + ! Enthalpy correction term calculation 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_rain','Foxx_hrain','Faxa_snow' ,'Foxx_hsnow', + ! 'Foxx_evap','Foxx_hevap','Foxx_hcond','Foxx_rofl', + ! 'Foxx_hrofl','Foxx_rofi','Foxx_hrofi' + + 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_htot_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_htot_corr(1) = 0._r8 + do n = 1,size(hcorr) + local_htot_corr(1) = local_htot_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_htot_corr, recvdata=global_htot_corr, count=1, & + reduceflag=ESMF_REDUCE_SUM, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine med_phases_prep_atm_enthalpy_correction + 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 0858462bc..de4599ffb 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -76,9 +76,11 @@ end subroutine med_phases_prep_ocn_init !----------------------------------------------------------------------------- subroutine med_phases_prep_ocn_accum(gcomp, rc) - use ESMF , only : ESMF_GridComp, ESMF_FieldBundleGet - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS - use ESMF , only : ESMF_FAILURE, ESMF_LOGMSG_ERROR + use ESMF , only : ESMF_GridComp, ESMF_FieldBundleGet + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS + use ESMF , only : ESMF_FAILURE, ESMF_LOGMSG_ERROR + use med_constants_mod , only : shr_const_cpsw, shr_const_tkfrz, shr_const_pi + use med_phases_prep_atm_mod , only : med_phases_prep_atm_enthalpy_correction ! input/output variables type(ESMF_GridComp) :: gcomp @@ -87,6 +89,16 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) ! local variables type(InternalState) :: is_local integer :: n, ncnt + real(r8) :: glob_area_inv + real(r8), pointer :: tocn(:) + real(r8), pointer :: rain(:), hrain(:) + real(r8), pointer :: snow(:), hsnow(:) + real(r8), pointer :: evap(:), hevap(:) + real(r8), pointer :: hcond(:) + real(r8), pointer :: rofl(:), hrofl(:) + real(r8), pointer :: rofi(:), hrofi(:) + real(r8), pointer :: areas(:) + real(r8), allocatable :: hcorr(:) character(len=*), parameter :: subname='(med_phases_prep_ocn_accum)' !--------------------------------------- @@ -124,6 +136,80 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if + ! compute enthaly associated with rain, snow, condensation and liquid river runoff + ! the sea-ice model already accounts for the enthalpy flux (as part of melth), so + ! enthalpy from meltw **is not** included below + if ( FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_rain' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrain' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_snow' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hsnow' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_evap' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hevap' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hcond' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofl' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrofl' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofi' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrofi' , rc=rc)) then + + 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 + + do n = 1,size(tocn) + ! Need max to ensure that will not have an enthalpy contribution if the water is below 0C + hrain(n) = max((tocn(n) - shr_const_tkfrz), 0._r8) * rain(n) * shr_const_cpsw + hsnow(n) = min((tocn(n) - shr_const_tkfrz), 0._r8) * snow(n) * shr_const_cpsw + hevap(n) = (tocn(n) - shr_const_tkfrz) * min(evap(n), 0._r8) * shr_const_cpsw + hcond(n) = max((tocn(n) - shr_const_tkfrz), 0._r8) * max(evap(n), 0._r8) * shr_const_cpsw + hrofl(n) = max((tocn(n) - shr_const_tkfrz), 0._r8) * rofl(n) * shr_const_cpsw + hrofi(n) = min((tocn(n) - shr_const_tkfrz), 0._r8) * rofi(n) * shr_const_cpsw + end do + + ! Determine enthalpy correction factor that will be added to the sensible heat flux sent to the atm + ! Areas here in radians**2 - this is an instantaneous snapshot that will be sent to the atm - only + ! need to calculate this if data is sent back to the atm + + if (FB_fldchk(is_local%wrap%FBExp(compatm), 'Faxx_sen', rc=rc)) then + allocate(hcorr(size(tocn))) + glob_area_inv = 1._r8 / (4._r8 * shr_const_pi) + areas => is_local%wrap%mesh_info(compocn)%areas + do n = 1,size(tocn) + hcorr(n) = (hrain(n) + hsnow(n) + hcond(n) + hevap(n) + hrofl(n) + hrofi(n)) * & + areas(n) * glob_area_inv + end do + call med_phases_prep_atm_enthalpy_correction(gcomp, hcorr, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + deallocate(hcorr) + end if + + end if + ! custom merges to ocean if (trim(coupling_mode) == 'cesm') then call med_phases_prep_ocn_custom_cesm(gcomp, rc)