Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Combining PRs #97 & 107: initialize ice fluxes and add "tiice" array #119

Merged
merged 6 commits into from
May 27, 2020
Merged
Show file tree
Hide file tree
Changes from 1 commit
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
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)
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Use uppercase Sfcprop, please.

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Thanks!

enddo
enddo
end if

idx = idx + 1
ExtDiag(idx)%axes = 2
ExtDiag(idx)%name = 'tg3'
Expand Down
17 changes: 12 additions & 5 deletions gfsphysics/GFS_layer/GFS_physics_driver.F90
Original file line number Diff line number Diff line change
Expand Up @@ -2855,11 +2855,18 @@ subroutine GFS_physics_driver &
if (Model%cplflx) then
do i=1,im
if (Sfcprop%oceanfrac(i) > zero) then ! Ocean only, NO LAKES
if (Sfcprop%fice(i) > one - epsln) then ! no open water, thus use results from CICE
Coupling%dusfci_cpl(i) = Coupling%dusfcin_cpl(i)
Coupling%dvsfci_cpl(i) = Coupling%dvsfcin_cpl(i)
Coupling%dtsfci_cpl(i) = Coupling%dtsfcin_cpl(i)
Coupling%dqsfci_cpl(i) = Coupling%dqsfcin_cpl(i)
if ( .not. wet(i)) then ! no open water
if (flag_cice(i)) then !use results from CICE
Coupling%dusfci_cpl(i) = Coupling%dusfcin_cpl(i)
Coupling%dvsfci_cpl(i) = Coupling%dvsfcin_cpl(i)
Coupling%dtsfci_cpl(i) = Coupling%dtsfcin_cpl(i)
Coupling%dqsfci_cpl(i) = Coupling%dqsfcin_cpl(i)
else ! use PBL fluxes when CICE fluxes is unavailable
Coupling%dusfci_cpl(i) = dusfc1(i)
Coupling%dvsfci_cpl(i) = dvsfc1(i)
Coupling%dtsfci_cpl(i) = dtsfc1(i)
Coupling%dqsfci_cpl(i) = dqsfc1(i)
end if
elseif (icy(i) .or. dry(i)) then ! use stress_ocean from sfc_diff for opw component at mixed point
tem1 = max(Diag%q1(i), 1.e-8)
rho = Statein%prsl(i,1) / (con_rd*Diag%t1(i)*(one+con_fvirt*tem1))
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