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 ---
@@ -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
@@ -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)
@@ -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)
!---------------------------------------------------------------------------------------------!
@@ -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
@@ -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)
@@ -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)
@@ -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)
@@ -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
@@ -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'
@@ -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'
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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:
@@ -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'
@@ -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
@@ -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'
@@ -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'
@@ -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'
@@ -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'
@@ -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'
@@ -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
@@ -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)
@@ -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))
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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