diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml
index dec6868f1..472889f5b 100644
--- a/cime_config/namelist_definition_drv.xml
+++ b/cime_config/namelist_definition_drv.xml
@@ -727,6 +727,20 @@
.true.
+
+
+ logical
+ control
+ MED_attributes
+
+ Compute energy of enthalpy
+
+
+ .false.
+ .true.
+
+
+
integer
control
diff --git a/mediator/CMakeLists.txt b/mediator/CMakeLists.txt
index 84f62675e..1ba39999d 100644
--- a/mediator/CMakeLists.txt
+++ b/mediator/CMakeLists.txt
@@ -16,7 +16,8 @@ set(SRCFILES esmFldsExchange_cesm_mod.F90 med_fraction_mod.F90
med_phases_post_ocn_mod.F90 med_phases_ocnalb_mod.F90
med_phases_post_atm_mod.F90 med_phases_post_ice_mod.F90
med_phases_post_lnd_mod.F90 med_phases_post_glc_mod.F90
- med_phases_post_rof_mod.F90 med_phases_post_wav_mod.F90)
+ med_phases_post_rof_mod.F90 med_phases_post_wav_mod.F90
+ med_enthalpy_mod.F90)
foreach(FILE ${SRCFILES})
if(EXISTS "${CASEROOT}/SourceMods/src.cmeps/${FILE}")
diff --git a/mediator/med.F90 b/mediator/med.F90
index 3efc94a6e..1a04c489e 100644
--- a/mediator/med.F90
+++ b/mediator/med.F90
@@ -662,7 +662,8 @@ subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc)
use esmFlds, only : med_fldlist_init1, med_fld_GetFldInfo, med_fldList_entry_type
use med_phases_history_mod, only : med_phases_history_init
use med_methods_mod , only : mediator_checkfornans
-
+ use med_enthalpy_mod , only : mediator_compute_enthalpy
+
! input/output variables
type(ESMF_GridComp) :: gcomp
type(ESMF_State) :: importState, exportState
@@ -935,6 +936,24 @@ subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc)
endif
+ ! Should enthalpy be calculated
+ call NUOPC_CompAttributeGet(gcomp, name="compute_enthalpy", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+ if(isPresent .and. isSet) then
+ read(cvalue, *) mediator_compute_enthalpy
+ else
+ mediator_compute_enthalpy = .false.
+ endif
+ if(maintask) then
+ write(logunit,*) ' compute_enthalpy is ',mediator_compute_enthalpy
+ if(mediator_compute_enthalpy) then
+ write(logunit,*) ' Enthalpy calculation is ON'
+ else
+ write(logunit,*) ' Enthalpy calculation is OFF'
+ endif
+ endif
+
+
if (profile_memory) call ESMF_VMLogMemInfo("Leaving "//trim(subname))
call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO)
diff --git a/mediator/med_enthalpy_mod.F90 b/mediator/med_enthalpy_mod.F90
new file mode 100644
index 000000000..10df74b89
--- /dev/null
+++ b/mediator/med_enthalpy_mod.F90
@@ -0,0 +1,171 @@
+module med_enthalpy_mod
+ use ESMF, only : ESMF_SUCCESS, ESMF_GridComp, ESMF_VMAllreduce, ESMF_REDUCE_SUM
+ use shr_kind_mod, only : R8=>shr_kind_r8
+ use shr_const_mod, only : tkfrz=>shr_const_tkfrz, cpfw=>shr_const_cpfw, cpice=>shr_const_cpice,&
+ cpwv=>shr_const_cpwv, cpsw=>shr_const_cpsw, pi=>shr_const_pi
+ use med_utils_mod , only : chkerr => med_utils_ChkErr
+ use med_methods_mod , only : FB_fldchk => med_methods_FB_FldChk
+ use med_methods_mod , only : FB_GetFldPtr => med_methods_FB_GetFldPtr
+ use med_internalstate_mod, only : compocn, compatm, InternalState
+ use perf_mod, only : t_startf, t_stopf
+
+
+ implicit none
+ public :: med_compute_enthalpy
+
+ real(r8) :: global_htot_corr(1)
+ character(*), parameter :: u_FILE_u = &
+ __FILE__
+contains
+ real(r8) function med_enthalpy_get_global_htot_corr()
+ ! Just return the latest global_htot_corr
+ med_enthalpy_get_global_htot_corr = global_htot_corr(1)
+ end function med_enthalpy_get_global_htot_corr
+
+ subroutine med_compute_enthalpy(is_local, rc)
+ type(InternalState), intent(in) :: is_local
+ integer, intent(out) :: rc
+
+ ! local variables
+
+ real(r8), pointer :: tocn(:), rain(:), snow(:), rofl(:), rofi(:), evap(:)
+ real(r8), pointer :: rainl(:), rainc(:)
+ real(r8), pointer :: snowl(:), snowc(:)
+ real(r8), pointer :: hrain(:), hsnow(:), hevap(:), hcond(:), hrofl(:), hrofi(:)
+ real(r8), allocatable :: hcorr(:)
+ real(r8), pointer :: areas(:)
+ real(r8), parameter :: glob_area_inv = 1._r8 / (4._r8 * pi)
+ real(r8) :: local_htot_corr(1)
+ integer :: n, nmax
+ character(len=*), parameter:: subname = "med_compute_enthalpy"
+
+ call t_startf(subname)
+ rc = ESMF_SUCCESS
+ nmax = size(tocn)
+
+ call FB_GetFldPtr(is_local%wrap%FBImp(compocn,compocn), 'So_t', tocn, rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+
+ if(FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_rain', rc)) then
+ call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Faxa_rain' , rain, rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+ else
+ call FB_GetFldPtr(is_local%wrap%FBImp(compatm, compatm), 'Faxa_rainl', rainl, rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+ call FB_GetFldPtr(is_local%wrap%FBImp(compatm, compatm), 'Faxa_rainl', rainc, rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+ allocate(rain(nmax))
+ rain = rainl + rainc
+ endif
+
+ if(FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrain', rc)) then
+ call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hrain', hrain, rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+ else
+ allocate(hrain(nmax))
+ endif
+
+ if(FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_evap', rc)) then
+ call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_evap' , evap, rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+ else
+ call FB_GetFldPtr(is_local%wrap%FBExp(compatm), 'Faxx_evap' , evap, rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+ endif
+
+ if(FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hevap', rc)) then
+ call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hevap', hevap, rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+ else
+ allocate(hevap(nmax))
+ endif
+ if(FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hcond', rc)) then
+ call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hcond', hcond, rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+ else
+ allocate(hcond(nmax))
+ endif
+
+ if(FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_snow', rc)) then
+ call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Faxa_snow' , snow, rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+ else
+ call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowc' , snowc, rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+ call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowl' , snowl, rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+ allocate(snow(nmax))
+ snow = snowc + snowl
+ endif
+
+ if(FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hsnow', rc)) then
+ call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hsnow', hsnow, rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+ else
+ allocate(hsnow(nmax))
+ endif
+
+ if(FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofl', rc)) then
+ call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_rofl' , rofl, rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+ else
+ endif
+ if(FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrofl', rc)) then
+ call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hrofl', hrofl, rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+ else
+ allocate(hrofl(nmax))
+ endif
+
+ if(FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofi', rc)) then
+ call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_rofi' , rofi, rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+ else
+ endif
+ if(FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrofi', rc)) then
+ call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hrofi', hrofi, rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+ else
+ allocate(hrofi(nmax))
+ endif
+
+ do n = 1,nmax
+ ! Need max to ensure that will not have an enthalpy contribution if the water is below 0C
+ hrain(n) = max((tocn(n) - tkfrz), 0._r8) * rain(n) * cpfw
+ hsnow(n) = min((tocn(n) - tkfrz), 0._r8) * snow(n) * cpice
+ hevap(n) = (tocn(n) - tkfrz) * min(evap(n), 0._r8) * cpwv
+ hcond(n) = (tocn(n) - tkfrz) * max(evap(n), 0._r8) * cpwv
+ hrofl(n) = max((tocn(n) - tkfrz), 0._r8) * rofl(n) * cpsw
+ hrofi(n) = min((tocn(n) - tkfrz), 0._r8) * rofi(n) * cpice
+ ! GMM - note change in hcond
+ 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(nmax))
+ areas => is_local%wrap%mesh_info(compocn)%areas
+ do n = 1,nmax
+ hcorr(n) = (hrain(n) + hsnow(n) + hcond(n) + hevap(n) + hrofl(n) + hrofi(n)) * &
+ areas(n) * glob_area_inv
+ end do
+
+ ! Determine sum of enthalpy correction for each hcorr index locally
+ local_htot_corr(1) = 0._r8
+ do n = 1,size(hcorr)
+ local_htot_corr(1) = local_htot_corr(1) + hcorr(n)
+ end do
+
+ call ESMF_VMAllreduce(is_local%wrap%vm, senddata=local_htot_corr, recvdata=global_htot_corr, count=1, &
+ reduceflag=ESMF_REDUCE_SUM, rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+
+ deallocate(hcorr)
+ endif
+ call t_stopf(subname)
+
+ end subroutine med_compute_enthalpy
+
+end module med_enthalpy_mod
diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90
index 98728a8a6..21037fc34 100644
--- a/mediator/med_phases_prep_atm_mod.F90
+++ b/mediator/med_phases_prep_atm_mod.F90
@@ -23,14 +23,12 @@ module med_phases_prep_atm_mod
use perf_mod , only : t_startf, t_stopf
use med_phases_aofluxes_mod, only : med_aofluxes_map_xgrid2agrid_output
use med_phases_aofluxes_mod, only : med_aofluxes_map_ogrid2agrid_output
+ use med_enthalpy_mod, only : med_enthalpy_get_global_htot_corr, med_compute_enthalpy
implicit none
private
public :: med_phases_prep_atm
- public :: med_phases_prep_atm_enthalpy_correction
-
- real(r8), public :: global_htot_corr(1) = 0._r8 ! enthalpy correction from med_phases_prep_ocn
character(*), parameter :: u_FILE_u = &
__FILE__
@@ -239,8 +237,14 @@ subroutine med_phases_prep_atm(gcomp, rc)
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
+
+ ! IF data ocn case compute first, otherwise computed in prep_ocn_mod
+
+! call med_compute_enthalpy(is_local, rc)
+! if (ChkErr(rc,__LINE__,u_FILE_u)) return
+
do n = 1,size(dataptr1)
- dataptr1(n) = dataptr1(n) + global_htot_corr(1)
+ dataptr1(n) = dataptr1(n) + med_enthalpy_get_global_htot_corr()
end do
end if
@@ -255,48 +259,4 @@ 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 7a71f7e90..ae8e823af 100644
--- a/mediator/med_phases_prep_ocn_mod.F90
+++ b/mediator/med_phases_prep_ocn_mod.F90
@@ -7,7 +7,7 @@ module med_phases_prep_ocn_mod
use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8
use med_constants_mod , only : czero =>med_constants_czero
use med_constants_mod , only : dbug_flag => med_constants_dbug_flag
- use med_internalstate_mod , only : InternalState, maintask, logunit
+ use med_internalstate_mod , only : InternalState, maintask, logunit, compocn, compatm, compice, coupling_mode
use med_merge_mod , only : med_merge_auto, med_merge_field
use med_map_mod , only : med_map_field_packed
use med_utils_mod , only : memcheck => med_memcheck
@@ -21,7 +21,6 @@ module med_phases_prep_ocn_mod
use med_methods_mod , only : FB_reset => med_methods_FB_reset
use med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans
use esmFlds , only : med_fldList_GetfldListTo, med_fldlist_type
- use med_internalstate_mod , only : compocn, compatm, compice, coupling_mode
use perf_mod , only : t_startf, t_stopf
implicit none
@@ -31,7 +30,7 @@ module med_phases_prep_ocn_mod
public :: med_phases_prep_ocn_accum ! called from run sequence
public :: med_phases_prep_ocn_avg ! called from run sequence
- private :: med_phases_prep_ocn_custom
+ private :: med_phases_prep_ocn_custom_cesm
private :: med_phases_prep_ocn_custom_nems
character(*), parameter :: u_FILE_u = &
@@ -81,7 +80,8 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc)
use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS
use ESMF , only : ESMF_FAILURE, ESMF_LOGMSG_ERROR
use med_constants_mod , only : shr_const_cpsw, shr_const_tkfrz, shr_const_pi
- use med_phases_prep_atm_mod , only : med_phases_prep_atm_enthalpy_correction
+ use med_constants_mod , only : shr_const_cpfw, shr_const_cpice, shr_const_cpwv
+ use med_enthalpy_mod , only : med_compute_enthalpy
! input/output variables
type(ESMF_GridComp) :: gcomp
@@ -142,7 +142,7 @@ 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
+ ! compute enthalpy 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. &
@@ -157,6 +157,9 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc)
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 med_compute_enthalpy(is_local, rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+#ifdef DOTHIS
call FB_GetFldPtr(is_local%wrap%FBImp(compocn,compocn), 'So_t', tocn, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
@@ -189,12 +192,13 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc)
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
+ hrain(n) = max((tocn(n) - shr_const_tkfrz), 0._r8) * rain(n) * shr_const_cpfw
+ hsnow(n) = min((tocn(n) - shr_const_tkfrz), 0._r8) * snow(n) * shr_const_cpice
+ hevap(n) = (tocn(n) - shr_const_tkfrz) * min(evap(n), 0._r8) * shr_const_cpwv
+ hcond(n) = (tocn(n) - shr_const_tkfrz) * max(evap(n), 0._r8) * shr_const_cpwv
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
+ hrofi(n) = min((tocn(n) - shr_const_tkfrz), 0._r8) * rofi(n) * shr_const_cpice
+ ! GMM - note change in hcond
end do
! Determine enthalpy correction factor that will be added to the sensible heat flux sent to the atm
@@ -213,13 +217,14 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
deallocate(hcorr)
end if
-
+#endif
end if
! custom merges to ocean
- call med_phases_prep_ocn_custom(gcomp, rc)
- if (ChkErr(rc,__LINE__,u_FILE_u)) return
- if (trim(coupling_mode(1:5)) == 'nems_') then
+ if (trim(coupling_mode) == 'cesm') then
+ call med_phases_prep_ocn_custom_cesm(gcomp, rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+ else if (trim(coupling_mode(1:5)) == 'nems_') then
call med_phases_prep_ocn_custom_nems(gcomp, rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
end if
@@ -314,7 +319,7 @@ subroutine med_phases_prep_ocn_avg(gcomp, rc)
end subroutine med_phases_prep_ocn_avg
!-----------------------------------------------------------------------------
- subroutine med_phases_prep_ocn_custom(gcomp, rc)
+ subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc)
!---------------------------------------
! custom calculations for cesm
@@ -371,7 +376,7 @@ subroutine med_phases_prep_ocn_custom(gcomp, rc)
integer :: lsize
real(R8) :: c1,c2,c3,c4
character(len=64), allocatable :: fldnames(:)
- character(len=*), parameter :: subname='(med_phases_prep_ocn_custom)'
+ character(len=*), parameter :: subname='(med_phases_prep_ocn_custom_cesm)'
!---------------------------------------
rc = ESMF_SUCCESS
@@ -619,7 +624,7 @@ subroutine med_phases_prep_ocn_custom(gcomp, rc)
end if
call t_stopf('MED:'//subname)
- end subroutine med_phases_prep_ocn_custom
+ end subroutine med_phases_prep_ocn_custom_cesm
!-----------------------------------------------------------------------------
subroutine med_phases_prep_ocn_custom_nems(gcomp, rc)
@@ -642,6 +647,7 @@ subroutine med_phases_prep_ocn_custom_nems(gcomp, rc)
real(R8), pointer :: ifrac(:)
real(R8), pointer :: ofrac(:)
integer :: lsize
+ real(R8) , parameter :: const_lhvap = 2.501e6_R8 ! latent heat of evaporation ~ J/kg
character(len=*), parameter :: subname='(med_phases_prep_ocn_custom_nems)'
!---------------------------------------
@@ -670,9 +676,9 @@ subroutine med_phases_prep_ocn_custom_nems(gcomp, rc)
if (trim(coupling_mode) == 'nems_orig' .or. &
trim(coupling_mode) == 'nems_frac' .or. &
trim(coupling_mode) == 'nems_frac_aoflux_sbs') then
- customwgt(:) = -ofrac(:)
+ customwgt(:) = -ofrac(:) / const_lhvap
call med_merge_field(is_local%wrap%FBExp(compocn), 'Faxa_evap', &
- FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_evap' , wgtA=customwgt, rc=rc)
+ FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_lat' , wgtA=customwgt, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
customwgt(:) = -ofrac(:)
@@ -691,6 +697,25 @@ subroutine med_phases_prep_ocn_custom_nems(gcomp, rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
end if
+ ! netsw_for_ocn = [downsw_from_atm*(1-ice_fraction)*(1-ocn_albedo)] + [pensw_from_ice*(ice_fraction)]
+ customwgt(:) = ofrac(:) * (1.0_R8 - 0.06_R8)
+ call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdr', &
+ FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_swvdr' , wgtA=customwgt, &
+ FBinB=is_local%wrap%FBImp(compice,compocn), fnameB='Fioi_swpen_vdr', wgtB=ifrac, rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+ call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdf', &
+ FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_swvdf' , wgtA=customwgt, &
+ FBinB=is_local%wrap%FBImp(compice,compocn), fnameB='Fioi_swpen_vdf', wgtB=ifrac, rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+ call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idr', &
+ FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_swndr' , wgtA=customwgt, &
+ FBinB=is_local%wrap%FBImp(compice,compocn), fnameB='Fioi_swpen_idr', wgtB=ifrac, rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+ call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idf', &
+ FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_swndf' , wgtA=customwgt, &
+ FBinB=is_local%wrap%FBImp(compice,compocn), fnameB='Fioi_swpen_idf', wgtB=ifrac, rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+
deallocate(customwgt)
if (dbug_flag > 20) then