From 1943c2e9a28353231381b867e4cd810aedf571d2 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Tue, 29 Aug 2023 17:56:56 -0600 Subject: [PATCH 01/30] add med_enthaply_mod --- cime_config/namelist_definition_drv.xml | 14 ++ mediator/CMakeLists.txt | 3 +- mediator/med.F90 | 21 ++- mediator/med_enthalpy_mod.F90 | 171 ++++++++++++++++++++++++ mediator/med_phases_prep_atm_mod.F90 | 56 ++------ mediator/med_phases_prep_ocn_mod.F90 | 63 ++++++--- 6 files changed, 259 insertions(+), 69 deletions(-) create mode 100644 mediator/med_enthalpy_mod.F90 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 From f7f7a1eb8b4447e9e6a2543638e0ee0fbb0af915 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Tue, 29 Aug 2023 18:56:38 -0600 Subject: [PATCH 02/30] clean up --- mediator/med_enthalpy_mod.F90 | 2 +- mediator/med_phases_prep_atm_mod.F90 | 4 +- mediator/med_phases_prep_ocn_mod.F90 | 77 +--------------------------- 3 files changed, 5 insertions(+), 78 deletions(-) diff --git a/mediator/med_enthalpy_mod.F90 b/mediator/med_enthalpy_mod.F90 index 10df74b89..b72141327 100644 --- a/mediator/med_enthalpy_mod.F90 +++ b/mediator/med_enthalpy_mod.F90 @@ -12,7 +12,7 @@ module med_enthalpy_mod implicit none public :: med_compute_enthalpy - + real(r8) :: global_htot_corr(1) character(*), parameter :: u_FILE_u = & __FILE__ diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index 21037fc34..950fa681a 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -23,7 +23,7 @@ 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 + use med_enthalpy_mod, only : med_enthalpy_get_global_htot_corr, med_compute_enthalpy, mediator_compute_enthalpy implicit none private @@ -234,7 +234,7 @@ subroutine med_phases_prep_atm(gcomp, rc) end if ! Add enthalpy correction to sensible heat if appropriate - if (FB_FldChk(is_local%wrap%FBExp(compatm), 'Faxx_sen', rc=rc)) then + if (Mediator_compute_enthalpy) then call FB_getfldptr(is_local%wrap%FBExp(compatm), 'Faxx_sen', dataptr1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index ae8e823af..23f987ded 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -81,7 +81,7 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) use ESMF , only : ESMF_FAILURE, ESMF_LOGMSG_ERROR use med_constants_mod , only : shr_const_cpsw, shr_const_tkfrz, shr_const_pi use med_constants_mod , only : shr_const_cpfw, shr_const_cpice, shr_const_cpwv - use med_enthalpy_mod , only : med_compute_enthalpy + use med_enthalpy_mod , only : med_compute_enthalpy, mediator_compute_enthalpy ! input/output variables type(ESMF_GridComp) :: gcomp @@ -142,82 +142,9 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - ! 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. & - 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 - + if(mediator_compute_enthalpy) 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 - - 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_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_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(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 -#endif end if ! custom merges to ocean From 9a3ddbd0830c8e6e1ecb6ba5215ddf0048bccbbf Mon Sep 17 00:00:00 2001 From: James Edwards Date: Wed, 30 Aug 2023 10:11:24 -0600 Subject: [PATCH 03/30] fix nmax value --- mediator/med_enthalpy_mod.F90 | 9 ++++----- mediator/med_phases_prep_atm_mod.F90 | 1 - 2 files changed, 4 insertions(+), 6 deletions(-) diff --git a/mediator/med_enthalpy_mod.F90 b/mediator/med_enthalpy_mod.F90 index b72141327..afcc2dde4 100644 --- a/mediator/med_enthalpy_mod.F90 +++ b/mediator/med_enthalpy_mod.F90 @@ -12,8 +12,9 @@ module med_enthalpy_mod implicit none public :: med_compute_enthalpy + logical, public :: mediator_compute_enthalpy = .true. - real(r8) :: global_htot_corr(1) + real(r8) :: global_htot_corr(1) = 0._r8 character(*), parameter :: u_FILE_u = & __FILE__ contains @@ -41,11 +42,11 @@ subroutine med_compute_enthalpy(is_local, rc) 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 - + nmax = size(tocn) + 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 @@ -128,7 +129,6 @@ subroutine med_compute_enthalpy(is_local, rc) 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 @@ -157,7 +157,6 @@ subroutine med_compute_enthalpy(is_local, rc) 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 diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index 950fa681a..b1d9878ba 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -242,7 +242,6 @@ subroutine med_phases_prep_atm(gcomp, rc) ! call med_compute_enthalpy(is_local, rc) ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - do n = 1,size(dataptr1) dataptr1(n) = dataptr1(n) + med_enthalpy_get_global_htot_corr() end do From c55d8084e53447f498ae32377b3011b96bb4316c Mon Sep 17 00:00:00 2001 From: James Edwards Date: Wed, 30 Aug 2023 10:16:18 -0600 Subject: [PATCH 04/30] set default to false --- mediator/med_enthalpy_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mediator/med_enthalpy_mod.F90 b/mediator/med_enthalpy_mod.F90 index afcc2dde4..5799e0993 100644 --- a/mediator/med_enthalpy_mod.F90 +++ b/mediator/med_enthalpy_mod.F90 @@ -12,7 +12,7 @@ module med_enthalpy_mod implicit none public :: med_compute_enthalpy - logical, public :: mediator_compute_enthalpy = .true. + logical, public :: mediator_compute_enthalpy = .false. real(r8) :: global_htot_corr(1) = 0._r8 character(*), parameter :: u_FILE_u = & From 39e6b188fec41f9fd2219e4cd5cb2a75c94f694e Mon Sep 17 00:00:00 2001 From: James Edwards Date: Wed, 30 Aug 2023 14:34:57 -0600 Subject: [PATCH 05/30] now functional for F case --- mediator/med_enthalpy_mod.F90 | 6 +++++- mediator/med_internalstate_mod.F90 | 5 ++++- mediator/med_phases_prep_atm_mod.F90 | 9 +++++---- 3 files changed, 14 insertions(+), 6 deletions(-) diff --git a/mediator/med_enthalpy_mod.F90 b/mediator/med_enthalpy_mod.F90 index 5799e0993..f7b5605da 100644 --- a/mediator/med_enthalpy_mod.F90 +++ b/mediator/med_enthalpy_mod.F90 @@ -6,7 +6,7 @@ module med_enthalpy_mod 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 med_internalstate_mod, only : compocn, compatm, comprof, InternalState use perf_mod, only : t_startf, t_stopf @@ -110,6 +110,8 @@ subroutine med_compute_enthalpy(is_local, rc) call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_rofl' , rofl, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else + call FB_GetFldPtr(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofl', rofl, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return 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) @@ -122,6 +124,8 @@ subroutine med_compute_enthalpy(is_local, rc) call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_rofi' , rofi, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else + call FB_GetFldPtr(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofi', rofi, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return 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) diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index 66e2eb1db..9d6029b1f 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -125,7 +125,8 @@ module med_internalstate_mod logical :: ocn2glc_coupling = .false. ! obtained from attribute logical :: lnd2glc_coupling = .false. logical :: accum_lnd2glc = .false. - + logical :: docn_present ! aoflux calc requires med_coupling_active true even for docn + ! so we need an additional flag ! Mediator vm type(ESMF_VM) :: vm @@ -282,8 +283,10 @@ subroutine med_internalstate_init(gcomp, rc) end if call NUOPC_CompAttributeGet(gcomp, name='OCN_model', value=ocn_name, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + is_local%wrap%docn_present = .false. if (isPresent .and. isSet) then if (trim(ocn_name) /= 'socn') is_local%wrap%comp_present(compocn) = .true. + if (trim(ocn_name) == 'docn') is_local%wrap%docn_present = .true. end if call NUOPC_CompAttributeGet(gcomp, name='ICE_model', value=ice_name, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index b1d9878ba..5d8826908 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -7,7 +7,7 @@ module med_phases_prep_atm_mod use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS use ESMF , only : ESMF_Field, ESMF_FieldGet, ESMF_FieldBundleGet - use ESMF , only : ESMF_GridComp, ESMF_GridCompGet + use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_FieldBundleIsCreated use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_utils_mod , only : memcheck => med_memcheck use med_utils_mod , only : chkerr => med_utils_ChkErr @@ -239,9 +239,10 @@ subroutine med_phases_prep_atm(gcomp, 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 + if(is_local%wrap%docn_present) then + call med_compute_enthalpy(is_local, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif do n = 1,size(dataptr1) dataptr1(n) = dataptr1(n) + med_enthalpy_get_global_htot_corr() end do From 08ddedc008a1a578d8be38c672108a06a97464e5 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Wed, 30 Aug 2023 14:50:18 -0600 Subject: [PATCH 06/30] print global enthalpy correction to med log --- mediator/med_enthalpy_mod.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/mediator/med_enthalpy_mod.F90 b/mediator/med_enthalpy_mod.F90 index f7b5605da..4aa1733ba 100644 --- a/mediator/med_enthalpy_mod.F90 +++ b/mediator/med_enthalpy_mod.F90 @@ -7,6 +7,7 @@ module med_enthalpy_mod 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, comprof, InternalState + use med_internalstate_mod , only : logunit, maintask use perf_mod, only : t_startf, t_stopf @@ -164,7 +165,7 @@ subroutine med_compute_enthalpy(is_local, rc) 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 - + if (maintask) write(logunit, '(a,a,f21.13)') trim(subname),' global enthalpy correction: ',global_htot_corr(1) deallocate(hcorr) endif call t_stopf(subname) From 23f23bfe6bbcfac80ff91f03fde1230c0fa6f026 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Wed, 30 Aug 2023 16:34:45 -0600 Subject: [PATCH 07/30] add deallocate for local variables, add tbot in hrain and hsnow calculations --- mediator/med_enthalpy_mod.F90 | 27 +++++++++++++++++++++++---- 1 file changed, 23 insertions(+), 4 deletions(-) diff --git a/mediator/med_enthalpy_mod.F90 b/mediator/med_enthalpy_mod.F90 index 4aa1733ba..ac6c52433 100644 --- a/mediator/med_enthalpy_mod.F90 +++ b/mediator/med_enthalpy_mod.F90 @@ -31,13 +31,14 @@ subroutine med_compute_enthalpy(is_local, rc) ! local variables real(r8), pointer :: tocn(:), rain(:), snow(:), rofl(:), rofi(:), evap(:) - real(r8), pointer :: rainl(:), rainc(:) + real(r8), pointer :: rainl(:), rainc(:), tbot(:) 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" @@ -47,6 +48,14 @@ subroutine med_compute_enthalpy(is_local, rc) call FB_GetFldPtr(is_local%wrap%FBImp(compocn,compocn), 'So_t', tocn, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return nmax = size(tocn) + + if (FB_fldchk(is_local%wrap%FBExp(compocn), 'Sa_tbot' , rc=rc)) then + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Sa_tbot', tbot, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call FB_GetFldPtr(is_local%wrap%FBImp(compatm, compatm), 'Sa_tbot', tbot, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif 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) @@ -136,14 +145,17 @@ subroutine med_compute_enthalpy(is_local, rc) 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 + hrain(n) = max((tbot(n) - tkfrz), 0._r8) * rain(n) * cpfw + hsnow(n) = min((tbot(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 + hrofl(n) = max((tocn(n) - tkfrz), 0._r8) * rofl(n) * cpfw hrofi(n) = min((tocn(n) - tkfrz), 0._r8) * rofi(n) * cpice ! GMM - note change in hcond end do + + if(.not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_rain', rc)) deallocate(rain) + if(.not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_snow', rc)) deallocate(snow) ! 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 @@ -168,6 +180,13 @@ subroutine med_compute_enthalpy(is_local, rc) if (maintask) write(logunit, '(a,a,f21.13)') trim(subname),' global enthalpy correction: ',global_htot_corr(1) deallocate(hcorr) endif + if(.not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hsnow', rc)) deallocate(hsnow) + if(.not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrofl', rc)) deallocate(hrofl) + if(.not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrofi', rc)) deallocate(hrofi) + if(.not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrain', rc)) deallocate(hrain) + if(.not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hevap', rc)) deallocate(hevap) + if(.not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hcond', rc)) deallocate(hcond) + call t_stopf(subname) end subroutine med_compute_enthalpy From bffee2d1f84e562f23c34b67a1ae0b0f5ca52e36 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Thu, 31 Aug 2023 06:55:46 -0600 Subject: [PATCH 08/30] fix github tests --- mediator/med_phases_prep_ocn_mod.F90 | 10 ---------- 1 file changed, 10 deletions(-) diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index 23f987ded..ed691a174 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -90,16 +90,6 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) ! local variables type(InternalState) :: is_local integer :: n - 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(:) type(med_fldlist_type), pointer :: fldList character(len=*), parameter :: subname='(med_phases_prep_ocn_accum)' !--------------------------------------- From 27433f11ee99078834e944887770512b4d72524a Mon Sep 17 00:00:00 2001 From: James Edwards Date: Thu, 31 Aug 2023 07:38:09 -0600 Subject: [PATCH 09/30] remove unintended changes in nems --- mediator/med_phases_prep_ocn_mod.F90 | 41 ++++++---------------------- 1 file changed, 9 insertions(+), 32 deletions(-) diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index ed691a174..631fd3c62 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -30,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_cesm + private :: med_phases_prep_ocn_custom private :: med_phases_prep_ocn_custom_nems character(*), parameter :: u_FILE_u = & @@ -79,8 +79,6 @@ 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 med_constants_mod , only : shr_const_cpsw, shr_const_tkfrz, shr_const_pi - use med_constants_mod , only : shr_const_cpfw, shr_const_cpice, shr_const_cpwv use med_enthalpy_mod , only : med_compute_enthalpy, mediator_compute_enthalpy ! input/output variables @@ -138,10 +136,9 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) end if ! custom merges to ocean - 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(gcomp, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + 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 @@ -236,7 +233,7 @@ subroutine med_phases_prep_ocn_avg(gcomp, rc) end subroutine med_phases_prep_ocn_avg !----------------------------------------------------------------------------- - subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc) + subroutine med_phases_prep_ocn_custom(gcomp, rc) !--------------------------------------- ! custom calculations for cesm @@ -293,7 +290,7 @@ subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc) integer :: lsize real(R8) :: c1,c2,c3,c4 character(len=64), allocatable :: fldnames(:) - character(len=*), parameter :: subname='(med_phases_prep_ocn_custom_cesm)' + character(len=*), parameter :: subname='(med_phases_prep_ocn_custom)' !--------------------------------------- rc = ESMF_SUCCESS @@ -541,7 +538,7 @@ subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc) end if call t_stopf('MED:'//subname) - end subroutine med_phases_prep_ocn_custom_cesm + end subroutine med_phases_prep_ocn_custom !----------------------------------------------------------------------------- subroutine med_phases_prep_ocn_custom_nems(gcomp, rc) @@ -564,7 +561,6 @@ 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)' !--------------------------------------- @@ -593,9 +589,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(:) / const_lhvap + customwgt(:) = -ofrac(:) call med_merge_field(is_local%wrap%FBExp(compocn), 'Faxa_evap', & - FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_lat' , wgtA=customwgt, rc=rc) + FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_evap' , wgtA=customwgt, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return customwgt(:) = -ofrac(:) @@ -614,25 +610,6 @@ 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 From 4581897ec9012b07f5cc64f88f0b46b491e6e82c Mon Sep 17 00:00:00 2001 From: James Edwards Date: Thu, 31 Aug 2023 07:47:25 -0600 Subject: [PATCH 10/30] include ofrac in calculations --- mediator/med_enthalpy_mod.F90 | 26 ++++++++++++++++++-------- mediator/med_phases_prep_ocn_mod.F90 | 2 +- 2 files changed, 19 insertions(+), 9 deletions(-) diff --git a/mediator/med_enthalpy_mod.F90 b/mediator/med_enthalpy_mod.F90 index ac6c52433..cf3ee81c5 100644 --- a/mediator/med_enthalpy_mod.F90 +++ b/mediator/med_enthalpy_mod.F90 @@ -32,7 +32,7 @@ subroutine med_compute_enthalpy(is_local, rc) real(r8), pointer :: tocn(:), rain(:), snow(:), rofl(:), rofi(:), evap(:) real(r8), pointer :: rainl(:), rainc(:), tbot(:) - real(r8), pointer :: snowl(:), snowc(:) + real(r8), pointer :: snowl(:), snowc(:), ofrac(:) real(r8), pointer :: hrain(:), hsnow(:), hevap(:), hcond(:), hrofl(:), hrofi(:) real(r8), allocatable :: hcorr(:) real(r8), pointer :: areas(:) @@ -48,7 +48,7 @@ subroutine med_compute_enthalpy(is_local, rc) call FB_GetFldPtr(is_local%wrap%FBImp(compocn,compocn), 'So_t', tocn, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return nmax = size(tocn) - + if (FB_fldchk(is_local%wrap%FBExp(compocn), 'Sa_tbot' , rc=rc)) then call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Sa_tbot', tbot, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -143,14 +143,24 @@ subroutine med_compute_enthalpy(is_local, rc) else allocate(hrofi(nmax)) endif + if(is_local%wrap%docn_present) then + ! For docn land points have none 0 tocn values so we need to include + ! ocnfrac in calculations. + call FB_GetFldPtr(is_local%wrap%FBfrac(compocn), 'ofrac' , ofrac, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + ! if not docn then tbot is 0 over land and we don't need ofrac + allocate(ofrac(nmax)) + ofrac = 1.0_R8 + 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((tbot(n) - tkfrz), 0._r8) * rain(n) * cpfw - hsnow(n) = min((tbot(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) * cpfw - hrofi(n) = min((tocn(n) - tkfrz), 0._r8) * rofi(n) * cpice + hrain(n) = max((tbot(n) - tkfrz), 0._r8) * rain(n) * cpfw * ofrac(n) + hsnow(n) = min((tbot(n) - tkfrz), 0._r8) * snow(n) * cpice * ofrac(n) + hevap(n) = (tocn(n) - tkfrz) * min(evap(n), 0._r8) * cpwv * ofrac(n) + hcond(n) = (tocn(n) - tkfrz) * max(evap(n), 0._r8) * cpwv * ofrac(n) + hrofl(n) = max((tocn(n) - tkfrz), 0._r8) * rofl(n) * cpfw * ofrac(n) + hrofi(n) = min((tocn(n) - tkfrz), 0._r8) * rofi(n) * cpice * ofrac(n) ! GMM - note change in hcond end do diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index 631fd3c62..b49d717f0 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -589,7 +589,7 @@ 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(:) 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) if (ChkErr(rc,__LINE__,u_FILE_u)) return From 77d745e5ac73d22e991ab3bd65ce57f1bc686049 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Thu, 31 Aug 2023 12:06:56 -0600 Subject: [PATCH 11/30] get tbot from atm export to ocn --- mediator/med_enthalpy_mod.F90 | 38 ++++++++++++++--------------------- 1 file changed, 15 insertions(+), 23 deletions(-) diff --git a/mediator/med_enthalpy_mod.F90 b/mediator/med_enthalpy_mod.F90 index cf3ee81c5..5ccbca3eb 100644 --- a/mediator/med_enthalpy_mod.F90 +++ b/mediator/med_enthalpy_mod.F90 @@ -6,6 +6,7 @@ module med_enthalpy_mod 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_methods_mod , only : fldbun_getdata1d => med_methods_FB_getdata1d use med_internalstate_mod, only : compocn, compatm, comprof, InternalState use med_internalstate_mod , only : logunit, maintask use perf_mod, only : t_startf, t_stopf @@ -49,13 +50,8 @@ subroutine med_compute_enthalpy(is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return nmax = size(tocn) - if (FB_fldchk(is_local%wrap%FBExp(compocn), 'Sa_tbot' , rc=rc)) then - call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Sa_tbot', tbot, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - call FB_GetFldPtr(is_local%wrap%FBImp(compatm, compatm), 'Sa_tbot', tbot, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - endif + call FB_GetFldPtr(is_local%wrap%FBImp(compatm, compocn), 'Sa_tbot', tbot, 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) @@ -143,29 +139,25 @@ subroutine med_compute_enthalpy(is_local, rc) else allocate(hrofi(nmax)) endif - if(is_local%wrap%docn_present) then - ! For docn land points have none 0 tocn values so we need to include - ! ocnfrac in calculations. - call FB_GetFldPtr(is_local%wrap%FBfrac(compocn), 'ofrac' , ofrac, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - ! if not docn then tbot is 0 over land and we don't need ofrac - allocate(ofrac(nmax)) - ofrac = 1.0_R8 - endif - do n = 1,nmax + + call fldbun_getdata1d(is_local%wrap%FBImp(compocn,compocn), 'So_omask', ofrac, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + do n=1,nmax + ! for F cases (docn) tocn is non-zero over land and so ofrac must be included + ! so that only ocean points are included in calculation ! Need max to ensure that will not have an enthalpy contribution if the water is below 0C - hrain(n) = max((tbot(n) - tkfrz), 0._r8) * rain(n) * cpfw * ofrac(n) + hrain(n) = max((tbot(n) - tkfrz), 0._r8) * rain(n) * cpfw * ofrac(n) hsnow(n) = min((tbot(n) - tkfrz), 0._r8) * snow(n) * cpice * ofrac(n) - hevap(n) = (tocn(n) - tkfrz) * min(evap(n), 0._r8) * cpwv * ofrac(n) - hcond(n) = (tocn(n) - tkfrz) * max(evap(n), 0._r8) * cpwv * ofrac(n) - hrofl(n) = max((tocn(n) - tkfrz), 0._r8) * rofl(n) * cpfw * ofrac(n) + hevap(n) = (tocn(n) - tkfrz) * min(evap(n), 0._r8) * cpwv * ofrac(n) + hcond(n) = (tocn(n) - tkfrz) * max(evap(n), 0._r8) * cpwv * ofrac(n) + hrofl(n) = max((tocn(n) - tkfrz), 0._r8) * rofl(n) * cpfw * ofrac(n) hrofi(n) = min((tocn(n) - tkfrz), 0._r8) * rofi(n) * cpice * ofrac(n) ! GMM - note change in hcond end do - if(.not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_rain', rc)) deallocate(rain) if(.not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_snow', rc)) deallocate(snow) + ! 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 From 66e454a3cce1520df615858eccf049fe693c3dd2 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Thu, 31 Aug 2023 13:11:13 -0600 Subject: [PATCH 12/30] fix github test --- mediator/med_phases_prep_ocn_mod.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index b49d717f0..11752a33c 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -87,7 +87,6 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) ! local variables type(InternalState) :: is_local - integer :: n type(med_fldlist_type), pointer :: fldList character(len=*), parameter :: subname='(med_phases_prep_ocn_accum)' !--------------------------------------- From d6dc143cad5f965ec4bf1b1979dae6f0e041b9f3 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Thu, 31 Aug 2023 13:46:19 -0600 Subject: [PATCH 13/30] update github tests, remove irrelavent comment --- .github/workflows/extbuild.yml | 51 ++++++++++++++++++---------------- mediator/med_enthalpy_mod.F90 | 1 - 2 files changed, 27 insertions(+), 25 deletions(-) diff --git a/.github/workflows/extbuild.yml b/.github/workflows/extbuild.yml index 6e26b40a5..41708115b 100644 --- a/.github/workflows/extbuild.yml +++ b/.github/workflows/extbuild.yml @@ -20,11 +20,11 @@ jobs: CPPFLAGS: "-I/usr/include -I/usr/local/include" # Versions of all dependencies can be updated here - ESMF_VERSION: v8.4.2 + ESMF_VERSION: v8.5.0 PNETCDF_VERSION: checkpoint.1.12.3 NETCDF_FORTRAN_VERSION: v4.6.0 - PIO_VERSION: pio2_6_0 - CDEPS_VERSION: cdeps1.0.15 + PIO_VERSION: pio2_6_2 + CDEPS_VERSION: cdeps1.0.21 steps: - uses: actions/checkout@v3 # Build the ESMF library, if the cache contains a previous build @@ -52,23 +52,27 @@ jobs: key: ${{ runner.os }}-${{ env.PIO_VERSION }}.pio - name: Build ParallelIO if: steps.cache-ParallelIO.outputs.cache-hit != 'true' - uses: NCAR/ParallelIO/.github/actions/parallelio_cmake@pio2_6_0 + uses: NCAR/ParallelIO/.github/actions/parallelio_cmake@pio2_6_2 with: parallelio_version: ${{ env.ParallelIO_VERSION }} enable_fortran: True - install_prefix: $HOME/pio - - name: Build ESMF - if: steps.cache-esmf.outputs.cache-hit != 'true' - uses: ESCOMP/CDEPS/.github/actions/buildesmf@cdeps1.0.15 + install_prefix: ${GITHUB_WORKSPACE}/pio + - name: Install ESMF + uses: esmf-org/install-esmf-action@v1 + env: + ESMF_COMPILER: gfortran + ESMF_BOPT: g + ESMF_COMM: openmpi + ESMF_NETCDF: nc-config + ESMF_PNETCDF: pnetcdf-config + ESMF_INSTALL_PREFIX: ${GITHUB_WORKSPACE}/ESMF + ESMF_PIO: external + ESMF_PIO_INCLUDE: ${GITHUB_WORKSPACE}/pio/include + ESMF_PIO_LIBPATH: ${GITHUB_WORKSPACE}/pio/lib with: - esmf_version: ${{ env.ESMF_VERSION }} - esmf_bopt: g - esmf_comm: openmpi - install_prefix: $HOME/ESMF - netcdf_c_path: /usr - netcdf_fortran_path: /usr - pnetcdf_path: /usr - parallelio_path: $HOME/pio + version: ${{ env.ESMF_VERSION }} + esmpy: false + cache: true - name: Cache CDEPS id: cache-cdeps uses: actions/cache@v3 @@ -84,24 +88,23 @@ jobs: ref: ${{ env.CDEPS_VERSION }} - name: Build CDEPS if: steps.cache-cdeps.outputs.cache-hit != 'true' - uses: ESCOMP/CDEPS/.github/actions/buildcdeps@cdeps1.0.15 + uses: ESCOMP/CDEPS/.github/actions/buildcdeps@cdeps1.0.21 with: - esmfmkfile: $HOME/ESMF/lib/libg/Linux.gfortran.64.openmpi.default/esmf.mk - pio_path: $HOME/pio + esmfmkfile: $ESMFMKFILE + pio_path: ${GITHUB_WORKSPACE}/pio src_root: ${GITHUB_WORKSPACE}/cdeps-src cmake_flags: " -Wno-dev -DCMAKE_BUILD_TYPE=DEBUG -DWERROR=ON -DCMAKE_Fortran_FLAGS=\"-DCPRGNU -g -Wall \ -ffree-form -ffree-line-length-none -fallow-argument-mismatch \"" - name: Build CMEPS run: | - export ESMFMKFILE=$HOME/ESMF/lib/libg/Linux.gfortran.64.openmpi.default/esmf.mk - export PIO=$HOME/pio + export PIO=${GITHUB_WORKSPACE}/pio mkdir build-cmeps pushd build-cmeps cmake -DCMAKE_BUILD_TYPE=DEBUG -DCMAKE_Fortran_FLAGS="-g -Wall -Werror -ffree-form -ffree-line-length-none -Wno-unused-dummy-argument -I /home/runner/work/CMEPS/CMEPS/build-cdeps/share" ../ make VERBOSE=1 popd - - name: Setup tmate session - if: ${{ failure() }} - uses: mxschmitt/action-tmate@v3 +# - name: Setup tmate session +# if: ${{ failure() }} +# uses: mxschmitt/action-tmate@v3 diff --git a/mediator/med_enthalpy_mod.F90 b/mediator/med_enthalpy_mod.F90 index 5ccbca3eb..38b3f6a8e 100644 --- a/mediator/med_enthalpy_mod.F90 +++ b/mediator/med_enthalpy_mod.F90 @@ -153,7 +153,6 @@ subroutine med_compute_enthalpy(is_local, rc) hcond(n) = (tocn(n) - tkfrz) * max(evap(n), 0._r8) * cpwv * ofrac(n) hrofl(n) = max((tocn(n) - tkfrz), 0._r8) * rofl(n) * cpfw * ofrac(n) hrofi(n) = min((tocn(n) - tkfrz), 0._r8) * rofi(n) * cpice * ofrac(n) - ! GMM - note change in hcond end do if(.not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_rain', rc)) deallocate(rain) if(.not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_snow', rc)) deallocate(snow) From fac966a3a7d655d2bf4e900c535e9c29a58c0389 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Thu, 14 Sep 2023 14:27:22 -0600 Subject: [PATCH 14/30] add Thomas Toniazzo changes --- mediator/fd_cesm.yaml | 53 ++++++++++++++++++++++++++- mediator/med_enthalpy_mod.F90 | 69 +++++++++++++++++++++++++++++++---- 2 files changed, 113 insertions(+), 9 deletions(-) diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index c09a63c58..9db92f6a5 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -42,6 +42,16 @@ canonical_units: N m-2 description: mediator export # + - standard_name: Faox_tauxa + alias: stress_on_air_ocn_zonal (atm) + canonical_units: N m-2 + description: mediator export + # + - standard_name: Faox_tauya + alias: stress_on_air_ocn_merid (atm) + canonical_units: N m-2 + description: mediator export + # - standard_name: area canonical_units: radians**2 description: mediator area for component @@ -226,6 +236,16 @@ description: atmosphere export mean downward SW heat flux # + - standard_name: Faxa_wsxadj + canonical_units: Pa + description: (from) atmosphere export to flux_atmocn (for now) + mean wind-stess correction due to PBL iteration, zonal component + # + - standard_name: Faxa_wsyadj + canonical_units: Pa + description: (from) atmosphere export to flux_atmocn (for now) + mean wind-stess correction due to PBL iteration, meridional component + # - standard_name: Faxa_ndep canonical_units: kg(N)/m2/sec description: atmosphere export to land and ocean - currently nhx and noy @@ -259,6 +279,11 @@ - standard_name: Faxa_rainl_wiso canonical_units: kg m-2 s-1 description: atmosphere export + # + - standard_name: Faxa_hrain + alias: mean_matentf_of_rain + canonical_units: W m-2 + description: atmosphere export # - standard_name: Faxa_snow alias: mean_fprec_rate @@ -284,6 +309,11 @@ - standard_name: Faxa_snowl_wiso canonical_units: kg m-2 s-1 description: atmosphere export + # + - standard_name: Faxa_hsnow + alias: mean_matentf_of_snow + canonical_units: W m-2 + description: atmosphere export # - standard_name: Faxa_swnet canonical_units: W m-2 @@ -407,6 +437,11 @@ alias: mean_laten_heat_flx_atm canonical_units: W m-2 description: atmosphere export + # + - standard_name: Faxa_hevap + alias: mean_matentf_of_vapour + canonical_units: W m-2 + description: atmosphere export # - standard_name: Faxa_sen alias: mean_sensi_heat_flx_atm @@ -1146,6 +1181,22 @@ canonical_units: 1 description: ocean import - fractional atmosphere coverage used in radiation computations wrt ocean # + - standard_name: Sw_swh + canonical_units: m + description: wave import - significant wave height + # + - standard_name: Sw_mwl + canonical_units: m + description: wave import - mean wave length + # + - standard_name: Sw_ch + canonical_units: nondmnsnl + description: wave import - Charnock parameter + # + - standard_name: Sw_z0 + canonical_units: m + description: wave import - roughness length + # - standard_name: Sw_hstokes canonical_units: m description: ocean import - Stokes drift depth @@ -1179,7 +1230,7 @@ # #----------------------------------- # section: wave import - #----------------------------------- + # ----------------------------------- # - standard_name: Fwxx_taux alias: mean_zonal_moment_flx diff --git a/mediator/med_enthalpy_mod.F90 b/mediator/med_enthalpy_mod.F90 index 38b3f6a8e..a74b4530c 100644 --- a/mediator/med_enthalpy_mod.F90 +++ b/mediator/med_enthalpy_mod.F90 @@ -35,6 +35,7 @@ subroutine med_compute_enthalpy(is_local, rc) real(r8), pointer :: rainl(:), rainc(:), tbot(:) real(r8), pointer :: snowl(:), snowc(:), ofrac(:) real(r8), pointer :: hrain(:), hsnow(:), hevap(:), hcond(:), hrofl(:), hrofi(:) + real(r8), pointer :: hrain_a(:), hevap_a(:), hsnow_a(:), hrofl_a(:), hrofi_a(:) real(r8), allocatable :: hcorr(:) real(r8), pointer :: areas(:) real(r8), parameter :: glob_area_inv = 1._r8 / (4._r8 * pi) @@ -50,8 +51,13 @@ subroutine med_compute_enthalpy(is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return nmax = size(tocn) - call FB_GetFldPtr(is_local%wrap%FBImp(compatm, compocn), 'Sa_tbot', tbot, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (FB_fldchk(is_local%wrap%FBExp(compocn), 'Sa_tbot' , rc=rc)) then + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Sa_tbot', tbot, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call FB_GetFldPtr(is_local%wrap%FBImp(compatm, compocn), 'Sa_tbot', tbot, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif 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) @@ -143,16 +149,63 @@ subroutine med_compute_enthalpy(is_local, rc) call fldbun_getdata1d(is_local%wrap%FBImp(compocn,compocn), 'So_omask', ofrac, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_hrain' , rc=rc)) then + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Faxa_hrain', hrain_a, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + do n = 1,nmax + hrain(n) = hrain_a(n) - tkfrz*rain(n)*cpfw * ofrac(n) + enddo + else if (FB_fldchk(is_local%wrap%FBExp(compocn), 'Sa_tbot' , rc=rc)) then + do n = 1,nmax + hrain(n) = max((tbot(n) - tkfrz), 0._r8) * rain(n) * cpfw * ofrac(n) + enddo + else + do n = 1,nmax + hrain(n) = max((tocn(n) - tkfrz), 0._r8) * rain(n) * cpfw * ofrac(n) + enddo + endif + + if (FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_hevap' , rc=rc)) then + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Faxa_hevap', hevap_a, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + do n = 1,nmax + hevap(n) = min(hevap_a(n),0._r8) - tkfrz * min(evap(n),0._r8) * cpwv * ofrac(n) + hcond(n) = max(hevap_a(n),0._r8) - tkfrz * max(evap(n),0._r8) * cpwv * ofrac(n) + enddo + else + do n = 1,nmax + hevap(n) = (tocn(n) - tkfrz) * min(evap(n),0._r8) * cpwv * ofrac(n) + hcond(n) = (tocn(n) - tkfrz) * max(evap(n),0._r8) * cpwv * ofrac(n) + enddo + endif + + if (FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_hsnow' , rc=rc)) then + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Faxa_hsnow', hsnow_a, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + do n = 1,nmax + hsnow(n) = hsnow_a(n) - tkfrz * snow(n) * cpice * ofrac(n) + enddo + else if (FB_fldchk(is_local%wrap%FBExp(compocn), 'Sa_tbot' , rc=rc)) then + do n = 1,nmax + hsnow(n) = min((tbot(n) - tkfrz), 0._r8) * snow(n) * cpice * ofrac(n) + enddo + else + do n = 1,nmax + hsnow(n) = min((tocn(n) - tkfrz), 0._r8) * snow(n) * cpice * ofrac(n) + enddo + endif + + do n=1,nmax ! for F cases (docn) tocn is non-zero over land and so ofrac must be included ! so that only ocean points are included in calculation ! Need max to ensure that will not have an enthalpy contribution if the water is below 0C - hrain(n) = max((tbot(n) - tkfrz), 0._r8) * rain(n) * cpfw * ofrac(n) - hsnow(n) = min((tbot(n) - tkfrz), 0._r8) * snow(n) * cpice * ofrac(n) - hevap(n) = (tocn(n) - tkfrz) * min(evap(n), 0._r8) * cpwv * ofrac(n) - hcond(n) = (tocn(n) - tkfrz) * max(evap(n), 0._r8) * cpwv * ofrac(n) - hrofl(n) = max((tocn(n) - tkfrz), 0._r8) * rofl(n) * cpfw * ofrac(n) - hrofi(n) = min((tocn(n) - tkfrz), 0._r8) * rofi(n) * cpice * ofrac(n) + + hrofl_a(n)= max( tocn(n) , tkfrz ) * rofl(n) * cpsw * ofrac(n) + hrofi_a(n)= min( tocn(n) , tkfrz ) * rofi(n) * cpsw * ofrac(n) + + hrofl(n) = max((tocn(n) - tkfrz), 0._r8) * rofl(n) * cpsw * ofrac(n) + hrofi(n) = min((tocn(n) - tkfrz), 0._r8) * rofi(n) * cpsw * ofrac(n) end do if(.not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_rain', rc)) deallocate(rain) if(.not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_snow', rc)) deallocate(snow) From d6fefa03a8594039f83fc35cdb66c87f34e90422 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Fri, 15 Sep 2023 09:51:57 -0600 Subject: [PATCH 15/30] correct hcorr calculation --- mediator/med_enthalpy_mod.F90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/mediator/med_enthalpy_mod.F90 b/mediator/med_enthalpy_mod.F90 index a74b4530c..a996913b3 100644 --- a/mediator/med_enthalpy_mod.F90 +++ b/mediator/med_enthalpy_mod.F90 @@ -219,8 +219,10 @@ subroutine med_compute_enthalpy(is_local, rc) 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)) * & + hcorr(n) = (hrain_a(n) + hsnow_a(n) + hevap_a(n) + hrofl_a(n) + hrofi_a(n)) * & areas(n) * glob_area_inv + + ! hcorr(n) = (hrofl_a(n) + hrofi_a(n)) *areas(n) *glob_area_inv end do ! Determine sum of enthalpy correction for each hcorr index locally From de2b74b553c445da6d617337f3237a3ed41c0c3e Mon Sep 17 00:00:00 2001 From: James Edwards Date: Fri, 15 Sep 2023 09:56:22 -0600 Subject: [PATCH 16/30] remove irrelavent changes --- mediator/fd_cesm.yaml | 16 ---------------- 1 file changed, 16 deletions(-) diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index 9db92f6a5..06af37ed4 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -1181,22 +1181,6 @@ canonical_units: 1 description: ocean import - fractional atmosphere coverage used in radiation computations wrt ocean # - - standard_name: Sw_swh - canonical_units: m - description: wave import - significant wave height - # - - standard_name: Sw_mwl - canonical_units: m - description: wave import - mean wave length - # - - standard_name: Sw_ch - canonical_units: nondmnsnl - description: wave import - Charnock parameter - # - - standard_name: Sw_z0 - canonical_units: m - description: wave import - roughness length - # - standard_name: Sw_hstokes canonical_units: m description: ocean import - Stokes drift depth From f3db775726f8f3222b9a8e3f704d8a77fdf311dd Mon Sep 17 00:00:00 2001 From: James Edwards Date: Fri, 15 Sep 2023 13:16:41 -0600 Subject: [PATCH 17/30] add new fields to exchange. --- mediator/esmFldsExchange_cesm_mod.F90 | 25 +++++++++++++++++++++++++ 1 file changed, 25 insertions(+) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index a2c4fe435..7c978d70d 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -1999,6 +1999,31 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addfld_to(compocn, 'Foxx_hcond') call addfld_to(compocn, 'Foxx_hrofl') call addfld_to(compocn, 'Foxx_hrofi') + + call addfld_from(compatm, 'Faxa_hrain') + call addfld_from(compatm, 'Faxa_hsnow') + call addfld_from(compatm, 'Faxa_hevap') + else + if ( fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_hrain', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_hrain', rc=rc)) then + call addmap_from(compatm, 'Faxa_hrain', compocn, mapconsf, 'one', atm2ocn_map) + call addmrg_to(compocn, 'Faxa_hrain', & + mrg_from=compatm, mrg_fld='Faxa_hrain', mrg_type='copy') + end if + if ( fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_hsnow', rc=rc) .and. & + + fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_hsnow', rc=rc)) then + call addmap_from(compatm, 'Faxa_hsnow', compocn, mapconsf, 'one', atm2ocn_map) + call addmrg_to(compocn, 'Faxa_hsnow', & + mrg_from=compatm, mrg_fld='Faxa_hsnow', mrg_type='copy') + end if + if ( fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_hevap', rc=rc) .and. & + + fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_hevap', rc=rc)) then + call addmap_from(compatm, 'Faxa_hevap', compocn, mapconsf, 'one', atm2ocn_map) + call addmrg_to(compocn, 'Faxa_hevap', & + mrg_from=compatm, mrg_fld='Faxa_hevap', mrg_type='copy') + end if end if ! --------------------------------------------------------------------- From ac39a238387d01c87b1fb70d02ee21b6a948a432 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 20 Sep 2023 07:17:08 -0600 Subject: [PATCH 18/30] allocate vars --- mediator/med_enthalpy_mod.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/mediator/med_enthalpy_mod.F90 b/mediator/med_enthalpy_mod.F90 index a996913b3..525d9ad2a 100644 --- a/mediator/med_enthalpy_mod.F90 +++ b/mediator/med_enthalpy_mod.F90 @@ -195,7 +195,8 @@ subroutine med_compute_enthalpy(is_local, rc) enddo endif - + allocate(hrofl_a(nmax)) + allocate(hrofi_a(nmax)) do n=1,nmax ! for F cases (docn) tocn is non-zero over land and so ofrac must be included ! so that only ocean points are included in calculation @@ -242,7 +243,8 @@ subroutine med_compute_enthalpy(is_local, rc) if(.not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrain', rc)) deallocate(hrain) if(.not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hevap', rc)) deallocate(hevap) if(.not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hcond', rc)) deallocate(hcond) - + deallocate(hrofl_a) + deallocate(hrofi_a) call t_stopf(subname) end subroutine med_compute_enthalpy From 41b3cb52559d4a80d596dcab9e18cc67aaaa5842 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Wed, 20 Sep 2023 11:03:45 -0600 Subject: [PATCH 19/30] fix source of fields --- mediator/med_enthalpy_mod.F90 | 59 ++++++++++++++++++++++------------- 1 file changed, 37 insertions(+), 22 deletions(-) diff --git a/mediator/med_enthalpy_mod.F90 b/mediator/med_enthalpy_mod.F90 index 525d9ad2a..a8ea5f0d2 100644 --- a/mediator/med_enthalpy_mod.F90 +++ b/mediator/med_enthalpy_mod.F90 @@ -149,24 +149,27 @@ subroutine med_compute_enthalpy(is_local, rc) call fldbun_getdata1d(is_local%wrap%FBImp(compocn,compocn), 'So_omask', ofrac, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_hrain' , rc=rc)) then - call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Faxa_hrain', hrain_a, rc=rc) + if (FB_fldchk(is_local%wrap%FBImp(compatm,compocn), 'Faxa_hrain' , rc=rc)) then + call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compocn), 'Faxa_hrain', hrain_a, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return do n = 1,nmax hrain(n) = hrain_a(n) - tkfrz*rain(n)*cpfw * ofrac(n) enddo - else if (FB_fldchk(is_local%wrap%FBExp(compocn), 'Sa_tbot' , rc=rc)) then - do n = 1,nmax - hrain(n) = max((tbot(n) - tkfrz), 0._r8) * rain(n) * cpfw * ofrac(n) - enddo - else - do n = 1,nmax - hrain(n) = max((tocn(n) - tkfrz), 0._r8) * rain(n) * cpfw * ofrac(n) - enddo + else + if (FB_fldchk(is_local%wrap%FBExp(compocn), 'Sa_tbot' , rc=rc)) then + do n = 1,nmax + hrain(n) = max((tbot(n) - tkfrz), 0._r8) * rain(n) * cpfw * ofrac(n) + enddo + else + do n = 1,nmax + hrain(n) = max((tocn(n) - tkfrz), 0._r8) * rain(n) * cpfw * ofrac(n) + enddo + endif + hrain_a => hrain endif - if (FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_hevap' , rc=rc)) then - call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Faxa_hevap', hevap_a, rc=rc) + if (FB_fldchk(is_local%wrap%FBImp(compatm,compocn), 'Faxa_hevap' , rc=rc)) then + call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compocn), 'Faxa_hevap', hevap_a, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return do n = 1,nmax hevap(n) = min(hevap_a(n),0._r8) - tkfrz * min(evap(n),0._r8) * cpwv * ofrac(n) @@ -177,22 +180,27 @@ subroutine med_compute_enthalpy(is_local, rc) hevap(n) = (tocn(n) - tkfrz) * min(evap(n),0._r8) * cpwv * ofrac(n) hcond(n) = (tocn(n) - tkfrz) * max(evap(n),0._r8) * cpwv * ofrac(n) enddo + hevap_a => hevap endif - if (FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_hsnow' , rc=rc)) then - call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Faxa_hsnow', hsnow_a, rc=rc) + if (FB_fldchk(is_local%wrap%FBImp(compatm,compocn), 'Faxa_hsnow' , rc=rc)) then + call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compocn), 'Faxa_hsnow', hsnow_a, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return do n = 1,nmax hsnow(n) = hsnow_a(n) - tkfrz * snow(n) * cpice * ofrac(n) enddo - else if (FB_fldchk(is_local%wrap%FBExp(compocn), 'Sa_tbot' , rc=rc)) then - do n = 1,nmax - hsnow(n) = min((tbot(n) - tkfrz), 0._r8) * snow(n) * cpice * ofrac(n) - enddo - else - do n = 1,nmax - hsnow(n) = min((tocn(n) - tkfrz), 0._r8) * snow(n) * cpice * ofrac(n) - enddo + else + + if (FB_fldchk(is_local%wrap%FBExp(compocn), 'Sa_tbot' , rc=rc)) then + do n = 1,nmax + hsnow(n) = min((tbot(n) - tkfrz), 0._r8) * snow(n) * cpice * ofrac(n) + enddo + else + do n = 1,nmax + hsnow(n) = min((tocn(n) - tkfrz), 0._r8) * snow(n) * cpice * ofrac(n) + enddo + endif + hsnow_a => hsnow endif allocate(hrofl_a(nmax)) @@ -235,6 +243,13 @@ subroutine med_compute_enthalpy(is_local, rc) reduceflag=ESMF_REDUCE_SUM, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (maintask) write(logunit, '(a,a,f21.13)') trim(subname),' global enthalpy correction: ',global_htot_corr(1) +#ifdef DEBUG + write(logunit, '(a,a,f21.13)') trim(subname), 'hrain_a: ',minval(hrain_a),maxval(hrain_a),sum(hrain_a) + write(logunit, '(a,a,f21.13)') trim(subname), 'hsnow_a: ',minval(hsnow_a),maxval(hsnow_a),sum(hsnow_a) + write(logunit, '(a,a,f21.13)') trim(subname), 'hevap_a: ',minval(hevap_a),maxval(hevap_a),sum(hevap_a) + write(logunit, '(a,a,f21.13)') trim(subname), 'hrofl_a: ',minval(hrofl_a),maxval(hrofl_a),sum(hrofl_a) + write(logunit, '(a,a,f21.13)') trim(subname), 'hrofi_a: ',minval(hrofi_a),maxval(hrofi_a),sum(hrofi_a) +#endif deallocate(hcorr) endif if(.not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hsnow', rc)) deallocate(hsnow) From f4696f18c54b87101a529a393e35ef3e7a5c2ec2 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 20 Sep 2023 12:35:31 -0600 Subject: [PATCH 20/30] fix formatting --- mediator/med_enthalpy_mod.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/mediator/med_enthalpy_mod.F90 b/mediator/med_enthalpy_mod.F90 index a8ea5f0d2..8e052a7a6 100644 --- a/mediator/med_enthalpy_mod.F90 +++ b/mediator/med_enthalpy_mod.F90 @@ -244,11 +244,11 @@ subroutine med_compute_enthalpy(is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (maintask) write(logunit, '(a,a,f21.13)') trim(subname),' global enthalpy correction: ',global_htot_corr(1) #ifdef DEBUG - write(logunit, '(a,a,f21.13)') trim(subname), 'hrain_a: ',minval(hrain_a),maxval(hrain_a),sum(hrain_a) - write(logunit, '(a,a,f21.13)') trim(subname), 'hsnow_a: ',minval(hsnow_a),maxval(hsnow_a),sum(hsnow_a) - write(logunit, '(a,a,f21.13)') trim(subname), 'hevap_a: ',minval(hevap_a),maxval(hevap_a),sum(hevap_a) - write(logunit, '(a,a,f21.13)') trim(subname), 'hrofl_a: ',minval(hrofl_a),maxval(hrofl_a),sum(hrofl_a) - write(logunit, '(a,a,f21.13)') trim(subname), 'hrofi_a: ',minval(hrofi_a),maxval(hrofi_a),sum(hrofi_a) + write(logunit, '(a,a,3f21.13)') trim(subname), ' hrain_a: ',minval(hrain_a),maxval(hrain_a),sum(hrain_a) + write(logunit, '(a,a,3f21.13)') trim(subname), ' hsnow_a: ',minval(hsnow_a),maxval(hsnow_a),sum(hsnow_a) + write(logunit, '(a,a,3f21.13)') trim(subname), ' hevap_a: ',minval(hevap_a),maxval(hevap_a),sum(hevap_a) + write(logunit, '(a,a,3f21.13)') trim(subname), ' hrofl_a: ',minval(hrofl_a),maxval(hrofl_a),sum(hrofl_a) + write(logunit, '(a,a,3f21.13)') trim(subname), ' hrofi_a: ',minval(hrofi_a),maxval(hrofi_a),sum(hrofi_a) #endif deallocate(hcorr) endif From 58c6bb6228945e0ce98959e62dc62b3a2f9c8ecb Mon Sep 17 00:00:00 2001 From: James Edwards Date: Thu, 21 Sep 2023 18:20:44 -0600 Subject: [PATCH 21/30] properly retreve atm fields --- mediator/med_enthalpy_mod.F90 | 12 ++++++------ mediator/med_phases_ocnalb_mod.F90 | 12 ++++-------- 2 files changed, 10 insertions(+), 14 deletions(-) diff --git a/mediator/med_enthalpy_mod.F90 b/mediator/med_enthalpy_mod.F90 index 8e052a7a6..434e6f336 100644 --- a/mediator/med_enthalpy_mod.F90 +++ b/mediator/med_enthalpy_mod.F90 @@ -149,8 +149,8 @@ subroutine med_compute_enthalpy(is_local, rc) call fldbun_getdata1d(is_local%wrap%FBImp(compocn,compocn), 'So_omask', ofrac, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (FB_fldchk(is_local%wrap%FBImp(compatm,compocn), 'Faxa_hrain' , rc=rc)) then - call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compocn), 'Faxa_hrain', hrain_a, rc=rc) + if (FB_fldchk(is_local%wrap%FBExp(compatm), 'Faxa_hrain' , rc=rc)) then + call FB_GetFldPtr(is_local%wrap%FBExp(compatm), 'Faxa_hrain', hrain_a, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return do n = 1,nmax hrain(n) = hrain_a(n) - tkfrz*rain(n)*cpfw * ofrac(n) @@ -168,8 +168,8 @@ subroutine med_compute_enthalpy(is_local, rc) hrain_a => hrain endif - if (FB_fldchk(is_local%wrap%FBImp(compatm,compocn), 'Faxa_hevap' , rc=rc)) then - call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compocn), 'Faxa_hevap', hevap_a, rc=rc) + if (FB_fldchk(is_local%wrap%FBExp(compatm), 'Faxa_hevap' , rc=rc)) then + call FB_GetFldPtr(is_local%wrap%FBExp(compatm), 'Faxa_hevap', hevap_a, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return do n = 1,nmax hevap(n) = min(hevap_a(n),0._r8) - tkfrz * min(evap(n),0._r8) * cpwv * ofrac(n) @@ -183,8 +183,8 @@ subroutine med_compute_enthalpy(is_local, rc) hevap_a => hevap endif - if (FB_fldchk(is_local%wrap%FBImp(compatm,compocn), 'Faxa_hsnow' , rc=rc)) then - call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compocn), 'Faxa_hsnow', hsnow_a, rc=rc) + if (FB_fldchk(is_local%wrap%FBExp(compatm), 'Faxa_hsnow' , rc=rc)) then + call FB_GetFldPtr(is_local%wrap%FBExp(compatm), 'Faxa_hsnow', hsnow_a, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return do n = 1,nmax hsnow(n) = hsnow_a(n) - tkfrz * snow(n) * cpice * ofrac(n) diff --git a/mediator/med_phases_ocnalb_mod.F90 b/mediator/med_phases_ocnalb_mod.F90 index 304d0c7fd..840082b36 100644 --- a/mediator/med_phases_ocnalb_mod.F90 +++ b/mediator/med_phases_ocnalb_mod.F90 @@ -636,7 +636,7 @@ subroutine med_phases_ocnalb_orbital_update(clock, logunit, maintask, eccen, ob integer :: orb_year ! orbital year for current orbital computation character(len=CL) :: msgstr ! temporary logical :: lprint - logical :: first_time = .true. + logical, save :: first_time = .true. character(len=*) , parameter :: subname = "(med_phases_ocnalb_orbital_update)" !------------------------------------------- @@ -648,16 +648,12 @@ subroutine med_phases_ocnalb_orbital_update(clock, logunit, maintask, eccen, ob call ESMF_TimeGet(CurrTime, yy=year, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return orb_year = orb_iyear + (year - orb_iyear_align) - lprint = maintask + if(first_time) lprint = maintask else orb_year = orb_iyear - if (first_time) then - lprint = maintask - first_time = .false. - else - lprint = .false. - end if + if(first_time) lprint = maintask end if + first_time = .false. eccen = orb_eccen shr_log_unit = logunit From ac2ed8623be249cf9b6648a859fc443f2e6d86fa Mon Sep 17 00:00:00 2001 From: James Edwards Date: Fri, 22 Sep 2023 08:30:59 -0600 Subject: [PATCH 22/30] corrections to ofrac and atm enthalpy terms --- mediator/esmFldsExchange_cesm_mod.F90 | 8 +------- mediator/med_enthalpy_mod.F90 | 22 +++++++++++----------- 2 files changed, 12 insertions(+), 18 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 7c978d70d..875b26c89 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -1784,7 +1784,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addfld_from(compatm, 'Faxa_snowl') call addfld_to(compocn, 'Faxa_snow' ) else - ! TODO: why are we not merging Faxa_rain and Faxa_snow if they are sent from atm wiht ofrac + ! TODO: why are we not merging Faxa_rain and Faxa_snow if they are sent from atm with 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. & @@ -2007,22 +2007,16 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if ( fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_hrain', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_hrain', rc=rc)) then call addmap_from(compatm, 'Faxa_hrain', compocn, mapconsf, 'one', atm2ocn_map) - call addmrg_to(compocn, 'Faxa_hrain', & - mrg_from=compatm, mrg_fld='Faxa_hrain', mrg_type='copy') end if if ( fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_hsnow', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_hsnow', rc=rc)) then call addmap_from(compatm, 'Faxa_hsnow', compocn, mapconsf, 'one', atm2ocn_map) - call addmrg_to(compocn, 'Faxa_hsnow', & - mrg_from=compatm, mrg_fld='Faxa_hsnow', mrg_type='copy') end if if ( fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_hevap', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_hevap', rc=rc)) then call addmap_from(compatm, 'Faxa_hevap', compocn, mapconsf, 'one', atm2ocn_map) - call addmrg_to(compocn, 'Faxa_hevap', & - mrg_from=compatm, mrg_fld='Faxa_hevap', mrg_type='copy') end if end if diff --git a/mediator/med_enthalpy_mod.F90 b/mediator/med_enthalpy_mod.F90 index 434e6f336..59db94a23 100644 --- a/mediator/med_enthalpy_mod.F90 +++ b/mediator/med_enthalpy_mod.F90 @@ -146,14 +146,14 @@ subroutine med_compute_enthalpy(is_local, rc) allocate(hrofi(nmax)) endif - call fldbun_getdata1d(is_local%wrap%FBImp(compocn,compocn), 'So_omask', ofrac, rc) + call FB_GetFldPtr(is_local%wrap%FBfrac(compocn), 'ofrac' , ofrac, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (FB_fldchk(is_local%wrap%FBExp(compatm), 'Faxa_hrain' , rc=rc)) then - call FB_GetFldPtr(is_local%wrap%FBExp(compatm), 'Faxa_hrain', hrain_a, rc=rc) + if (FB_fldchk(is_local%wrap%FBImp(compatm,compocn), 'Faxa_hrain' , rc=rc)) then + call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compocn), 'Faxa_hrain', hrain_a, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return do n = 1,nmax - hrain(n) = hrain_a(n) - tkfrz*rain(n)*cpfw * ofrac(n) + hrain(n) = (hrain_a(n) - tkfrz*rain(n)*cpfw) * ofrac(n) enddo else if (FB_fldchk(is_local%wrap%FBExp(compocn), 'Sa_tbot' , rc=rc)) then @@ -168,12 +168,12 @@ subroutine med_compute_enthalpy(is_local, rc) hrain_a => hrain endif - if (FB_fldchk(is_local%wrap%FBExp(compatm), 'Faxa_hevap' , rc=rc)) then - call FB_GetFldPtr(is_local%wrap%FBExp(compatm), 'Faxa_hevap', hevap_a, rc=rc) + if (FB_fldchk(is_local%wrap%FBImp(compatm, compocn), 'Faxa_hevap' , rc=rc)) then + call FB_GetFldPtr(is_local%wrap%FBImp(compatm, compocn), 'Faxa_hevap', hevap_a, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return do n = 1,nmax - hevap(n) = min(hevap_a(n),0._r8) - tkfrz * min(evap(n),0._r8) * cpwv * ofrac(n) - hcond(n) = max(hevap_a(n),0._r8) - tkfrz * max(evap(n),0._r8) * cpwv * ofrac(n) + hevap(n) = (min(hevap_a(n),0._r8) - tkfrz * min(evap(n),0._r8) * cpwv) * ofrac(n) + hcond(n) = (max(hevap_a(n),0._r8) - tkfrz * max(evap(n),0._r8) * cpwv) * ofrac(n) enddo else do n = 1,nmax @@ -183,11 +183,11 @@ subroutine med_compute_enthalpy(is_local, rc) hevap_a => hevap endif - if (FB_fldchk(is_local%wrap%FBExp(compatm), 'Faxa_hsnow' , rc=rc)) then - call FB_GetFldPtr(is_local%wrap%FBExp(compatm), 'Faxa_hsnow', hsnow_a, rc=rc) + if (FB_fldchk(is_local%wrap%FBImp(compatm, compocn), 'Faxa_hsnow' , rc=rc)) then + call FB_GetFldPtr(is_local%wrap%FBImp(compatm, compocn), 'Faxa_hsnow', hsnow_a, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return do n = 1,nmax - hsnow(n) = hsnow_a(n) - tkfrz * snow(n) * cpice * ofrac(n) + hsnow(n) = (hsnow_a(n) - tkfrz * snow(n) * cpice) * ofrac(n) enddo else From adc6bbdb24afadca4d19cb49e6e103b895d3076c Mon Sep 17 00:00:00 2001 From: James Edwards Date: Mon, 25 Sep 2023 09:43:55 -0600 Subject: [PATCH 23/30] correct transfer of enthalpy fields --- mediator/esmFldsExchange_cesm_mod.F90 | 16 +++++++--------- mediator/med_enthalpy_mod.F90 | 2 +- 2 files changed, 8 insertions(+), 10 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 875b26c89..6e049a0a2 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -1991,7 +1991,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! 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 + ! will be computed directly in med_enthalpy_mod if (phase == 'advertise') then call addfld_to(compocn, 'Foxx_hrain') call addfld_to(compocn, 'Foxx_hsnow') @@ -2004,18 +2004,16 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addfld_from(compatm, 'Faxa_hsnow') call addfld_from(compatm, 'Faxa_hevap') else - if ( fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_hrain', rc=rc) .and. & - fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_hrain', rc=rc)) then + if ( fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_hrain', rc=rc)) then + ! fldchk(is_local%wrap%FBExp(compocn) , 'Foxx_hrain', rc=rc)) then call addmap_from(compatm, 'Faxa_hrain', compocn, mapconsf, 'one', atm2ocn_map) end if - if ( fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_hsnow', rc=rc) .and. & - - fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_hsnow', rc=rc)) then + if ( fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_hsnow', rc=rc)) then + ! fldchk(is_local%wrap%FBExp(compocn) , 'Foxx_hsnow', rc=rc)) then call addmap_from(compatm, 'Faxa_hsnow', compocn, mapconsf, 'one', atm2ocn_map) end if - if ( fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_hevap', rc=rc) .and. & - - fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_hevap', rc=rc)) then + if ( fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_hevap', rc=rc)) then + ! fldchk(is_local%wrap%FBExp(compocn) , 'Foxx_hevap', rc=rc)) then call addmap_from(compatm, 'Faxa_hevap', compocn, mapconsf, 'one', atm2ocn_map) end if end if diff --git a/mediator/med_enthalpy_mod.F90 b/mediator/med_enthalpy_mod.F90 index 59db94a23..7e4f72898 100644 --- a/mediator/med_enthalpy_mod.F90 +++ b/mediator/med_enthalpy_mod.F90 @@ -150,7 +150,7 @@ subroutine med_compute_enthalpy(is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (FB_fldchk(is_local%wrap%FBImp(compatm,compocn), 'Faxa_hrain' , rc=rc)) then - call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compocn), 'Faxa_hrain', hrain_a, rc=rc) + call FB_GetFldPtr(is_local%wrap%FBImp(compatm, compocn), 'Faxa_hrain', hrain_a, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return do n = 1,nmax hrain(n) = (hrain_a(n) - tkfrz*rain(n)*cpfw) * ofrac(n) From f7e4572e753ec113aba4e7d033bd4e5da9ef2273 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Thu, 5 Oct 2023 07:39:42 -0600 Subject: [PATCH 24/30] add atm enthalpy to diagnostics table --- mediator/med_diag_mod.F90 | 25 ++++++++++++++++++++++--- 1 file changed, 22 insertions(+), 3 deletions(-) diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index 8ea6651ea..fe218fc81 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -144,6 +144,7 @@ module med_diag_mod integer :: f_heat_latf = unset_index ! heat : latent, fusion, snow integer :: f_heat_ioff = unset_index ! heat : latent, fusion, frozen runoff integer :: f_heat_sen = unset_index ! heat : sensible + 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 @@ -405,7 +406,7 @@ subroutine med_diag_init(gcomp, rc) ! Salt fluxes budget terms (for v1 only) ! ----------------------------------------- - if (trim(budget_table_version) == 'v1') then + if (trim(budget_table_version) .ne. 'v0') then call add_to_budget_diag(budget_diags%fields, f_watr_salt ,'saltf') ! field water: salt flux f_salt_beg = f_watr_salt f_salt_end = f_watr_salt @@ -444,7 +445,6 @@ subroutine med_diag_init(gcomp, rc) allocate(budget_global (f_size , c_size , p_size)) ! global sum, valid only on root pe allocate(budget_counter (f_size , c_size , p_size)) ! counter, valid only on root pe allocate(budget_global_1d(f_size * c_size * p_size)) ! needed for ESMF_VMReduce call - end subroutine med_diag_init integer function get_diag_attribute(gcomp, name, rc) @@ -726,6 +726,25 @@ subroutine med_phases_diag_atm(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if + call diag_atm_recv(is_local%wrap%FBImp(compatm,compatm), 'Faxa_hrain', f_heat_rain, & + areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call diag_atm_recv(is_local%wrap%FBImp(compatm,compatm), 'Faxa_hsnow', f_heat_snow, & + areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call diag_atm_recv(is_local%wrap%FBImp(compatm,compatm), 'Faxa_hevap', f_heat_evap, & + areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call diag_atm_recv(is_local%wrap%FBImp(compatm,compatm), 'Faxa_hrofl', f_heat_rofl, & + areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call diag_atm_recv(is_local%wrap%FBImp(compatm,compatm), 'Faxa_hrofi', f_heat_rofi, & + areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! heat implied by snow flux from atm to mediator budget_local(f_heat_latf,c_atm_recv ,ip) = -budget_local(f_watr_snow,c_atm_recv ,ip)*shr_const_latice budget_local(f_heat_latf,c_lnd_arecv,ip) = -budget_local(f_watr_snow,c_lnd_arecv,ip)*shr_const_latice @@ -2681,7 +2700,7 @@ subroutine med_diag_print_summary(data, ip, date, tod) ! write out net salt budgets ! ----------------------------- - if (trim(budget_table_version) == 'v1') then + if (trim(budget_table_version) .ne. 'v0') then write(diagunit,*) ' ' write(diagunit,FAH) subname,'NET SALT BUDGET (kg/m2s): period = ',& trim(budget_diags%periods(ip)%name), ': date = ',date,tod From bce11df9beed1ead93c6cd0451a5db4e89c46dc9 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Thu, 5 Oct 2023 16:59:34 -0600 Subject: [PATCH 25/30] map from atm to ocn --- mediator/med_enthalpy_mod.F90 | 36 ++++++++++++++++++++++++++-- mediator/med_phases_prep_ocn_mod.F90 | 1 - 2 files changed, 34 insertions(+), 3 deletions(-) diff --git a/mediator/med_enthalpy_mod.F90 b/mediator/med_enthalpy_mod.F90 index 7e4f72898..d7e1a0551 100644 --- a/mediator/med_enthalpy_mod.F90 +++ b/mediator/med_enthalpy_mod.F90 @@ -1,5 +1,5 @@ module med_enthalpy_mod - use ESMF, only : ESMF_SUCCESS, ESMF_GridComp, ESMF_VMAllreduce, ESMF_REDUCE_SUM + use ESMF, only : ESMF_SUCCESS, ESMF_GridComp, ESMF_VMAllreduce, ESMF_REDUCE_SUM, ESMF_FieldBundleGet, ESMF_Field 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 @@ -26,16 +26,19 @@ real(r8) function med_enthalpy_get_global_htot_corr() end function med_enthalpy_get_global_htot_corr subroutine med_compute_enthalpy(is_local, rc) + use med_map_mod, only : med_map_field + use med_internalstate_mod, only : mapconsf type(InternalState), intent(in) :: is_local integer, intent(out) :: rc ! local variables - + type(ESMF_Field) :: fld_a, fld_o real(r8), pointer :: tocn(:), rain(:), snow(:), rofl(:), rofi(:), evap(:) real(r8), pointer :: rainl(:), rainc(:), tbot(:) real(r8), pointer :: snowl(:), snowc(:), ofrac(:) real(r8), pointer :: hrain(:), hsnow(:), hevap(:), hcond(:), hrofl(:), hrofi(:) real(r8), pointer :: hrain_a(:), hevap_a(:), hsnow_a(:), hrofl_a(:), hrofi_a(:) + real(r8), allocatable :: hcorr(:) real(r8), pointer :: areas(:) real(r8), parameter :: glob_area_inv = 1._r8 / (4._r8 * pi) @@ -150,8 +153,18 @@ subroutine med_compute_enthalpy(is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (FB_fldchk(is_local%wrap%FBImp(compatm,compocn), 'Faxa_hrain' , rc=rc)) then + call ESMF_FieldBundleGet(is_local%wrap%FBImp(compatm, compatm), 'Faxa_hrain', field=fld_a, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldBundleGet(is_local%wrap%FBImp(compatm, compocn), 'Faxa_hrain', field=fld_o, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call med_map_field(fld_a, fld_o, is_local%wrap%RH(compatm, compocn,:), mapconsf, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBImp(compatm, compocn), 'Faxa_hrain', hrain_a, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + do n = 1,nmax hrain(n) = (hrain_a(n) - tkfrz*rain(n)*cpfw) * ofrac(n) enddo @@ -169,8 +182,18 @@ subroutine med_compute_enthalpy(is_local, rc) endif if (FB_fldchk(is_local%wrap%FBImp(compatm, compocn), 'Faxa_hevap' , rc=rc)) then + call ESMF_FieldBundleGet(is_local%wrap%FBImp(compatm, compatm), 'Faxa_hevap', field=fld_a, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldBundleGet(is_local%wrap%FBImp(compatm, compocn), 'Faxa_hevap', field=fld_o, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call med_map_field(fld_a, fld_o, is_local%wrap%RH(compatm, compocn,:), mapconsf, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBImp(compatm, compocn), 'Faxa_hevap', hevap_a, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + do n = 1,nmax hevap(n) = (min(hevap_a(n),0._r8) - tkfrz * min(evap(n),0._r8) * cpwv) * ofrac(n) hcond(n) = (max(hevap_a(n),0._r8) - tkfrz * max(evap(n),0._r8) * cpwv) * ofrac(n) @@ -184,6 +207,15 @@ subroutine med_compute_enthalpy(is_local, rc) endif if (FB_fldchk(is_local%wrap%FBImp(compatm, compocn), 'Faxa_hsnow' , rc=rc)) then + call ESMF_FieldBundleGet(is_local%wrap%FBImp(compatm, compatm), 'Faxa_hsnow', field=fld_a, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldBundleGet(is_local%wrap%FBImp(compatm, compocn), 'Faxa_hsnow', field=fld_o, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call med_map_field(fld_a, fld_o, is_local%wrap%RH(compatm, compocn,:), mapconsf, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBImp(compatm, compocn), 'Faxa_hsnow', hsnow_a, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return do n = 1,nmax diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index 11752a33c..a30ce7008 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -9,7 +9,6 @@ module med_phases_prep_ocn_mod use med_constants_mod , only : dbug_flag => med_constants_dbug_flag 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 use med_utils_mod , only : chkerr => med_utils_ChkErr use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose From 00a5b779a23a42701f8be372b2ca2c196ae6814b Mon Sep 17 00:00:00 2001 From: James Edwards Date: Mon, 9 Oct 2023 16:55:15 -0600 Subject: [PATCH 26/30] correction to enthalpy calculation, bug fix in abort code --- cesm/driver/esmApp.F90 | 2 +- mediator/med_enthalpy_mod.F90 | 7 +++---- 2 files changed, 4 insertions(+), 5 deletions(-) diff --git a/cesm/driver/esmApp.F90 b/cesm/driver/esmApp.F90 index 12cf1537d..5215ea2aa 100644 --- a/cesm/driver/esmApp.F90 +++ b/cesm/driver/esmApp.F90 @@ -139,7 +139,7 @@ program esmApp ! Call Run for the ensemble driver !----------------------------------------------------------------------------- call ESMF_GridCompRun(ensemble_driver_comp, userRc=urc, rc=rc) - if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, & + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & call ESMF_Finalize(endflag=ESMF_END_ABORT) diff --git a/mediator/med_enthalpy_mod.F90 b/mediator/med_enthalpy_mod.F90 index d7e1a0551..e19553a5f 100644 --- a/mediator/med_enthalpy_mod.F90 +++ b/mediator/med_enthalpy_mod.F90 @@ -164,7 +164,6 @@ subroutine med_compute_enthalpy(is_local, rc) call FB_GetFldPtr(is_local%wrap%FBImp(compatm, compocn), 'Faxa_hrain', hrain_a, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - do n = 1,nmax hrain(n) = (hrain_a(n) - tkfrz*rain(n)*cpfw) * ofrac(n) enddo @@ -260,10 +259,10 @@ subroutine med_compute_enthalpy(is_local, rc) allocate(hcorr(nmax)) areas => is_local%wrap%mesh_info(compocn)%areas do n = 1,nmax - hcorr(n) = (hrain_a(n) + hsnow_a(n) + hevap_a(n) + hrofl_a(n) + hrofi_a(n)) * & - areas(n) * glob_area_inv + ! hcorr(n) = (hrain_a(n) + hsnow_a(n) + hevap_a(n) + hrofl_a(n) + hrofi_a(n)) * & + ! areas(n) * glob_area_inv - ! hcorr(n) = (hrofl_a(n) + hrofi_a(n)) *areas(n) *glob_area_inv + hcorr(n) = (hrofl_a(n) + hrofi_a(n)) *areas(n) *glob_area_inv end do ! Determine sum of enthalpy correction for each hcorr index locally From ce8375a614da0d3a1527c4631e1607116f2539d2 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Tue, 10 Oct 2023 07:21:00 -0600 Subject: [PATCH 27/30] revert change to hcorr --- mediator/med_enthalpy_mod.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/mediator/med_enthalpy_mod.F90 b/mediator/med_enthalpy_mod.F90 index e19553a5f..fd51baf70 100644 --- a/mediator/med_enthalpy_mod.F90 +++ b/mediator/med_enthalpy_mod.F90 @@ -259,10 +259,10 @@ subroutine med_compute_enthalpy(is_local, rc) allocate(hcorr(nmax)) areas => is_local%wrap%mesh_info(compocn)%areas do n = 1,nmax - ! hcorr(n) = (hrain_a(n) + hsnow_a(n) + hevap_a(n) + hrofl_a(n) + hrofi_a(n)) * & - ! areas(n) * glob_area_inv + hcorr(n) = (hrain_a(n) + hsnow_a(n) + hevap_a(n) + hrofl_a(n) + hrofi_a(n)) * & + areas(n) * glob_area_inv - hcorr(n) = (hrofl_a(n) + hrofi_a(n)) *areas(n) *glob_area_inv + !hcorr(n) = (hrofl_a(n) + hrofi_a(n)) *areas(n) *glob_area_inv end do ! Determine sum of enthalpy correction for each hcorr index locally From 2dc4f211b7bb79ab03ed75268bbdd02d048e8603 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 31 Jul 2024 10:59:32 -0600 Subject: [PATCH 28/30] fix error in extbuild github workflow --- .github/workflows/extbuild.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/extbuild.yml b/.github/workflows/extbuild.yml index 55e0f8f92..7f7dde3a4 100644 --- a/.github/workflows/extbuild.yml +++ b/.github/workflows/extbuild.yml @@ -48,7 +48,7 @@ jobs: id: cache-ParallelIO uses: actions/cache@v4 with: - path: ~/pio + path: {GITHUB_WORKSPACE}/pio key: ${{ runner.os }}-${{ env.PIO_VERSION }}.pio - name: Build ParallelIO if: steps.cache-ParallelIO.outputs.cache-hit != 'true' From a65d1d0a9fe97c79c4c915aafc33f800bf677672 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 7 Aug 2024 13:49:43 -0600 Subject: [PATCH 29/30] set xgrid to default --- cime_config/namelist_definition_drv.xml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 222a15b26..a1857b935 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -929,7 +929,8 @@ default: ogrid - ogrid + xgrid + ogrid From 1f09a5de4ade7b13b8c2d35800e3fc354091970e Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Thu, 19 Sep 2024 13:05:22 -0600 Subject: [PATCH 30/30] fix issues --- mediator/med_phases_prep_atm_mod.F90 | 2 +- mediator/med_phases_prep_ocn_mod.F90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index d6155c696..a2734e945 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -267,7 +267,7 @@ subroutine med_phases_prep_atm_enthalpy_correction (gcomp, hcorr, rc) use ESMF , only : ESMF_VMAllreduce, ESMF_GridCompGet, ESMF_REDUCE_SUM use ESMF , only : ESMF_VM - + use med_enthalpy_mod, only : global_htot_corr ! input/output variables type(ESMF_GridComp) , intent(in) :: gcomp real(r8) , intent(in) :: hcorr(:) diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index aebf951f1..a3b311542 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -78,7 +78,7 @@ 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_enthalpy_mod , only : med_compute_enthalpy, mediator_compute_enthalpy - + use med_map_mod , only : med_map_field_packed ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc