From dc977bcadd1ade1a528dee75f1ad45e8bd80ca0a Mon Sep 17 00:00:00 2001 From: Daniel Rosen Date: Tue, 17 Sep 2024 08:18:34 -0600 Subject: [PATCH 1/2] add fire behavior tendencies to ufs ccpp (#117) * add hflx_fire, evap_fire, cpl_fire Co-authored-by: Grant Firl --- ufs/ccpp/data/MED_typedefs.F90 | 8 ++++++++ ufs/ccpp/data/MED_typedefs.meta | 20 ++++++++++++++++++++ 2 files changed, 28 insertions(+) diff --git a/ufs/ccpp/data/MED_typedefs.F90 b/ufs/ccpp/data/MED_typedefs.F90 index 786ce4711..649ee9b69 100644 --- a/ufs/ccpp/data/MED_typedefs.F90 +++ b/ufs/ccpp/data/MED_typedefs.F90 @@ -183,6 +183,7 @@ module MED_typedefs logical :: restart !< flag whether this is a coldstart (.false.) or a warmstart/restart (.true.) logical :: cplice !< default no cplice collection (used together with cplflx) logical :: cplflx !< flag controlling cplflx collection (default off) + logical :: cpl_fire !< flag controlling fire behavior collection (default off) integer :: kdt !< current forecast iteration real(kind=kind_phys) :: min_lakeice !< minimum lake ice value real(kind=kind_phys) :: min_seaice !< minimum sea ice value @@ -262,7 +263,9 @@ module MED_typedefs real(kind=kind_phys), pointer :: ffhh(:) => null() !< Monin-Obukhov similarity function for heat real(kind=kind_phys), pointer :: ffmm(:) => null() !< Monin-Obukhov similarity function for momentum real(kind=kind_phys), pointer :: evap(:) => null() !< kinematic surface upward latent heat flux (kg kg-1 m s-1) + real(kind=kind_phys), pointer :: evap_fire(:) => null() !< kinematic surface upward latent heat flux of fire (kg kg-1 m s-1) real(kind=kind_phys), pointer :: hflx(:) => null() !< kinematic surface upward sensible heat flux (K m/s) + real(kind=kind_phys), pointer :: hflx_fire(:) => null() !< kinematic surface upward sensible heat flux of fire (K m/s) real(kind=kind_phys), pointer :: tiice(:,:) => null() !< sea ice internal temperature real(kind=kind_phys), pointer :: t2m(:) => null() !< temperature at 2 m real(kind=kind_phys), pointer :: q2m(:) => null() !< specific humidity at 2 m @@ -655,6 +658,7 @@ subroutine control_initialize(model) model%restart = .false. model%cplice = .false. model%cplflx = .false. + model%cpl_fire = .false. model%kdt = 0 ! nint(Model%fhour*con_hr/Model%dtp) model%min_lakeice = 0.15d0 model%min_seaice = 1.0d-11 @@ -767,8 +771,12 @@ subroutine sfcprop_create(sfcprop, im, model) sfcprop%ffmm = clear_val allocate(sfcprop%evap(im)) sfcprop%evap = clear_val + allocate(sfcprop%evap_fire(im)) + sfcprop%evap_fire = clear_val allocate(sfcprop%hflx(im)) sfcprop%hflx = clear_val + allocate(sfcprop%hflx_fire(im)) + sfcprop%hflx_fire = clear_val allocate(sfcprop%tiice(im,model%kice)) sfcprop%tiice = clear_val allocate(sfcprop%t2m(im)) diff --git a/ufs/ccpp/data/MED_typedefs.meta b/ufs/ccpp/data/MED_typedefs.meta index c14616a6a..046e4bfa6 100644 --- a/ufs/ccpp/data/MED_typedefs.meta +++ b/ufs/ccpp/data/MED_typedefs.meta @@ -917,6 +917,12 @@ units = 1 dimensions = () type = integer +[cpl_fire] + standard_name = do_fire_coupling + long_name = flag controlling fire_behavior collection (default off) + units = flag + dimensions = () + type = logical [kdt] standard_name = index_of_timestep long_name = current forecast iteration @@ -1267,6 +1273,13 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys +[evap_fire] + standard_name = surface_upward_specific_humidity_flux_of_fire + long_name = kinematic surface upward latent heat flux of fire + units = kg kg-1 m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys [hflx] standard_name = surface_upward_temperature_flux long_name = kinematic surface upward sensible heat flux @@ -1274,6 +1287,13 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys +[hflx_fire] + standard_name = kinematic_surface_upward_sensible_heat_flux_of_fire + long_name = kinematic surface upward sensible heat flux of fire + units = K m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys [tiice] standard_name = temperature_in_ice_layer long_name = sea ice internal temperature From 24e9eed4ffe8138bef635c8f916f91b142595675 Mon Sep 17 00:00:00 2001 From: Justin Perket Date: Thu, 10 Oct 2024 11:59:40 -0400 Subject: [PATCH 2/2] Enable Data Atmosphere Coupling of GFDL Land Model (#113) --- mediator/esmFldsExchange_ufs_mod.F90 | 32 ++++++++++++++++++++++++++++ 1 file changed, 32 insertions(+) diff --git a/mediator/esmFldsExchange_ufs_mod.F90 b/mediator/esmFldsExchange_ufs_mod.F90 index 57c266b59..9b23a6d5e 100644 --- a/mediator/esmFldsExchange_ufs_mod.F90 +++ b/mediator/esmFldsExchange_ufs_mod.F90 @@ -55,6 +55,9 @@ subroutine esmFldsExchange_ufs(gcomp, phase, rc) character(len=CS) :: fldname character(len=CS), allocatable :: flds(:), oflds(:), aflds(:), iflds(:) character(len=*) , parameter :: subname='(esmFldsExchange_ufs)' + + ! component name + character(len=CS) :: lnd_name = '' !-------------------------------------- rc = ESMF_SUCCESS @@ -76,6 +79,13 @@ subroutine esmFldsExchange_ufs(gcomp, phase, rc) write(msgString,'(A,i6,A)') trim(subname)//': maptype is ',maptype,', '//mapnames(maptype) call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + ! determine which land model is present + if (is_local%wrap%comp_present(complnd)) then + call NUOPC_CompAttributeGet(gcomp, name="LND_model", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + lnd_name = trim(cvalue) + end if + if (trim(coupling_mode) == 'ufs.nfrac.aoflux' .or. trim(coupling_mode) == 'ufs.frac.aoflux') then med_aoflux_to_ocn = .true. else @@ -773,6 +783,28 @@ subroutine esmFldsExchange_ufs(gcomp, phase, rc) end do deallocate(flds) + + if (lnd_name == 'lm4') then + allocate(flds(4)) + flds = (/'Faxa_swndr', 'Faxa_swndf', 'Faxa_swvdr', 'Faxa_swvdf' /) + do n = 1,size(flds) + fldname = trim(flds(n)) + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(complnd)) then + call addfld_from(compatm , fldname) + call addfld_to(complnd , fldname) + end if + else + if ( fldchk(is_local%wrap%FBexp(complnd) , fldname, rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), fldname, rc=rc)) then + call addmap_from(compatm, fldname, complnd, maptype, 'one', 'unset') + call addmrg_to(complnd, fldname, mrg_from=compatm, mrg_fld=fldname, mrg_type='copy') + end if + end if + end do + deallocate(flds) + end if ! lm4 + end subroutine esmFldsExchange_ufs end module esmFldsExchange_ufs_mod