Skip to content

Commit

Permalink
Initialize ice fluxes and add "tiice" array (NOAA-EMC#119)
Browse files Browse the repository at this point in the history
(1) Introducing a separate array "tiice" to store internal ice temperature. "tiice" will be added to phyf*nc output only when frac_grid=T.
(2) When cplflx=T, initializing ice fluxes by PBL calculated values when fluxes from CICE are unavailable.
(3) Adding frac_grid to namelist and no longer modifying it inside FV3GFS_io.F90. frac_grid=F by default.
  • Loading branch information
ShanSunNOAA authored May 27, 2020
1 parent 6590d4b commit 9868550
Show file tree
Hide file tree
Showing 5 changed files with 84 additions and 39 deletions.
18 changes: 17 additions & 1 deletion gfsphysics/GFS_layer/GFS_diagnostics.F90
Original file line number Diff line number Diff line change
Expand Up @@ -13,7 +13,7 @@ module GFS_diagnostics
GFS_stateout_type, GFS_sfcprop_type, &
GFS_coupling_type, GFS_grid_type, &
GFS_tbd_type, GFS_cldprop_type, &
GFS_radtend_type, GFS_diag_type, &
GFS_radtend_type, GFS_diag_type, &
GFS_init_type
implicit none
private
Expand Down Expand Up @@ -2778,6 +2778,22 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop
ExtDiag(idx)%data(nb)%var2 => Sfcprop(nb)%tsfc(:)
enddo

if (Model%frac_grid) then
do num = 1,Model%kice
write (xtra,'(i1)') num
idx = idx + 1
ExtDiag(idx)%axes = 2
ExtDiag(idx)%name = 'tiice'//trim(xtra)
ExtDiag(idx)%desc = 'internal ice temperature layer ' // trim(xtra)
ExtDiag(idx)%unit = 'K'
ExtDiag(idx)%mod_name = 'gfs_sfc'
allocate (ExtDiag(idx)%data(nblks))
do nb = 1,nblks
ExtDiag(idx)%data(nb)%var2 => Sfcprop(nb)%tiice(:,num)
enddo
enddo
end if

idx = idx + 1
ExtDiag(idx)%axes = 2
ExtDiag(idx)%name = 'tg3'
Expand Down
17 changes: 6 additions & 11 deletions gfsphysics/GFS_layer/GFS_typedefs.F90
Original file line number Diff line number Diff line change
Expand Up @@ -236,6 +236,7 @@ module GFS_typedefs
real (kind=kind_phys), pointer :: tsfco (:) => null() !< sst in K
real (kind=kind_phys), pointer :: tsfcl (:) => null() !< surface land temperature in K
real (kind=kind_phys), pointer :: tisfc (:) => null() !< surface temperature over ice fraction
real (kind=kind_phys), pointer :: tiice(:,:) => null() !< internal ice temperature
real (kind=kind_phys), pointer :: snowd (:) => null() !< snow depth water equivalent in mm ; same as snwdph
real (kind=kind_phys), pointer :: zorl (:) => null() !< composite surface roughness in cm
real (kind=kind_phys), pointer :: zorlo (:) => null() !< ocean surface roughness in cm
Expand Down Expand Up @@ -751,6 +752,7 @@ module GFS_typedefs
integer :: lsm_noahmp=2 !< flag for NOAH land surface model
integer :: lsm_ruc=3 !< flag for RUC land surface model
integer :: lsoil !< number of soil layers
integer :: kice=2 !< number of layers in sice
#ifdef CCPP
integer :: lsoil_lsm !< number of soil layers internal to land surface model
integer :: lsnow_lsm !< maximum number of snow layers internal to land surface model
Expand Down Expand Up @@ -955,7 +957,6 @@ module GFS_typedefs
!< nstf_name(5) : zsea2 in mm
!--- fractional grid
logical :: frac_grid !< flag for fractional grid
logical :: frac_grid_off !< flag for using fractional grid
logical :: ignore_lake !< flag for ignoring lakes
real(kind=kind_phys) :: min_lakeice !< minimum lake ice value
real(kind=kind_phys) :: min_seaice !< minimum sea ice value
Expand Down Expand Up @@ -2169,6 +2170,7 @@ subroutine sfcprop_create (Sfcprop, IM, Model)
allocate (Sfcprop%tsfco (IM))
allocate (Sfcprop%tsfcl (IM))
allocate (Sfcprop%tisfc (IM))
allocate (Sfcprop%tiice (IM,Model%kice))
allocate (Sfcprop%snowd (IM))
allocate (Sfcprop%zorl (IM))
allocate (Sfcprop%zorlo (IM))
Expand All @@ -2185,6 +2187,7 @@ subroutine sfcprop_create (Sfcprop, IM, Model)
Sfcprop%tsfco = clear_val
Sfcprop%tsfcl = clear_val
Sfcprop%tisfc = clear_val
Sfcprop%tiice = clear_val
Sfcprop%snowd = clear_val
Sfcprop%zorl = clear_val
Sfcprop%zorlo = clear_val
Expand Down Expand Up @@ -3152,7 +3155,6 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, &
!< nstf_name(5) : zsea2 in mm
!--- fractional grid
logical :: frac_grid = .false. !< flag for fractional grid
logical :: frac_grid_off = .true. !< flag for using fractional grid
logical :: ignore_lake = .true. !< flag for ignoring lakes
real(kind=kind_phys) :: min_lakeice = 0.15d0 !< minimum lake ice value
real(kind=kind_phys) :: min_seaice = 1.0d-11 !< minimum sea ice value
Expand Down Expand Up @@ -3316,7 +3318,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, &
!--- near surface sea temperature model
nst_anl, lsea, nstf_name, &
frac_grid, min_lakeice, min_seaice, min_lake_height, &
frac_grid_off, ignore_lake, &
ignore_lake, &
!--- surface layer
sfc_z0_type, &
! vertical diffusion
Expand Down Expand Up @@ -3773,14 +3775,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, &

!--- fractional grid
Model%frac_grid = frac_grid
Model%frac_grid_off = frac_grid_off
Model%ignore_lake = ignore_lake
#ifdef CCPP
if (Model%frac_grid) then
write(0,*) "ERROR: CCPP has not been tested with fractional landmask turned on"
! stop
end if
#endif
Model%min_lakeice = min_lakeice
Model%min_seaice = min_seaice
Model%min_lake_height = min_lake_height
Expand Down Expand Up @@ -4167,7 +4162,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, &
endif

print *,' nst_anl=',Model%nst_anl,' use_ufo=',Model%use_ufo,' frac_grid=',Model%frac_grid,&
' frac_grid_off=',frac_grid_off,' ignore_lake=',ignore_lake
' ignore_lake=',ignore_lake
print *,' min_lakeice=',Model%min_lakeice,' min_seaice=',Model%min_seaice, &
'min_lake_height=',Model%min_lake_height
if (Model%nstf_name(1) > 0 ) then
Expand Down
13 changes: 13 additions & 0 deletions gfsphysics/GFS_layer/GFS_typedefs.meta
Original file line number Diff line number Diff line change
Expand Up @@ -492,6 +492,13 @@
dimensions = (horizontal_dimension)
type = real
kind = kind_phys
[tiice]
standard_name = internal_ice_temperature
long_name = sea ice internal temperature
units = K
dimensions = (horizontal_dimension,ice_vertical_dimension)
type = real
kind = kind_phys
[snowd]
standard_name = surface_snow_thickness_water_equivalent
long_name = water equivalent snow depth
Expand Down Expand Up @@ -2752,6 +2759,12 @@
units = flag
dimensions = ()
type = integer
[kice]
standard_name = ice_vertical_dimension
long_name = vertical loop extent for ice levels, start at 1
units = count
dimensions = ()
type = integer
[lsoil]
standard_name = soil_vertical_dimension
long_name = number of soil layers
Expand Down
73 changes: 47 additions & 26 deletions io/FV3GFS_io.F90
Original file line number Diff line number Diff line change
Expand Up @@ -79,7 +79,7 @@ module FV3GFS_io_mod

!--- GFDL FMS restart containers
character(len=32), allocatable, dimension(:) :: oro_name2, sfc_name2, sfc_name3
real(kind=kind_phys), allocatable, target, dimension(:,:,:) :: oro_var2, sfc_var2, phy_var2
real(kind=kind_phys), allocatable, target, dimension(:,:,:) :: oro_var2, sfc_var2, phy_var2, sfc_var3ice
real(kind=kind_phys), allocatable, target, dimension(:,:,:,:) :: sfc_var3, phy_var3
!--- Noah MP restart containers
real(kind=kind_phys), allocatable, target, dimension(:,:,:,:) :: sfc_var3sn,sfc_var3eq,sfc_var3zn
Expand All @@ -89,7 +89,7 @@ module FV3GFS_io_mod
integer :: tot_diag_idx = 0
integer :: total_outputlevel = 0
integer :: isco,ieco,jsco,jeco,levo,num_axes_phys
integer :: fhzero, ncld, nsoil, imp_physics, landsfcmdl
integer :: fhzero, ncld, nsoil, imp_physics, landsfcmdl, k
real(4) :: dtp
logical :: lprecip_accu
character(len=64) :: Sprecip_accu
Expand Down Expand Up @@ -193,9 +193,9 @@ subroutine FV3GFS_IPD_checksum (Model, IPD_Data, Atm_block)
ntr = size(IPD_Data(1)%Statein%qgrs,3)

if(Model%lsm == Model%lsm_noahmp) then
nsfcprop2d = 149
nsfcprop2d = 151
else
nsfcprop2d = 100
nsfcprop2d = 102
endif

allocate (temp2d(isc:iec,jsc:jec,nsfcprop2d+Model%ntot3d+Model%nctp))
Expand Down Expand Up @@ -321,8 +321,10 @@ subroutine FV3GFS_IPD_checksum (Model, IPD_Data, Atm_block)
temp2d(i,j,82) = IPD_Data(nb)%Radtend%sfcflw(ix)%upfx0
temp2d(i,j,83) = IPD_Data(nb)%Radtend%sfcflw(ix)%dnfxc
temp2d(i,j,84) = IPD_Data(nb)%Radtend%sfcflw(ix)%dnfx0
temp2d(i,j,85) = IPD_Data(nb)%Sfcprop%tiice(ix,1)
temp2d(i,j,86) = IPD_Data(nb)%Sfcprop%tiice(ix,2)

idx_opt = 85
idx_opt = 87
if (Model%lsm == Model%lsm_noahmp) then
temp2d(i,j,idx_opt) = IPD_Data(nb)%Sfcprop%snowxy(ix)
temp2d(i,j,idx_opt+1) = IPD_Data(nb)%Sfcprop%tvxy(ix)
Expand Down Expand Up @@ -374,7 +376,7 @@ subroutine FV3GFS_IPD_checksum (Model, IPD_Data, Atm_block)
temp2d(i,j,idx_opt+46) = IPD_Data(nb)%Sfcprop%zsnsoxy(ix,2)
temp2d(i,j,idx_opt+47) = IPD_Data(nb)%Sfcprop%zsnsoxy(ix,3)
temp2d(i,j,idx_opt+48) = IPD_Data(nb)%Sfcprop%zsnsoxy(ix,4)
idx_opt = 134
idx_opt = 136
endif

if (Model%nstf_name(1) > 0) then
Expand Down Expand Up @@ -602,7 +604,6 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain)
call mpp_error(NOTE,'reading topographic/orographic information from INPUT/oro_data.tile*.nc')
call restore_state(Oro_restart)

Model%frac_grid = .false.
!--- copy data into GFS containers
do nb = 1, Atm_block%nblks
!--- 2D variables
Expand Down Expand Up @@ -635,17 +636,6 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain)
enddo
enddo

if (nint(oro_var2(1,1,18)) == -9999._kind_phys) then ! lakefrac doesn't exist in the restart, need to create it
if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - will computing lakefrac')
Model%frac_grid = .false.
elseif (Model%frac_grid_off) then
Model%frac_grid = .false.
else
Model%frac_grid = .true.
endif

if (Model%me == Model%master ) write(0,*)' resetting Model%frac_grid=',Model%frac_grid

!--- deallocate containers and free restart container
deallocate(oro_name2, oro_var2)
call free_restart_type(Oro_restart)
Expand All @@ -655,23 +645,24 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain)
!--- allocate the various containers needed for restarts
#ifdef CCPP
allocate(sfc_name2(nvar_s2m+nvar_s2o+nvar_s2mp+nvar_s2r))
allocate(sfc_name3(nvar_s3+nvar_s3mp))
allocate(sfc_name3(0:nvar_s3+nvar_s3mp))

allocate(sfc_var2(nx,ny,nvar_s2m+nvar_s2o+nvar_s2mp+nvar_s2r))
allocate(sfc_var2(nx,ny,nvar_s2m+nvar_s2o+nvar_s2mp+nvar_s2r),sfc_var3ice(nx,ny,Model%kice))
if (Model%lsm == Model%lsm_noah .or. Model%lsm == Model%lsm_noahmp .or. (.not.warm_start)) then
allocate(sfc_var3(nx,ny,Model%lsoil,nvar_s3))
else if (Model%lsm == Model%lsm_ruc) then
allocate(sfc_var3(nx,ny,Model%lsoil_lsm,nvar_s3))
end if
#else
allocate(sfc_name2(nvar_s2m+nvar_s2o+nvar_s2mp))
allocate(sfc_name3(nvar_s3+nvar_s3mp))
allocate(sfc_name3(0:nvar_s3+nvar_s3mp))

allocate(sfc_var2(nx,ny,nvar_s2m+nvar_s2o+nvar_s2mp))
allocate(sfc_var3(nx,ny,Model%lsoil,nvar_s3))
#endif
sfc_var2 = -9999._kind_phys
sfc_var3 = -9999._kind_phys
sfc_var3ice= -9999._kind_phys
!
if (Model%lsm == Model%lsm_noahmp) then
allocate(sfc_var3sn(nx,ny,-2:0,4:6))
Expand Down Expand Up @@ -717,8 +708,8 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain)
!--- variables below here are optional
sfc_name2(32) = 'sncovr'
if(Model%cplflx) then
sfc_name2(33) = 'tsfcl' !temp on land portion of a cell
sfc_name2(34) = 'zorll' !zorl on land portion of a cell
sfc_name2(33) = 'tsfcl' !temp on land portion of a cell
sfc_name2(34) = 'zorll' !zorl on land portion of a cell
end if

!--- NSSTM inputs only needed when (nstf_name(1) > 0) .and. (nstf_name(2)) == 0)
Expand Down Expand Up @@ -865,6 +856,12 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain)
endif
#endif
!--- register the 3D fields
if (Model%frac_grid) then
sfc_name3(0) = 'tiice'
var3_p => sfc_var3ice(:,:,:)
id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name3(0), var3_p, domain=fv_domain, mandatory=.false.)
end if

do num = 1,nvar_s3
var3_p => sfc_var3(:,:,:,num)
id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name3(num), var3_p, domain=fv_domain)
Expand Down Expand Up @@ -1087,6 +1084,10 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain)
Sfcprop(nb)%flag_frsoil(ix,lsoil) = sfc_var3(i,j,lsoil,5) !--- flag_frsoil
enddo
end if

do k = 1,Model%kice
Sfcprop(nb)%tiice(ix,k)= sfc_var3ice(i,j,k) !--- internal ice temp
enddo
#else
!--- 3D variables
do lsoil = 1,Model%lsoil
Expand Down Expand Up @@ -1155,7 +1156,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain)
enddo
endif

if(Model%cplflx .or. Model%frac_grid) then
if (Model%cplflx .or. Model%frac_grid) then
if (nint(sfc_var2(1,1,33)) == -9999) then
if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing tsfcl')
do nb = 1, Atm_block%nblks
Expand All @@ -1175,6 +1176,16 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain)
endif
endif

if (nint(sfc_var3ice(1,1,1)) == -9999) then
if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing tiice')
do nb = 1, Atm_block%nblks
do ix = 1, Atm_block%blksz(nb)
Sfcprop(nb)%tiice(ix,1) = Sfcprop(nb)%stc(ix,1) !--- initialize internal ice temp from soil temp at layer 1
Sfcprop(nb)%tiice(ix,2) = Sfcprop(nb)%stc(ix,2) !--- initialize internal ice temp from soil temp at layer 2
enddo
enddo
endif

!#endif

if(Model%frac_grid) then ! 3-way composite
Expand Down Expand Up @@ -1561,7 +1572,7 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta
!--- allocate the various containers needed for restarts
#ifdef CCPP
allocate(sfc_name2(nvar2m+nvar2o+nvar2mp+nvar2r))
allocate(sfc_name3(nvar3+nvar3mp))
allocate(sfc_name3(0:nvar3+nvar3mp))
allocate(sfc_var2(nx,ny,nvar2m+nvar2o+nvar2mp+nvar2r))
if (Model%lsm == Model%lsm_noah .or. Model%lsm == Model%lsm_noahmp) then
allocate(sfc_var3(nx,ny,Model%lsoil,nvar3))
Expand All @@ -1570,7 +1581,7 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta
endif
#else
allocate(sfc_name2(nvar2m+nvar2o+nvar2mp))
allocate(sfc_name3(nvar3+nvar3mp))
allocate(sfc_name3(0:nvar3+nvar3mp))
allocate(sfc_var2(nx,ny,nvar2m+nvar2o+nvar2mp))
allocate(sfc_var3(nx,ny,Model%lsoil,nvar3))
#endif
Expand Down Expand Up @@ -1762,6 +1773,12 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta
#endif

!--- register the 3D fields
if (Model%frac_grid) then
sfc_name3(0) = 'tiice'
var3_p => sfc_var3ice(:,:,:)
id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name3(0), var3_p, domain=fv_domain)
end if

do num = 1,nvar3
var3_p => sfc_var3(:,:,:,num)
id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name3(num), var3_p, domain=fv_domain)
Expand Down Expand Up @@ -1901,6 +1918,10 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta
endif

#ifdef CCPP
do k = 1,Model%kice
sfc_var3ice(i,j,k) = Sfcprop(nb)%tiice(ix,k) !--- internal ice temperature
end do

if (Model%lsm == Model%lsm_noah .or. Model%lsm == Model%lsm_noahmp) then
!--- 3D variables
do lsoil = 1,Model%lsoil
Expand Down

0 comments on commit 9868550

Please sign in to comment.