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

UFS-dev PR#173 #126

Merged
merged 9 commits into from
Mar 29, 2024
140 changes: 100 additions & 40 deletions ccpp/driver/GFS_diagnostics.F90
Original file line number Diff line number Diff line change
@@ -1,11 +1,11 @@
module GFS_diagnostics

!-----------------------------------------------------------------------
! GFS_diagnostics_mod defines a data type and contains the routine
! GFS_diagnostics_mod defines a data type and contains the routine
! to populate said type with diagnostics from the GFS physics for
! use by the modeling system for output
!-----------------------------------------------------------------------

use machine, only: kind_phys

!--- GFS_typedefs ---
Expand Down Expand Up @@ -51,7 +51,7 @@ module GFS_diagnostics
CONTAINS

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

! Helper function for GFS_externaldiag_populate to handle the massive dtend(:,:,dtidx(:,:)) array
subroutine add_dtend(Model,ExtDiag,IntDiag,idx,nblks,itrac,iprocess,desc,unit)
implicit none
Expand All @@ -62,7 +62,7 @@ subroutine add_dtend(Model,ExtDiag,IntDiag,idx,nblks,itrac,iprocess,desc,unit)
integer, intent(inout) :: idx
real(kind=kind_phys), pointer :: dtend(:,:,:) ! Assumption: dtend is null iff all(dtidx <= 1)
character(len=*), intent(in), optional :: desc, unit

integer :: idtend, nb

idtend = Model%dtidx(itrac,iprocess)
Expand All @@ -88,17 +88,17 @@ subroutine add_dtend(Model,ExtDiag,IntDiag,idx,nblks,itrac,iprocess,desc,unit)
enddo
endif
end subroutine add_dtend
!-------------------------------------------------------------------------

!-------------------------------------------------------------------------
!--- GFS_externaldiag_populate ---
!-------------------------------------------------------------------------
! creates and populates a data type with GFS physics diagnostic
!-------------------------------------------------------------------------
! creates and populates a data type with GFS physics diagnostic
! variables which is then handed off to the IPD for use by the model
! infrastructure layer to output as needed. The data type includes
! names, units, conversion factors, etc. There is no copying of data,
! but instead pointers are associated to the internal representation
! infrastructure layer to output as needed. The data type includes
! names, units, conversion factors, etc. There is no copying of data,
! but instead pointers are associated to the internal representation
! of each individual physics diagnostic.
!-------------------------------------------------------------------------
!-------------------------------------------------------------------------
subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop, Coupling, &
Grid, Tbd, Cldprop, Radtend, IntDiag, Init_parm)
!---------------------------------------------------------------------------------------------!
Expand Down Expand Up @@ -158,7 +158,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop
ExtDiag(:)%name = ''
ExtDiag(:)%intpl_method = 'nearest_stod'

idx = 0
idx = 0

idx = idx + 1
ExtDiag(idx)%axes = 2
Expand Down Expand Up @@ -949,7 +949,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop
!
!--- accumulated diagnostics ---
do num = 1,NFXR
write (xtra,'(I2.2)') num
write (xtra,'(I2.2)') num
idx = idx + 1
ExtDiag(idx)%axes = 2
ExtDiag(idx)%name = 'fluxr_'//trim(xtra)
Expand All @@ -965,7 +965,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop
!--- the next two appear to be appear to be coupling fields in gloopr
!--- each has four elements
!rab do num = 1,4
!rab write (xtra,'(I1)') num
!rab write (xtra,'(I1)') num
!rab idx = idx + 1
!rab ExtDiag(idx)%axes = 2
!rab ExtDiag(idx)%name = 'dswcmp_'//trim(xtra)
Expand All @@ -978,7 +978,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop
!rab enddo
!rab
!rab do num = 1,4
!rab write (xtra,'(I1)') num
!rab write (xtra,'(I1)') num
!rab idx = idx + 1
!rab ExtDiag(idx)%axes = 2
!rab ExtDiag(idx)%name = 'uswcmp_'//trim(xtra)
Expand Down Expand Up @@ -1103,7 +1103,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop
do nb = 1,nblks
ExtDiag(idx)%data(nb)%var2 => IntDiag(nb)%snohfa(:)
enddo

if (Model%lsm == Model%lsm_noahmp) then
idx = idx + 1
ExtDiag(idx)%axes = 2
Expand Down Expand Up @@ -1383,7 +1383,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop
ExtDiag(idx)%data(nb)%var2 => IntDiag(nb)%tedir(:)
enddo

if (Model%lsm == Model%lsm_noahmp) then
if (Model%lsm == Model%lsm_noahmp) then
idx = idx + 1
ExtDiag(idx)%axes = 2
ExtDiag(idx)%name = 'wa_acc'
Expand Down Expand Up @@ -2197,7 +2197,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop
ExtDiag(idx)%data(nb)%var2 => IntDiag(nb)%smcref2(:)
enddo

if (Model%lsm == Model%lsm_noahmp) then
if (Model%lsm == Model%lsm_noahmp) then
idx = idx + 1
ExtDiag(idx)%axes = 2
ExtDiag(idx)%name = 'pahi'
Expand Down Expand Up @@ -2468,7 +2468,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop
ExtDiag(idx)%data(nb)%var3 => Coupling(nb)%spp_wts_pbl(:,:)
enddo
endif

if (Model%do_spp) then
idx = idx + 1
ExtDiag(idx)%axes = 3
Expand All @@ -2481,7 +2481,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop
ExtDiag(idx)%data(nb)%var3 => Coupling(nb)%spp_wts_sfc(:,:)
enddo
endif

if (Model%do_spp) then
idx = idx + 1
ExtDiag(idx)%axes = 3
Expand All @@ -2494,7 +2494,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop
ExtDiag(idx)%data(nb)%var3 => Coupling(nb)%spp_wts_mp(:,:)
enddo
endif

if (Model%do_spp) then
idx = idx + 1
ExtDiag(idx)%axes = 3
Expand All @@ -2507,7 +2507,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop
ExtDiag(idx)%data(nb)%var3 => Coupling(nb)%spp_wts_gwd(:,:)
enddo
endif

if (Model%do_spp) then
idx = idx + 1
ExtDiag(idx)%axes = 3
Expand Down Expand Up @@ -2677,7 +2677,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop
do nb = 1,nblks
ExtDiag(idx)%data(nb)%int2 => Sfcprop(nb)%use_lake_model(:)
enddo

if(Model%iopt_lake==Model%iopt_lake_clm) then

! Populate the 3D arrays separately since the code is complicated:
Expand All @@ -2704,7 +2704,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop
do nb = 1,nblks
ExtDiag(idx)%data(nb)%int2 => Sfcprop(nb)%lake_cannot_freeze(:)
enddo

idx = idx + 1
ExtDiag(idx)%axes = 2
ExtDiag(idx)%name = 'lake_t2m'
Expand Down Expand Up @@ -2812,7 +2812,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop
do nb = 1,nblks
ExtDiag(idx)%data(nb)%var2 => Sfcprop(nb)%lake_ht(:)
enddo

endif

endif
Expand Down Expand Up @@ -2909,8 +2909,8 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop
do nb = 1,nblks
ExtDiag(idx)%data(nb)%var3 => IntDiag(nb)%du3dt_pbl(:,:)
enddo
!
! dv3dt_pbl
!
! dv3dt_pbl
idx = idx + 1
ExtDiag(idx)%axes = 3
ExtDiag(idx)%name = 'dv3dt_pbl_ugwp'
Expand All @@ -2921,8 +2921,8 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop
do nb = 1,nblks
ExtDiag(idx)%data(nb)%var3 => IntDiag(nb)%dv3dt_pbl(:,:)
enddo
!
! dt3dt_pbl
!
! dt3dt_pbl
idx = idx + 1
ExtDiag(idx)%axes = 3
ExtDiag(idx)%name = 'dt3dt_pbl_ugwp'
Expand All @@ -2934,8 +2934,8 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop
ExtDiag(idx)%data(nb)%var3 => IntDiag(nb)%dt3dt_pbl(:,:)
enddo
!
! uav_ugwp
!
! uav_ugwp
!
idx = idx + 1
ExtDiag(idx)%axes = 3
ExtDiag(idx)%name = 'uav_ugwp'
Expand All @@ -2947,8 +2947,8 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop
ExtDiag(idx)%data(nb)%var3 => IntDiag(nb)%uav_ugwp(:,:)
enddo
!
! tav_ugwp
!
! tav_ugwp
!
idx = idx + 1
ExtDiag(idx)%axes = 3
ExtDiag(idx)%name = 'tav_ugwp'
Expand Down Expand Up @@ -2982,7 +2982,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop
ExtDiag(idx)%data(nb)%var3 => IntDiag(nb)%du3dt_ngw(:,:)
enddo
!
!
!
idx = idx + 1
ExtDiag(idx)%axes = 3
ExtDiag(idx)%name = 'du3dt_mtb'
Expand Down Expand Up @@ -3454,7 +3454,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop
endif
enddo
enddo

if_qdiag3d: if(Model%qdiag3d) then

idx = idx + 1
Expand Down Expand Up @@ -3499,7 +3499,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop

!rab
!rab do num = 1,5+Mdl_parms%pl_coeff
!rab write (xtra,'(I1)') num
!rab write (xtra,'(I1)') num
!rab idx = idx + 1
!rab ExtDiag(idx)%axes = 3
!rab ExtDiag(idx)%name = 'dtend_'//trim(xtra)
Expand Down Expand Up @@ -3877,7 +3877,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop
idx = idx + 1
ExtDiag(idx)%axes = 2
ExtDiag(idx)%name = 'scolor'
ExtDiag(idx)%desc = 'soil color in integer 1-20'
ExtDiag(idx)%desc = 'soil color in integer 1-20'
ExtDiag(idx)%unit = 'number'
ExtDiag(idx)%mod_name = 'gfs_sfc'
allocate (ExtDiag(idx)%data(nblks))
Expand Down Expand Up @@ -4203,6 +4203,16 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop
ExtDiag(idx)%data(nb)%var2 => sfcprop(nb)%sh2o(:,num)
enddo
enddo
idx = idx + 1
ExtDiag(idx)%axes = 3
ExtDiag(idx)%name = 'soill'
ExtDiag(idx)%desc = 'liquid soil moisture'
ExtDiag(idx)%unit = 'm**3/m**3'
ExtDiag(idx)%mod_name = 'gfs_sfc'
allocate (ExtDiag(idx)%data(nblks))
do nb = 1,nblks
ExtDiag(idx)%data(nb)%var3 => sfcprop(nb)%sh2o(:,:)
enddo
else
do num = 1,Model%lsoil_lsm
write (xtra,'(i1)') num
Expand All @@ -4225,6 +4235,16 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop
ExtDiag(idx)%data(nb)%var2 => sfcprop(nb)%slc(:,num)
enddo
enddo
idx = idx + 1
ExtDiag(idx)%axes = 3
ExtDiag(idx)%name = 'soill'
ExtDiag(idx)%desc = 'liquid soil moisture'
ExtDiag(idx)%unit = 'm**3/m**3'
ExtDiag(idx)%mod_name = 'gfs_sfc'
allocate (ExtDiag(idx)%data(nblks))
do nb = 1,nblks
ExtDiag(idx)%data(nb)%var3 => sfcprop(nb)%slc(:,:)
enddo
endif

if (Model%lsm == Model%lsm_ruc) then
Expand All @@ -4241,6 +4261,16 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop
ExtDiag(idx)%data(nb)%var2 => sfcprop(nb)%smois(:,num)
enddo
enddo
idx = idx + 1
ExtDiag(idx)%axes = 3
ExtDiag(idx)%name = 'soilw'
ExtDiag(idx)%desc = 'volumetric soil moisture'
ExtDiag(idx)%unit = 'fraction'
ExtDiag(idx)%mod_name = 'gfs_sfc'
allocate (ExtDiag(idx)%data(nblks))
do nb = 1,nblks
ExtDiag(idx)%data(nb)%var3 => sfcprop(nb)%smois(:,:)
enddo
else
do num = 1,Model%lsoil_lsm
write (xtra,'(i1)') num
Expand All @@ -4255,6 +4285,16 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop
ExtDiag(idx)%data(nb)%var2 => sfcprop(nb)%smc(:,num)
enddo
enddo
idx = idx + 1
ExtDiag(idx)%axes = 3
ExtDiag(idx)%name = 'soilw'
ExtDiag(idx)%desc = 'volumetric soil moisture'
ExtDiag(idx)%unit = 'fraction'
ExtDiag(idx)%mod_name = 'gfs_sfc'
allocate (ExtDiag(idx)%data(nblks))
do nb = 1,nblks
ExtDiag(idx)%data(nb)%var3 => sfcprop(nb)%smc(:,:)
enddo
endif

if (Model%lsm == Model%lsm_ruc) then
Expand All @@ -4271,6 +4311,16 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop
ExtDiag(idx)%data(nb)%var2 => sfcprop(nb)%tslb(:,num)
enddo
enddo
idx = idx + 1
ExtDiag(idx)%axes = 3
ExtDiag(idx)%name = 'soilt'
ExtDiag(idx)%desc = 'soil temperature'
ExtDiag(idx)%unit = 'K'
ExtDiag(idx)%mod_name = 'gfs_sfc'
allocate (ExtDiag(idx)%data(nblks))
do nb = 1,nblks
ExtDiag(idx)%data(nb)%var3 => sfcprop(nb)%tslb(:,:)
enddo
else
do num = 1,Model%lsoil_lsm
write (xtra,'(i1)') num
Expand All @@ -4285,6 +4335,16 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop
ExtDiag(idx)%data(nb)%var2 => sfcprop(nb)%stc(:,num)
enddo
enddo
idx = idx + 1
ExtDiag(idx)%axes = 3
ExtDiag(idx)%name = 'soilt'
ExtDiag(idx)%desc = 'soil temperature'
ExtDiag(idx)%unit = 'K'
ExtDiag(idx)%mod_name = 'gfs_sfc'
allocate (ExtDiag(idx)%data(nblks))
do nb = 1,nblks
ExtDiag(idx)%data(nb)%var3 => sfcprop(nb)%stc(:,:)
enddo
endif

!--------------------------nsst variables
Expand Down Expand Up @@ -5396,7 +5456,7 @@ subroutine clm_lake_externaldiag_populate(ExtDiag, Model, Sfcprop, idx, cn_one,
character(:), allocatable :: fullname

integer :: nk, idx0, iblk

do iblk=1,nblks
call link_all_levels(Sfcprop(iblk)%lake_snow_z3d, 'lake_snow_z3d', 'lake snow level depth', 'm')
enddo
Expand Down Expand Up @@ -5524,6 +5584,6 @@ function soil_layer_depth(lsm, lsm_ruc, lsm_noah, layer) result(layer_depth)
!
end function soil_layer_depth

!-------------------------------------------------------------------------
!-------------------------------------------------------------------------

end module GFS_diagnostics
Loading