Skip to content

Commit

Permalink
Merge pull request NCAR#611 from climbfuji/capgen_fixes_assumed_sizes
Browse files Browse the repository at this point in the history 
Wrapper PR for assumed sizes, Fortran/metadata consistency fixes, bugfix Thompson MP, etc.
  • Loading branch information
@climbfuji
climbfuji authored Apr 30, 2021
2 parents 5015be4 + ffe0057 commit 6237270
Show file tree
Hide file tree
Showing 126 changed files with 2,747 additions and 2,646 deletions.
28 changes: 14 additions & 14 deletions physics/GFS_DCNV_generic.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -26,14 +26,14 @@ subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, qdiag3d, do_cnvgwd, cplc

integer, intent(in) :: im, levs
logical, intent(in) :: ldiag3d, qdiag3d, do_cnvgwd, cplchm
real(kind=kind_phys), dimension(im,levs), intent(in) :: gu0
real(kind=kind_phys), dimension(im,levs), intent(in) :: gv0
real(kind=kind_phys), dimension(im,levs), intent(in) :: gt0
real(kind=kind_phys), dimension(im,levs), intent(inout) :: gq0_water_vapor
real(kind=kind_phys), dimension(im,levs), intent(inout) :: save_u
real(kind=kind_phys), dimension(im,levs), intent(inout) :: save_v
real(kind=kind_phys), dimension(im,levs), intent(inout) :: save_t
real(kind=kind_phys), dimension(im,levs), intent(inout) :: save_qv
real(kind=kind_phys), dimension(:,:), intent(in) :: gu0
real(kind=kind_phys), dimension(:,:), intent(in) :: gv0
real(kind=kind_phys), dimension(:,:), intent(in) :: gt0
real(kind=kind_phys), dimension(:,:), intent(inout) :: gq0_water_vapor
real(kind=kind_phys), dimension(:,:), intent(inout) :: save_u
real(kind=kind_phys), dimension(:,:), intent(inout) :: save_v
real(kind=kind_phys), dimension(:,:), intent(inout) :: save_t
real(kind=kind_phys), dimension(:,:), intent(inout) :: save_qv
! dqdti only allocated if cplchm is .true.
real(kind=kind_phys), dimension(:,:), intent(inout) :: dqdti
character(len=*), intent(out) :: errmsg
Expand Down Expand Up @@ -107,18 +107,18 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, qdiag3d, ras, cs
logical, intent(in) :: flag_for_dcnv_generic_tend

real(kind=kind_phys), intent(in) :: frain, dtf
real(kind=kind_phys), dimension(im), intent(in) :: rain1, cld1d
real(kind=kind_phys), dimension(im,levs), intent(in) :: save_u, save_v, save_t, save_qv
real(kind=kind_phys), dimension(im,levs), intent(in) :: gu0, gv0, gt0, gq0_water_vapor
real(kind=kind_phys), dimension(im,levs), intent(in) :: ud_mf, dd_mf, dt_mf
real(kind=kind_phys), dimension(:), intent(in) :: rain1, cld1d
real(kind=kind_phys), dimension(:,:), intent(in) :: save_u, save_v, save_t, save_qv
real(kind=kind_phys), dimension(:,:), intent(in) :: gu0, gv0, gt0, gq0_water_vapor
real(kind=kind_phys), dimension(:,:), intent(in) :: ud_mf, dd_mf, dt_mf
real(kind=kind_phys), intent(in) :: con_g
integer, intent(in) :: npdf3d, num_p3d, ncnvcld3d

real(kind=kind_phys), dimension(im), intent(inout) :: rainc, cldwrk
real(kind=kind_phys), dimension(:), intent(inout) :: rainc, cldwrk
! dt3dt, dq3dt, du3dt, dv3dt upd_mf, dwn_mf, det_mf only allocated if ldiag3d == .true.
real(kind=kind_phys), dimension(:,:), intent(inout) :: dt3dt, dq3dt, du3dt, dv3dt
real(kind=kind_phys), dimension(:,:), intent(inout) :: upd_mf, dwn_mf, det_mf
real(kind=kind_phys), dimension(im,levs), intent(inout) :: cnvw, cnvc
real(kind=kind_phys), dimension(:,:), intent(inout) :: cnvw, cnvc
! The following arrays may not be allocated, depending on certain flags and microphysics schemes.
! Since Intel 15 crashes when passing unallocated arrays to arrays defined with explicit shape,
! use assumed-shape arrays. Note that Intel 18 and GNU 6.2.0-8.1.0 tolerate explicit-shape arrays
Expand Down
17 changes: 13 additions & 4 deletions physics/GFS_GWD_generic.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -6,6 +6,9 @@ module GFS_GWD_generic_pre

contains

!! \section arg_table_GFS_GWD_generic_pre_init Argument Table
!! \htmlinclude GFS_GWD_generic_pre_init.html
!!
subroutine GFS_GWD_generic_pre_init()
end subroutine GFS_GWD_generic_pre_init

Expand All @@ -27,15 +30,15 @@ subroutine GFS_GWD_generic_pre_run( &
implicit none

integer, intent(in) :: im, levs, nmtvr
real(kind=kind_phys), intent(in) :: mntvar(im,nmtvr)
real(kind=kind_phys), intent(in) :: mntvar(:,:)

real(kind=kind_phys), intent(out) :: &
& oc(im), oa4(im,4), clx(im,4), &
& oc(:), oa4(:,:), clx(:,:), &
& varss(:), ocss(:), oa4ss(:,:), clxss(:,:), &
& theta(im), sigma(im), gamma(im), elvmax(im)
& theta(:), sigma(:), gamma(:), elvmax(:)

logical, intent(in) :: lssav, ldiag3d, flag_for_gwd_generic_tend
real(kind=kind_phys), intent(in) :: dtdt(im,levs), dudt(im,levs), dvdt(im,levs)
real(kind=kind_phys), intent(in) :: dtdt(:,:), dudt(:,:), dvdt(:,:)
! dt3dt only allocated only if ldiag3d is .true.
real(kind=kind_phys), intent(inout) :: dt3dt(:,:), du3dt(:,:), dv3dt(:,:)
real(kind=kind_phys), intent(in) :: dtf
Expand Down Expand Up @@ -132,6 +135,9 @@ subroutine GFS_GWD_generic_pre_run( &
end subroutine GFS_GWD_generic_pre_run
!> @}

!! \section arg_table_GFS_GWD_generic_pre_finalize Argument Table
!! \htmlinclude GFS_GWD_generic_pre_finalize.html
!!
subroutine GFS_GWD_generic_pre_finalize()
end subroutine GFS_GWD_generic_pre_finalize

Expand Down Expand Up @@ -189,6 +195,9 @@ subroutine GFS_GWD_generic_post_run(lssav, ldiag3d, dtf, dusfcg, dvsfcg, dudt, d
end subroutine GFS_GWD_generic_post_run
!> @}

!! \section arg_table_GFS_GWD_generic_post_finalize Argument Table
!! \htmlinclude GFS_GWD_generic_post_finalize.html
!!
subroutine GFS_GWD_generic_post_finalize()
end subroutine GFS_GWD_generic_post_finalize

Expand Down
4 changes: 2 additions & 2 deletions physics/GFS_GWD_generic.meta
View file
Original file line number Diff line number Diff line change
Expand Up @@ -162,7 +162,7 @@
dimensions = (horizontal_loop_extent,vertical_dimension)
type = real
kind = kind_phys
intent = inout
intent = in
optional = F
[dvdt]
standard_name = tendency_of_y_wind_due_to_model_physics
Expand All @@ -171,7 +171,7 @@
dimensions = (horizontal_loop_extent,vertical_dimension)
type = real
kind = kind_phys
intent = inout
intent = in
optional = F
[dtdt]
standard_name = tendency_of_air_temperature_due_to_model_physics
Expand Down
71 changes: 36 additions & 35 deletions physics/GFS_MP_generic.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -12,18 +12,19 @@ end subroutine GFS_MP_generic_pre_init
!> \section arg_table_GFS_MP_generic_pre_run Argument Table
!! \htmlinclude GFS_MP_generic_pre_run.html
!!
subroutine GFS_MP_generic_pre_run(im, levs, ldiag3d, qdiag3d, do_aw, ntcw, nncl, ntrac, gt0, gq0, save_t, save_qv, save_q, errmsg, errflg)
subroutine GFS_MP_generic_pre_run(im, levs, ldiag3d, qdiag3d, do_aw, ntcw, nncl, &
ntrac, gt0, gq0, save_t, save_qv, save_q, errmsg, errflg)
!
use machine, only: kind_phys

implicit none
integer, intent(in) :: im, levs, ntcw, nncl, ntrac
logical, intent(in) :: ldiag3d, qdiag3d, do_aw
real(kind=kind_phys), dimension(im, levs), intent(in) :: gt0
real(kind=kind_phys), dimension(im, levs, ntrac), intent(in) :: gq0
integer, intent(in) :: im, levs, ntcw, nncl, ntrac
logical, intent(in) :: ldiag3d, qdiag3d, do_aw
real(kind=kind_phys), dimension(:,:), intent(in) :: gt0
real(kind=kind_phys), dimension(:,:,:), intent(in) :: gq0

real(kind=kind_phys), dimension(im, levs), intent(inout) :: save_t, save_qv
real(kind=kind_phys), dimension(im, levs, ntrac), intent(inout) :: save_q
real(kind=kind_phys), dimension(:,:), intent(inout) :: save_t, save_qv
real(kind=kind_phys), dimension(:,:,:), intent(inout) :: save_q

character(len=*), intent(out) :: errmsg
integer, intent(out) :: errflg
Expand Down Expand Up @@ -100,41 +101,41 @@ subroutine GFS_MP_generic_post_run(im, levs, kdt, nrcm, ncld, nncl, ntcw, ntrac,
integer, intent(in) :: imp_physics, imp_physics_gfdl, imp_physics_thompson, imp_physics_mg, imp_physics_fer_hires
logical, intent(in) :: cal_pre, lssav, ldiag3d, qdiag3d, cplflx, cplchm

real(kind=kind_phys), intent(in) :: dtf, frain, con_g
real(kind=kind_phys), dimension(im), intent(in) :: rain1, xlat, xlon, tsfc
real(kind=kind_phys), dimension(im), intent(inout) :: ice, snow, graupel, rainc
real(kind=kind_phys), dimension(:), intent(in) :: rain0, ice0, snow0, graupel0 ! conditionally allocated in GFS_typedefs (imp_physics == GFDL or Thompson)
real(kind=kind_phys), dimension(im,nrcm), intent(in) :: rann
real(kind=kind_phys), dimension(im,levs), intent(in) :: gt0, prsl, save_t, save_qv, del
real(kind=kind_phys), dimension(im,levs+1), intent(in) :: prsi, phii
real(kind=kind_phys), dimension(im,levs,ntrac), intent(in) :: gq0
real(kind=kind_phys), intent(in) :: dtf, frain, con_g
real(kind=kind_phys), dimension(:), intent(in) :: rain1, xlat, xlon, tsfc
real(kind=kind_phys), dimension(:), intent(inout) :: ice, snow, graupel, rainc
real(kind=kind_phys), dimension(:), intent(in) :: rain0, ice0, snow0, graupel0
real(kind=kind_phys), dimension(:,:), intent(in) :: rann
real(kind=kind_phys), dimension(:,:), intent(in) :: gt0, prsl, save_t, save_qv, del
real(kind=kind_phys), dimension(:,:), intent(in) :: prsi, phii
real(kind=kind_phys), dimension(:,:,:), intent(in) :: gq0

real(kind=kind_phys), dimension(im), intent(in ) :: sr
real(kind=kind_phys), dimension(im), intent(inout) :: rain, domr_diag, domzr_diag, domip_diag, doms_diag, tprcp, &
srflag, cnvprcp, totprcp, totice, totsnw, totgrp, cnvprcpb, &
totprcpb, toticeb, totsnwb, totgrpb, pwat
real(kind=kind_phys), dimension(:), intent(inout) :: rain_cpl, rainc_cpl, snow_cpl
real(kind=kind_phys), dimension(:), intent(in ) :: sr
real(kind=kind_phys), dimension(:), intent(inout) :: rain, domr_diag, domzr_diag, domip_diag, doms_diag, tprcp, &
srflag, cnvprcp, totprcp, totice, totsnw, totgrp, cnvprcpb, &
totprcpb, toticeb, totsnwb, totgrpb, pwat
real(kind=kind_phys), dimension(:), intent(inout) :: rain_cpl, rainc_cpl, snow_cpl

real(kind=kind_phys), dimension(:,:), intent(inout) :: dt3dt ! only if ldiag3d
real(kind=kind_phys), dimension(:,:), intent(inout) :: dq3dt ! only if ldiag3d and qdiag3d
real(kind=kind_phys), dimension(:,:), intent(inout) :: dt3dt ! only if ldiag3d
real(kind=kind_phys), dimension(:,:), intent(inout) :: dq3dt ! only if ldiag3d and qdiag3d

! Stochastic physics / surface perturbations
real(kind=kind_phys), dimension(:), intent(inout) :: drain_cpl, dsnow_cpl
real(kind=kind_phys), dimension(:), intent(inout) :: drain_cpl, dsnow_cpl

! Rainfall variables previous time step
integer, intent(in) :: lsm, lsm_ruc, lsm_noahmp
real(kind=kind_phys), dimension(:), intent(inout) :: raincprv
real(kind=kind_phys), dimension(:), intent(inout) :: rainncprv
real(kind=kind_phys), dimension(:), intent(inout) :: iceprv
real(kind=kind_phys), dimension(:), intent(inout) :: snowprv
real(kind=kind_phys), dimension(:), intent(inout) :: graupelprv
real(kind=kind_phys), dimension(:), intent(inout) :: draincprv
real(kind=kind_phys), dimension(:), intent(inout) :: drainncprv
real(kind=kind_phys), dimension(:), intent(inout) :: diceprv
real(kind=kind_phys), dimension(:), intent(inout) :: dsnowprv
real(kind=kind_phys), dimension(:), intent(inout) :: dgraupelprv

real(kind=kind_phys), intent(in) :: dtp
real(kind=kind_phys), dimension(:), intent(inout) :: raincprv
real(kind=kind_phys), dimension(:), intent(inout) :: rainncprv
real(kind=kind_phys), dimension(:), intent(inout) :: iceprv
real(kind=kind_phys), dimension(:), intent(inout) :: snowprv
real(kind=kind_phys), dimension(:), intent(inout) :: graupelprv
real(kind=kind_phys), dimension(:), intent(inout) :: draincprv
real(kind=kind_phys), dimension(:), intent(inout) :: drainncprv
real(kind=kind_phys), dimension(:), intent(inout) :: diceprv
real(kind=kind_phys), dimension(:), intent(inout) :: dsnowprv
real(kind=kind_phys), dimension(:), intent(inout) :: dgraupelprv

real(kind=kind_phys), intent(in) :: dtp

! CCPP error handling
character(len=*), intent(out) :: errmsg
Expand Down
4 changes: 2 additions & 2 deletions physics/GFS_MP_generic.meta
View file
Original file line number Diff line number Diff line change
Expand Up @@ -105,7 +105,7 @@
dimensions = (horizontal_loop_extent,vertical_dimension)
type = real
kind = kind_phys
intent = out
intent = inout
optional = F
[save_q]
standard_name = tracer_concentration_save
Expand Down Expand Up @@ -330,7 +330,7 @@
dimensions = (horizontal_loop_extent)
type = real
kind = kind_phys
intent = in
intent = inout
optional = F
[rain1]
standard_name = lwe_thickness_of_explicit_precipitation_amount
Expand Down
28 changes: 14 additions & 14 deletions physics/GFS_PBL_generic.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -101,11 +101,11 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac,
integer, intent(in) :: imp_physics_zhao_carr, imp_physics_mg, imp_physics_fer_hires
logical, intent(in) :: cplchm, ltaerosol, hybedmf, do_shoc, satmedmf

real(kind=kind_phys), dimension(im, levs, ntrac), intent(in) :: qgrs
real(kind=kind_phys), dimension(im, levs), intent(in) :: ugrs, vgrs, tgrs
real(kind=kind_phys), dimension(im, levs, nvdiff), intent(inout) :: vdftra
real(kind=kind_phys), dimension(im, levs), intent(out) :: save_u, save_v, save_t
real(kind=kind_phys), dimension(im, levs, ntrac), intent(out) :: save_q
real(kind=kind_phys), dimension(:,:,:), intent(in) :: qgrs
real(kind=kind_phys), dimension(:,:), intent(in) :: ugrs, vgrs, tgrs
real(kind=kind_phys), dimension(:,:, :), intent(inout) :: vdftra
real(kind=kind_phys), dimension(:,:), intent(out) :: save_u, save_v, save_t
real(kind=kind_phys), dimension(:,:, :), intent(out) :: save_q

! CCPP error handling variables
character(len=*), intent(out) :: errmsg
Expand Down Expand Up @@ -336,8 +336,8 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac,
integer, intent(in) :: kdt

logical, intent(in) :: flag_for_pbl_generic_tend
real(kind=kind_phys), dimension(im, levs), intent(in) :: save_u, save_v, save_t
real(kind=kind_phys), dimension(im, levs, ntrac), intent(in) :: save_q
real(kind=kind_phys), dimension(:,:), intent(in) :: save_u, save_v, save_t
real(kind=kind_phys), dimension(:,:, :), intent(in) :: save_q

real(kind=kind_phys), intent(in) :: dtf
real(kind=kind_phys), intent(in) :: rd, cp, fvirt, hvap
Expand All @@ -346,14 +346,14 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac,
real(kind=kind_phys), dimension(:), intent(in) :: dusfc_cice, dvsfc_cice, dtsfc_cice, dqsfc_cice, &
wind, stress_wat, hflx_wat, evap_wat, ugrs1, vgrs1

real(kind=kind_phys), dimension(im, levs, ntrac), intent(in) :: qgrs
real(kind=kind_phys), dimension(im, levs), intent(in) :: ugrs, vgrs, tgrs
real(kind=kind_phys), dimension(:,:, :), intent(in) :: qgrs
real(kind=kind_phys), dimension(:,:), intent(in) :: ugrs, vgrs, tgrs

real(kind=kind_phys), dimension(im, levs, nvdiff), intent(in) :: dvdftra
real(kind=kind_phys), dimension(im), intent(in) :: dusfc1, dvsfc1, dtsfc1, dqsfc1, xmu
real(kind=kind_phys), dimension(im, levs), intent(in) :: dudt, dvdt, dtdt, htrsw, htrlw
real(kind=kind_phys), dimension(:,:, :), intent(in) :: dvdftra
real(kind=kind_phys), dimension(:), intent(in) :: dusfc1, dvsfc1, dtsfc1, dqsfc1, xmu
real(kind=kind_phys), dimension(:,:), intent(in) :: dudt, dvdt, dtdt, htrsw, htrlw

real(kind=kind_phys), dimension(im, levs, ntrac), intent(inout) :: dqdt
real(kind=kind_phys), dimension(:,:, :), intent(inout) :: dqdt

! The following arrays may not be allocated, depending on certain flags (cplflx, ...).
! Since Intel 15 crashes when passing unallocated arrays to arrays defined with explicit shape,
Expand All @@ -370,7 +370,7 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac,
real(kind=kind_phys), dimension(:,:), intent(in) :: dkt

! From canopy heat storage - reduction factors in latent/sensible heat flux due to surface roughness
real(kind=kind_phys), dimension(im), intent(in) :: hffac, hefac
real(kind=kind_phys), dimension(:), intent(in) :: hffac, hefac

character(len=*), intent(out) :: errmsg
integer, intent(out) :: errflg
Expand Down
12 changes: 6 additions & 6 deletions physics/GFS_PBL_generic.meta
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1334,18 +1334,18 @@
kind = kind_phys
intent = in
optional = F
[hefac]
standard_name = surface_upward_latent_heat_flux_reduction_factor
long_name = surface upward latent heat flux reduction factor from canopy heat storage
[hffac]
standard_name = surface_upward_sensible_heat_flux_reduction_factor
long_name = surface upward sensible heat flux reduction factor from canopy heat storage
units = none
dimensions = (horizontal_loop_extent)
type = real
kind = kind_phys
intent = in
optional = F
[hffac]
standard_name = surface_upward_sensible_heat_flux_reduction_factor
long_name = surface upward sensible heat flux reduction factor from canopy heat storage
[hefac]
standard_name = surface_upward_latent_heat_flux_reduction_factor
long_name = surface upward latent heat flux reduction factor from canopy heat storage
units = none
dimensions = (horizontal_loop_extent)
type = real
Expand Down
Loading

0 comments on commit 6237270

Please sign in to comment.