Merge branch 'NOAA-EMC:emc/develop' into restart_fh

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

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))

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,13 +1273,27 @@
   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
   units = K m s-1
   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