Skip to content

Commit

Permalink
changes for the SCM to work with ufs/dev PR#183 and GFS_Debug.F90 sch…
Browse files Browse the repository at this point in the history
…emes; allocate the Interstitial DDT as an array of size n_threads
  • Loading branch information
grantfirl committed Oct 17, 2024
1 parent b9b86f9 commit 114e7b3
Show file tree
Hide file tree
Showing 12 changed files with 945 additions and 870 deletions.
2 changes: 1 addition & 1 deletion .gitmodules
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,7 @@
[submodule "ccpp-physics"]
path = ccpp/physics
url = https://github.com/grantfirl/ccpp-physics
branch = ufs-dev-PR219
branch = ufs-dev-PR183
[submodule "CMakeModules"]
path = CMakeModules
url = https://github.com/noaa-emc/CMakeModules
Expand Down
3 changes: 2 additions & 1 deletion ccpp/config/ccpp_prebuild_config.py
Original file line number Diff line number Diff line change
Expand Up @@ -50,7 +50,7 @@
'ty_ozphys' : '',
},
'CCPP_typedefs' : {
'GFS_interstitial_type' : 'physics%Interstitial',
'GFS_interstitial_type' : 'physics%Interstitial(cdata%thrd_no)',
'CCPP_typedefs' : '',
},
'GFS_typedefs' : {
Expand Down Expand Up @@ -94,6 +94,7 @@
'ccpp/physics/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_post.F90' ,
'ccpp/physics/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_pre.F90' ,
'ccpp/physics/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_post.F90' ,
'ccpp/physics/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_debug.F90' ,
'ccpp/physics/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.F90' ,
'ccpp/physics/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.scm.F90' ,
'ccpp/physics/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_surface.F90' ,
Expand Down
143 changes: 84 additions & 59 deletions scm/src/GFS_typedefs.F90
Original file line number Diff line number Diff line change
Expand Up @@ -742,7 +742,11 @@ module GFS_typedefs
integer :: nblks !< for explicit data blocking: number of blocks
integer, pointer :: blksz(:) !< for explicit data blocking: block sizes of all blocks
integer :: ncols !< total number of columns for all blocks

!
integer :: nchunks !< number of chunks of an array that are used in the CCPP run phase
integer, pointer :: chunk_begin(:) !< first indices of chunks of an array for the CCPP run phase
integer, pointer :: chunk_end(:) !< last indices of chunks of an array for the CCPP run phase
!
integer :: fire_aux_data_levels !< vertical levels of fire auxiliary data

!--- coupling parameters
Expand Down Expand Up @@ -1652,50 +1656,50 @@ module GFS_typedefs
!!
type GFS_grid_type

real (kind=kind_phys), pointer :: xlon (:) => null() !< grid longitude in radians, ok for both 0->2pi
!! or -pi -> +pi ranges
real (kind=kind_phys), pointer :: xlat (:) => null() !< grid latitude in radians, default to pi/2 ->
!! -pi/2 range, otherwise adj in subr called
real (kind=kind_phys), pointer :: xlat_d (:) => null() !< grid latitude in degrees, default to 90 ->
!! -90 range, otherwise adj in subr called
real (kind=kind_phys), pointer :: xlon_d (:) => null() !< grid longitude in degrees, default to 0 ->
!! 360 range, otherwise adj in subr called
real (kind=kind_phys), pointer :: sinlat (:) => null() !< sine of the grids corresponding latitudes
real (kind=kind_phys), pointer :: coslat (:) => null() !< cosine of the grids corresponding latitudes
real (kind=kind_phys), pointer :: area (:) => null() !< area of the grid cell
real (kind=kind_phys), pointer :: dx (:) => null() !< relative dx for the grid cell
real (kind=kind_phys), pointer :: xlon (:) !< grid longitude in radians, ok for both 0->2pi
!! or -pi -> +pi ranges
real (kind=kind_phys), pointer :: xlat (:) !< grid latitude in radians, default to pi/2 ->
!! -pi/2 range, otherwise adj in subr called
real (kind=kind_phys), pointer :: xlat_d (:) !< grid latitude in degrees, default to 90 ->
!! -90 range, otherwise adj in subr called
real (kind=kind_phys), pointer :: xlon_d (:) !< grid longitude in degrees, default to 0 ->
!! 360 range, otherwise adj in subr called
real (kind=kind_phys), pointer :: sinlat (:) !< sine of the grids corresponding latitudes
real (kind=kind_phys), pointer :: coslat (:) !< cosine of the grids corresponding latitudes
real (kind=kind_phys), pointer :: area (:) !< area of the grid cell
real (kind=kind_phys), pointer :: dx (:) !< relative dx for the grid cell

!--- grid-related interpolation data for prognostic ozone
real (kind=kind_phys), pointer :: ddy_o3 (:) => null() !< interpolation weight for ozone
integer, pointer :: jindx1_o3 (:) => null() !< interpolation low index for ozone
integer, pointer :: jindx2_o3 (:) => null() !< interpolation high index for ozone
real (kind=kind_phys), pointer :: ddy_o3 (:) !< interpolation weight for ozone
integer, pointer :: jindx1_o3 (:) !< interpolation low index for ozone
integer, pointer :: jindx2_o3 (:) !< interpolation high index for ozone

!--- grid-related interpolation data for stratosphere water
real (kind=kind_phys), pointer :: ddy_h (:) => null() !< interpolation weight for h2o
integer, pointer :: jindx1_h (:) => null() !< interpolation low index for h2o
integer, pointer :: jindx2_h (:) => null() !< interpolation high index for h2o
real (kind=kind_phys), pointer :: ddy_h (:) !< interpolation weight for h2o
integer, pointer :: jindx1_h (:) !< interpolation low index for h2o
integer, pointer :: jindx2_h (:) !< interpolation high index for h2o

!--- grid-related interpolation data for prognostic iccn
real (kind=kind_phys), pointer :: ddy_ci (:) => null() !< interpolation weight for iccn
integer, pointer :: jindx1_ci (:) => null() !< interpolation low index for iccn
integer, pointer :: jindx2_ci (:) => null() !< interpolation high index for iccn
real (kind=kind_phys), pointer :: ddx_ci (:) => null() !< interpolation weight for iccn
integer, pointer :: iindx1_ci (:) => null() !< interpolation low index for iccn
integer, pointer :: iindx2_ci (:) => null() !< interpolation high index for iccn
real (kind=kind_phys), pointer :: ddy_ci (:) !< interpolation weight for iccn
integer, pointer :: jindx1_ci (:) !< interpolation low index for iccn
integer, pointer :: jindx2_ci (:) !< interpolation high index for iccn
real (kind=kind_phys), pointer :: ddx_ci (:) !< interpolation weight for iccn
integer, pointer :: iindx1_ci (:) !< interpolation low index for iccn
integer, pointer :: iindx2_ci (:) !< interpolation high index for iccn

!--- grid-related interpolation data for prescribed aerosols
real (kind=kind_phys), pointer :: ddy_aer (:) => null() !< interpolation weight for iaerclm
integer, pointer :: jindx1_aer (:) => null() !< interpolation low index for iaerclm
integer, pointer :: jindx2_aer (:) => null() !< interpolation high index for iaerclm
real (kind=kind_phys), pointer :: ddx_aer (:) => null() !< interpolation weight for iaerclm
integer, pointer :: iindx1_aer (:) => null() !< interpolation low index for iaerclm
integer, pointer :: iindx2_aer (:) => null() !< interpolation high index for iaerclm
real (kind=kind_phys), pointer :: ddy_aer (:) !< interpolation weight for iaerclm
integer, pointer :: jindx1_aer (:) !< interpolation low index for iaerclm
integer, pointer :: jindx2_aer (:) !< interpolation high index for iaerclm
real (kind=kind_phys), pointer :: ddx_aer (:) !< interpolation weight for iaerclm
integer, pointer :: iindx1_aer (:) !< interpolation low index for iaerclm
integer, pointer :: iindx2_aer (:) !< interpolation high index for iaerclm

!--- grid-related interpolation data for cires_ugwp_v1
real (kind=kind_phys), pointer :: ddy_j1tau (:) => null() !< interpolation weight for tau_ugwp
real (kind=kind_phys), pointer :: ddy_j2tau (:) => null() !< interpolation weight for tau_ugwp
integer, pointer :: jindx1_tau (:) => null() !< interpolation low index for tau_ugwp
integer, pointer :: jindx2_tau (:) => null() !< interpolation high index for tau_ugwp
real (kind=kind_phys), pointer :: ddy_j1tau (:) !< interpolation weight for tau_ugwp
real (kind=kind_phys), pointer :: ddy_j2tau (:) !< interpolation weight for tau_ugwp
integer, pointer :: jindx1_tau (:) !< interpolation low index for tau_ugwp
integer, pointer :: jindx2_tau (:) !< interpolation high index for tau_ugwp

contains
procedure :: create => grid_create !< allocate array data
Expand Down Expand Up @@ -2195,12 +2199,14 @@ module GFS_typedefs
!------------------------
! GFS_statein_type%create
!------------------------
subroutine statein_create (Statein, IM, Model)
subroutine statein_create (Statein, Model)
implicit none

class(GFS_statein_type) :: Statein
integer, intent(in) :: IM
type(GFS_control_type), intent(in) :: Model
integer :: IM

IM = Model%ncols

!--- level geopotential and pressures
allocate (Statein%phii (IM,Model%levs+1))
Expand Down Expand Up @@ -2262,13 +2268,15 @@ end subroutine statein_create
!-------------------------
! GFS_stateout_type%create
!-------------------------
subroutine stateout_create (Stateout, IM, Model)
subroutine stateout_create (Stateout, Model)

implicit none

class(GFS_stateout_type) :: Stateout
integer, intent(in) :: IM
type(GFS_control_type), intent(in) :: Model
integer :: IM

IM = Model%ncols

allocate (Stateout%gu0 (IM,Model%levs))
allocate (Stateout%gv0 (IM,Model%levs))
Expand All @@ -2286,13 +2294,15 @@ end subroutine stateout_create
!------------------------
! GFS_sfcprop_type%create
!------------------------
subroutine sfcprop_create (Sfcprop, IM, Model)
subroutine sfcprop_create (Sfcprop, Model)

implicit none

class(GFS_sfcprop_type) :: Sfcprop
integer, intent(in) :: IM
type(GFS_control_type), intent(in) :: Model
integer :: IM

IM = Model%ncols

!--- physics and radiation
allocate (Sfcprop%slmsk (IM))
Expand Down Expand Up @@ -2861,13 +2871,15 @@ end subroutine sfcprop_create
!-------------------------
! GFS_coupling_type%create
!-------------------------
subroutine coupling_create (Coupling, IM, Model)
subroutine coupling_create (Coupling, Model)

implicit none

class(GFS_coupling_type) :: Coupling
integer, intent(in) :: IM
type(GFS_control_type), intent(in) :: Model
integer :: IM

IM = Model%ncols

!--- radiation out
!--- physics in
Expand Down Expand Up @@ -4387,7 +4399,17 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, &
allocate(Model%blksz(1:Model%nblks))
Model%blksz = blksz
Model%ncols = sum(Model%blksz)

! DH*
Model%nchunks = size(blksz)
allocate(Model%chunk_begin(Model%nchunks))
allocate(Model%chunk_end(Model%nchunks))
Model%chunk_begin(1) = 1
Model%chunk_end(1) = Model%chunk_begin(1) + blksz(1) - 1
do i=2,Model%nchunks
Model%chunk_begin(i) = Model%chunk_end(i-1) + 1
Model%chunk_end(i) = Model%chunk_begin(i) + blksz(i) - 1
end do

!--- coupling parameters
Model%cplflx = cplflx
Model%cplice = cplice
Expand Down Expand Up @@ -7074,14 +7096,15 @@ end subroutine control_print
!----------------
! GFS_grid%create
!----------------
subroutine grid_create (Grid, IM, Model)
subroutine grid_create (Grid, Model)

implicit none

class(GFS_grid_type) :: Grid
integer, intent(in) :: IM
type(GFS_control_type), intent(in) :: Model
integer :: IM

IM = Model%ncols
allocate (Grid%xlon (IM))
allocate (Grid%xlat (IM))
allocate (Grid%xlat_d (IM))
Expand Down Expand Up @@ -7175,14 +7198,15 @@ end subroutine grid_create
!--------------------
! GFS_tbd_type%create
!--------------------
subroutine tbd_create (Tbd, IM, Model)
subroutine tbd_create (Tbd, Model)

implicit none

class(GFS_tbd_type) :: Tbd
integer, intent(in) :: IM
type(GFS_control_type), intent(in) :: Model
integer :: IM

IM = Model%ncols
!--- In
!--- sub-grid cloud radiation
if ( Model%isubc_lw == 2 .or. Model%isubc_sw == 2 ) then
Expand Down Expand Up @@ -7216,19 +7240,16 @@ subroutine tbd_create (Tbd, IM, Model)
Tbd%ozpl = clear_val

!--- ccn and in needs
! DH* allocate only for MG? *DH
allocate (Tbd%in_nm (IM,Model%levs))
allocate (Tbd%ccn_nm (IM,Model%levs))
Tbd%in_nm = clear_val
Tbd%ccn_nm = clear_val

!--- aerosol fields
! DH* allocate only for MG? *DH
allocate (Tbd%aer_nm (IM,Model%levs,ntrcaer))
Tbd%aer_nm = clear_val

!--- tau_amf for NGWs
! DH* allocate only for UGWP ? *DH
allocate (Tbd%tau_amf(im) )
Tbd%tau_amf = clear_val

Expand Down Expand Up @@ -7372,13 +7393,15 @@ end subroutine tbd_create
!------------------------
! GFS_cldprop_type%create
!------------------------
subroutine cldprop_create (Cldprop, IM, Model)
subroutine cldprop_create (Cldprop, Model)

implicit none

class(GFS_cldprop_type) :: Cldprop
integer, intent(in) :: IM
type(GFS_control_type), intent(in) :: Model
integer :: IM

IM = Model%ncols

allocate (Cldprop%cv (IM))
allocate (Cldprop%cvt (IM))
Expand All @@ -7394,13 +7417,15 @@ end subroutine cldprop_create
!******************************************
! GFS_radtend_type%create
!******************************************
subroutine radtend_create (Radtend, IM, Model)
subroutine radtend_create (Radtend, Model)

implicit none

class(GFS_radtend_type) :: Radtend
integer, intent(in) :: IM
type(GFS_control_type), intent(in) :: Model
integer :: IM

IM = Model%ncols

!--- Out (radiation only)
allocate (Radtend%sfcfsw (IM))
Expand Down Expand Up @@ -7672,16 +7697,16 @@ end subroutine label_dtend_cause
!----------------
! GFS_diag%create
!----------------
subroutine diag_create (Diag, IM, Model)
subroutine diag_create (Diag, Model)
use parse_tracers, only: get_tracer_index
class(GFS_diag_type) :: Diag
integer, intent(in) :: IM
type(GFS_control_type), intent(in) :: Model

!
integer :: IM
logical, save :: linit
logical :: have_pbl, have_dcnv, have_scnv, have_mp, have_oz_phys

IM = Model%ncols

if(Model%print_diff_pgr) then
allocate(Diag%old_pgr(IM))
Diag%old_pgr = clear_val
Expand Down
Loading

0 comments on commit 114e7b3

Please sign in to comment.