Addition of enthalpy fluxes in CESM (#278)

Add ability to send enthalpy fluxes back to MOM6 and at the same time adding a correction term to the sensible heat flux sent back to CAM.

cime_config/config_component_cesm.xml

@@ -503,6 +503,8 @@
     <default_value>FALSE</default_value>
     <values match="last">
       <value compset="DATM.*_POP\d">TRUE</value>
+      <value compset="DATM.*_MOM\d">TRUE</value>
+      <value compset="CAM.*_MOM\d">TRUE</value>
       <value compset="CAM.*_POP\d">TRUE</value>
       <value compset="CAM.*_DOCN%SOM">TRUE</value>
     </values>

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,23 +1775,17 @@ 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
 
     if (flds_wiso) then
        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)
     ! ---------------------------------------------------------------------

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

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

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', &

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,11 +225,64 @@ 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
     call t_stopf('MED:'//subname)
 
   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