Skip to content

Commit

Permalink
Merge branch 'NOAA-EMC:develop' into develop
Browse files Browse the repository at this point in the history
  • Loading branch information
DeniseWorthen authored Mar 1, 2024
2 parents 67465da + 4941026 commit 4596682
Show file tree
Hide file tree
Showing 7 changed files with 318 additions and 95 deletions.
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

0 comments on commit 4596682

Please sign in to comment.