Skip to content

Commit

Permalink
fix bugs found in pbl and ozone 3d diagnostic tendencies (NCAR#27)
Browse files Browse the repository at this point in the history 
PBL tendencies were missing in two schemes; now fixed. Squashed commit of:
* fix bugs found in pbl and ozone 3d diagnostic tendencies
* remove debugging prints
* implied shape arrays for five variables
* more block labels
* yet more bug fixes
  • Loading branch information
@SamuelTrahanNOAA
SamuelTrahanNOAA authored May 14, 2020
1 parent bbc6f33 commit 238c84c
Show file tree
Hide file tree
Showing 4 changed files with 141 additions and 22 deletions.
26 changes: 13 additions & 13 deletions physics/GFS_PBL_generic.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -373,7 +373,7 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac,
errmsg = ''
errflg = 0
!GJF: dvdftra is only used if nvdiff != ntrac or (nvdiff == ntrac .and. )
if (nvdiff == ntrac .and. (hybedmf .or. do_shoc .or. satmedmf)) then
if_nvdiff_ntrac: if (nvdiff == ntrac .and. (hybedmf .or. do_shoc .or. satmedmf)) then
dqdt = dvdftra
elseif (nvdiff /= ntrac .and. .not. shinhong .and. .not. do_ysu) then
!
Expand All @@ -385,7 +385,7 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac,
enddo
endif
!
if (trans_aero) then
if_trans_aero: if (trans_aero) then
! Set kk if chemistry-aerosol tracers are diffused
call set_aerosol_tracer_index(imp_physics, imp_physics_wsm6, &
imp_physics_thompson, ltaerosol, &
Expand All @@ -403,9 +403,9 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac,
enddo
enddo
enddo
endif
endif if_trans_aero
!
if (imp_physics == imp_physics_wsm6) then
if_imp_physics: if (imp_physics == imp_physics_wsm6) then
! WSM6
do k=1,levs
do i=1,im
Expand Down Expand Up @@ -517,9 +517,9 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac,
dqdt(i,k,ntoz) = dvdftra(i,k,3)
enddo
enddo
endif
endif if_imp_physics

endif ! nvdiff == ntrac
endif if_nvdiff_ntrac

if (cplchm) then
do i = 1, im
Expand All @@ -534,7 +534,7 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac,

! --- ... coupling insertion

if (cplflx) then
if_cplflx: if (cplflx) then
do i=1,im
if (oceanfrac(i) > 0.0) then ! Ocean only, NO LAKES
! if (fice(i) == ceanfrac(i)) then ! use results from CICE
Expand Down Expand Up @@ -572,10 +572,10 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac,
!!
endif ! Ocean only, NO LAKES
enddo
endif
endif if_cplflx

!-------------------------------------------------------lssav if loop ----------
if (lssav) then
if_lssav: if (lssav) then
do i=1,im
dusfc_diag (i) = dusfc_diag(i) + dusfc1(i)*dtf
dvsfc_diag (i) = dvsfc_diag(i) + dvsfc1(i)*dtf
Expand All @@ -591,7 +591,7 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac,
! & dtf,' kdt=',kdt,' lat=',lat
! endif

if (ldiag3d .and. flag_for_pbl_generic_tend .and. lssav) then
if_diag: if (ldiag3d .and. flag_for_pbl_generic_tend .and. lssav) then
if (lsidea) then
dt3dt(1:im,:) = dt3dt(1:im,:) + dtdt(1:im,:)*dtf
else
Expand All @@ -615,9 +615,9 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac,
enddo
enddo
endif
endif

endif ! end if_lssav
endif if_diag
endif if_lssav

end subroutine GFS_PBL_generic_post_run

Expand Down
2 changes: 1 addition & 1 deletion physics/moninedmf.f
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1068,7 +1068,7 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, &
enddo
enddo
if(lssav .and. ldiag3d .and. ntoz>0 .and. qdiag3d .and. &
& flag_for_pbl_generic_tend) then
& .not. flag_for_pbl_generic_tend) then
kk = ntoz
is = (kk-1) * km
do k = 1, km
Expand Down
66 changes: 58 additions & 8 deletions physics/satmedmfvdifq.F
View file
Original file line number Diff line number Diff line change
Expand Up @@ -65,6 +65,7 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, &
& prsi,del,prsl,prslk,phii,phil,delt, &
& dspheat,dusfc,dvsfc,dtsfc,dqsfc,hpbl, &
& kinver,xkzm_m,xkzm_h,xkzm_s,dspfac,bl_upfr,bl_dnfr, &
& ntoz,du3dt,dv3dt,dt3dt,dq3dt,do3dt,ldiag3d,qdiag3d, &
& errmsg,errflg)
!
use machine , only : kind_phys
Expand All @@ -73,9 +74,10 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, &
implicit none
!
!----------------------------------------------------------------------
integer, intent(in) :: ix, im, km, ntrac, ntcw, ntiw, ntke
integer, intent(in) :: ix, im, km, ntrac, ntcw, ntiw, ntke, ntoz
integer, intent(in) :: kinver(im)
integer, intent(out) :: kpbl(im)
logical, intent(in) :: ldiag3d,qdiag3d
!
real(kind=kind_phys), intent(in) :: grav,rd,cp,rv,hvap,hfus,fv, &
& eps,epsm1
Expand All @@ -97,6 +99,10 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, &
& prsi(ix,km+1), del(ix,km), &
& prsl(ix,km), prslk(ix,km), &
& phii(ix,km+1), phil(ix,km)
real(kind=kind_phys), intent(inout), dimension(:,:) :: &
& du3dt(:,:), dv3dt(:,:), &
& dt3dt(:,:), dq3dt(:,:), &
& do3dt(:,:)
real(kind=kind_phys), intent(out) :: &
& dusfc(im), dvsfc(im), &
& dtsfc(im), dqsfc(im), &
Expand Down Expand Up @@ -1303,6 +1309,22 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, &
dqsfc(i) = dqsfc(i)+conq*del(i,k)*qtend
enddo
enddo
if(ldiag3d) then
do k = 1,km
do i = 1,im
ttend = (f1(i,k)-t1(i,k))*rdt
dt3dt(i,k) = dt3dt(i,k)+dspfac*ttend*delt
enddo
enddo
if(qdiag3d) then
do k = 1,km
do i = 1,im
qtend = (f2(i,k)-q1(i,k,1))*rdt
dq3dt(i,k) = dq3dt(i,k)+dspfac*qtend*delt
enddo
enddo
endif
endif
!
if(ntrac1 >= 2) then
do kk = 2, ntrac1
Expand All @@ -1314,19 +1336,37 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, &
enddo
enddo
enddo
if(ldiag3d .and. qdiag3d .and. ntoz>0) then
kk=ntoz
is = (kk-1) * km
do k = 1, km
do i = 1, im
qtend = (f2(i,k+is)-q1(i,k,kk))*rdt
do3dt(i,k) = do3dt(i,k)+qtend*delt
enddo
enddo
endif
endif
!
! add tke dissipative heating to temperature tendency
!
if(dspheat) then
do k = 1,km1
do i = 1,im
! tem = min(diss(i,k), dspmax)
! ttend = tem / cp
ttend = diss(i,k) / cp
tdt(i,k) = tdt(i,k) + dspfac * ttend
do k = 1,km1
do i = 1,im
! tem = min(diss(i,k), dspmax)
! ttend = tem / cp
ttend = diss(i,k) / cp
tdt(i,k) = tdt(i,k) + dspfac * ttend
enddo
enddo
enddo
if(ldiag3d) then
do k = 1,km1
do i = 1,im
ttend = diss(i,k) / cp
dt3dt(i,k) = dt3dt(i,k)+dspfac * ttend*delt
enddo
enddo
endif
endif
c
c compute tridiagonal matrix elements for momentum
Expand Down Expand Up @@ -1403,6 +1443,16 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, &
dvsfc(i) = dvsfc(i)+conw*del(i,k)*vtend
enddo
enddo
if(ldiag3d) then
do k = 1,km
do i = 1,im
utend = (f1(i,k)-u1(i,k))*rdt
vtend = (f2(i,k)-v1(i,k))*rdt
du3dt(i,k) = du3dt(i,k) + utend*delt
dv3dt(i,k) = dv3dt(i,k) + vtend*delt
enddo
enddo
endif
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! pbl height for diagnostic purpose
Expand Down
69 changes: 69 additions & 0 deletions physics/satmedmfvdifq.meta
View file
Original file line number Diff line number Diff line change
Expand Up @@ -578,6 +578,75 @@
kind = kind_phys
intent = in
optional = F
[ntoz]
standard_name = index_for_ozone
long_name = tracer index for ozone mixing ratio
units = index
dimensions = ()
type = integer
intent = in
optional = F
[du3dt]
standard_name = cumulative_change_in_x_wind_due_to_PBL
long_name = cumulative change in x wind due to PBL
units = m s-1
dimensions = (horizontal_dimension,vertical_dimension)
type = real
kind = kind_phys
intent = inout
optional = F
[dv3dt]
standard_name = cumulative_change_in_y_wind_due_to_PBL
long_name = cumulative change in y wind due to PBL
units = m s-1
dimensions = (horizontal_dimension,vertical_dimension)
type = real
kind = kind_phys
intent = inout
optional = F
[dt3dt]
standard_name = cumulative_change_in_temperature_due_to_PBL
long_name = cumulative change in temperature due to PBL
units = K
dimensions = (horizontal_dimension,vertical_dimension)
type = real
kind = kind_phys
intent = inout
optional = F
[dq3dt]
standard_name = cumulative_change_in_water_vapor_specific_humidity_due_to_PBL
long_name = cumulative change in water vapor specific humidity due to PBL
units = kg kg-1
dimensions = (horizontal_dimension,vertical_dimension)
type = real
kind = kind_phys
intent = inout
optional = F
[do3dt]
standard_name = cumulative_change_in_ozone_mixing_ratio_due_to_PBL
long_name = cumulative change in ozone mixing ratio due to PBL
units = kg kg-1
dimensions = (horizontal_dimension,vertical_dimension)
type = real
kind = kind_phys
intent = inout
optional = F
[ldiag3d]
standard_name = flag_diagnostics_3D
long_name = flag for 3d diagnostic fields
units = flag
dimensions = ()
type = logical
intent = inout
optional = F
[qdiag3d]
standard_name = flag_tracer_diagnostics_3D
long_name = flag for 3d tracer diagnostic fields
units = flag
dimensions = ()
type = logical
intent = inout
optional = F
[errmsg]
standard_name = ccpp_error_message
long_name = error message for error handling in CCPP
Expand Down

0 comments on commit 238c84c

Please sign in to comment.