Skip to content

Commit

Permalink
Merge pull request #681 from SamuelTrahanNOAA/feature/gsl-develop-dia…
Browse files Browse the repository at this point in the history 
…gnostics-20210609

tracer tendency diagnostics and related bug fixes
  • Loading branch information
@climbfuji
climbfuji authored Jul 21, 2021
2 parents 1792e87 + 8474f91 commit 09faa73
Show file tree
Hide file tree
Showing 53 changed files with 3,514 additions and 2,045 deletions.
166 changes: 113 additions & 53 deletions physics/GFS_DCNV_generic.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -15,30 +15,35 @@ end subroutine GFS_DCNV_generic_pre_finalize
!! \section arg_table_GFS_DCNV_generic_pre_run Argument Table
!! \htmlinclude GFS_DCNV_generic_pre_run.html
!!
subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, qdiag3d, do_cnvgwd, cplchm,&
gu0, gv0, gt0, gq0_water_vapor, &
save_u, save_v, save_t, save_qv, &
errmsg, errflg)
subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, qdiag3d, do_cnvgwd, cplchm, &
gu0, gv0, gt0, gq0, nsamftrac, ntqv, &
save_u, save_v, save_t, save_q, clw, &
ntcw,ntiw,ntclamt,ntrw,ntsw,ntrnc,ntsnc,ntgl, &
ntgnc, cscnv, satmedmf, trans_trac, ras, ntrac, &
dtidx, index_of_process_dcnv, errmsg, errflg)

use machine, only: kind_phys

implicit none

integer, intent(in) :: im, levs
integer, intent(in) :: im, levs, nsamftrac, ntqv, index_of_process_dcnv, dtidx(:,:), &
ntcw,ntiw,ntclamt,ntrw,ntsw,ntrnc,ntsnc,ntgl,ntrac,ntgnc
logical, intent(in) :: ldiag3d, qdiag3d, do_cnvgwd, cplchm
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
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
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_q
character(len=*), intent(out) :: errmsg
integer, intent(out) :: errflg

logical, intent(in) :: cscnv, satmedmf, trans_trac, ras
real(kind=kind_phys), parameter :: zero = 0.0d0
integer :: i, k
real(kind=kind_phys), dimension(:,:,:), intent(in) :: clw

integer :: i, k, n, tracers

! Initialize CCPP error handling variables
errmsg = ''
Expand All @@ -61,11 +66,26 @@ subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, qdiag3d, do_cnvgwd, cplc
endif

if ((ldiag3d.and.qdiag3d) .or. cplchm) then
do k=1,levs
do i=1,im
save_qv(i,k) = gq0_water_vapor(i,k)
enddo
enddo
if (cscnv .or. satmedmf .or. trans_trac .or. ras) then
tracers = 2
do n=2,ntrac
if ( n /= ntcw .and. n /= ntiw .and. n /= ntclamt .and. &
n /= ntrw .and. n /= ntsw .and. n /= ntrnc .and. &
n /= ntsnc .and. n /= ntgl .and. n /= ntgnc) then
tracers = tracers + 1
if(dtidx(100+n,index_of_process_dcnv)>0) then
save_q(:,:,n) = clw(:,:,tracers)
endif
endif
enddo
else
do n=2,ntrac
if(dtidx(100+n,index_of_process_dcnv)>0) then
save_q(:,:,n) = gq0(:,:,n)
endif
enddo
endif ! end if_ras or cfscnv or samf
save_q(:,:,ntqv) = gq0(:,:,ntqv)
endif

end subroutine GFS_DCNV_generic_pre_run
Expand All @@ -85,44 +105,51 @@ end subroutine GFS_DCNV_generic_post_finalize
!> \section arg_table_GFS_DCNV_generic_post_run Argument Table
!! \htmlinclude GFS_DCNV_generic_post_run.html
!!
subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, qdiag3d, ras, cscnv, &
frain, rain1, dtf, cld1d, save_u, save_v, save_t, save_qv, gu0, gv0, gt0, &
gq0_water_vapor, ud_mf, dd_mf, dt_mf, con_g, npdf3d, num_p3d, ncnvcld3d, &
rainc, cldwrk, dt3dt, dq3dt, du3dt, dv3dt, upd_mf, dwn_mf, det_mf, &
cnvw, cnvc, cnvw_phy_f3d, cnvc_phy_f3d, flag_for_dcnv_generic_tend, errmsg, errflg)
subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, qdiag3d, ras, &
cscnv, frain, rain1, dtf, cld1d, save_u, save_v, save_t, gu0, gv0, gt0, &
ud_mf, dd_mf, dt_mf, con_g, npdf3d, num_p3d, ncnvcld3d, nsamftrac, &
rainc, cldwrk, upd_mf, dwn_mf, det_mf, dtend, dtidx, index_of_process_dcnv, &
index_of_temperature, index_of_x_wind, index_of_y_wind, ntqv, gq0, save_q, &
cnvw, cnvc, cnvw_phy_f3d, cnvc_phy_f3d, flag_for_dcnv_generic_tend, &
ntcw,ntiw,ntclamt,ntrw,ntsw,ntrnc,ntsnc,ntgl,ntgnc, ntrac,clw, &
satmedmf, trans_trac, errmsg, errflg)


use machine, only: kind_phys

implicit none

integer, intent(in) :: im, levs
integer, intent(in) :: im, levs, nsamftrac
logical, intent(in) :: lssav, ldiag3d, qdiag3d, ras, cscnv
logical, intent(in) :: flag_for_dcnv_generic_tend

real(kind=kind_phys), intent(in) :: frain, dtf
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), dimension(:), intent(in) :: rain1, cld1d
real(kind=kind_phys), dimension(:,:), intent(in) :: save_u, save_v, save_t
real(kind=kind_phys), dimension(:,:), intent(in) :: gu0, gv0, gt0
real(kind=kind_phys), dimension(:,:,:), intent(in) :: gq0, save_q
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
logical, intent(in) :: satmedmf, trans_trac

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) :: rainc, cldwrk
real(kind=kind_phys), dimension(:,:), intent(inout) :: upd_mf, dwn_mf, det_mf
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
! as long as these do not get used when not allocated (it is still invalid Fortran code, though).

real(kind=kind_phys), dimension(:,:,:), intent(inout) :: dtend
integer, intent(in) :: dtidx(:,:), index_of_process_dcnv, index_of_temperature, &
index_of_x_wind, index_of_y_wind, ntqv
integer, intent(in) :: ntcw,ntiw,ntclamt,ntrw,ntsw,ntrnc,ntsnc,ntgl,ntrac,ntgnc
real(kind=kind_phys), dimension(:,:,:), intent(in) :: clw


real(kind=kind_phys), dimension(:,:), intent(inout) :: cnvw_phy_f3d, cnvc_phy_f3d

character(len=*), intent(out) :: errmsg
integer, intent(out) :: errflg

integer :: i, k
integer :: i, k, n, idtend, tracers

! Initialize CCPP error handling variables
errmsg = ''
Expand Down Expand Up @@ -158,23 +185,56 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, qdiag3d, ras, cs
enddo

if (ldiag3d .and. flag_for_dcnv_generic_tend) then
do k=1,levs
do i=1,im
dt3dt(i,k) = dt3dt(i,k) + (gt0(i,k)-save_t(i,k)) * frain
du3dt(i,k) = du3dt(i,k) + (gu0(i,k)-save_u(i,k)) * frain
dv3dt(i,k) = dv3dt(i,k) + (gv0(i,k)-save_v(i,k)) * frain
idtend=dtidx(index_of_temperature,index_of_process_dcnv)
if(idtend>=1) then
dtend(:,:,idtend) = dtend(:,:,idtend) + (gt0-save_t)*frain
endif

idtend=dtidx(index_of_x_wind,index_of_process_dcnv)
if(idtend>=1) then
dtend(:,:,idtend) = dtend(:,:,idtend) + (gu0-save_u)*frain
endif

idtend=dtidx(index_of_y_wind,index_of_process_dcnv)
if(idtend>=1) then
dtend(:,:,idtend) = dtend(:,:,idtend) + (gv0-save_v)*frain
endif

if (cscnv .or. satmedmf .or. trans_trac .or. ras) then
tracers = 2
do n=2,ntrac
if ( n /= ntcw .and. n /= ntiw .and. n /= ntclamt .and. &
n /= ntrw .and. n /= ntsw .and. n /= ntrnc .and. &
n /= ntsnc .and. n /= ntgl .and. n /= ntgnc) then
tracers = tracers + 1
idtend = dtidx(100+n,index_of_process_dcnv)
if(idtend>0) then
dtend(:,:,idtend) = dtend(:,:,idtend) + clw(:,:,tracers)-save_q(:,:,n) * frain
endif
endif
enddo
else
do n=2,ntrac
idtend = dtidx(100+n,index_of_process_dcnv)
if(idtend>0) then
dtend(:,:,idtend) = dtend(:,:,idtend) + (gq0(:,:,n)-save_q(:,:,n))*frain
endif
enddo
enddo
endif
idtend = dtidx(100+ntqv, index_of_process_dcnv)
if(idtend>=1) then
dtend(:,:,idtend) = dtend(:,:,idtend) + (gq0(:,:,ntqv) - save_q(:,:,ntqv)) * frain
endif

! convective mass fluxes
if(qdiag3d) then
do k=1,levs
do i=1,im
dq3dt(i,k) = dq3dt(i,k) + (gq0_water_vapor(i,k)-save_qv(i,k)) * frain
! convective mass fluxes
upd_mf(i,k) = upd_mf(i,k) + ud_mf(i,k) * (con_g*frain)
dwn_mf(i,k) = dwn_mf(i,k) + dd_mf(i,k) * (con_g*frain)
det_mf(i,k) = det_mf(i,k) + dt_mf(i,k) * (con_g*frain)
enddo
enddo
do k=1,levs
do i=1,im
upd_mf(i,k) = upd_mf(i,k) + ud_mf(i,k) * (con_g*frain)
dwn_mf(i,k) = dwn_mf(i,k) + dd_mf(i,k) * (con_g*frain)
det_mf(i,k) = det_mf(i,k) + dt_mf(i,k) * (con_g*frain)
enddo
enddo
endif
endif ! if (ldiag3d)

Expand Down
Loading

0 comments on commit 09faa73

Please sign in to comment.