Skip to content

Commit

Permalink
Merge pull request #786 from climbfuji/wam_debug_and_thompson_suggest…
Browse files Browse the repository at this point in the history 
…ions

Update consistency checks and effective radii calculation for Thompson MP
  • Loading branch information
@climbfuji
climbfuji authored Jan 20, 2022
2 parents a37ea20 + 2817053 commit 899df7f
Show file tree
Hide file tree
Showing 3 changed files with 49 additions and 64 deletions.
45 changes: 15 additions & 30 deletions physics/GFS_rrtmg_pre.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -195,9 +195,9 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, &
effrl, effri, effrr, effrs, rho, orho, plyrpa

! for Thompson MP
real(kind=kind_phys), dimension(im,lm+LTP) :: &
re_cloud, re_ice, re_snow, qv_mp, qc_mp, &
qi_mp, qs_mp, nc_mp, ni_mp, nwfa
real(kind=kind_phys), dimension(im,lm+LTP) :: &
qv_mp, qc_mp, qi_mp, qs_mp, &
nc_mp, ni_mp, nwfa
real (kind=kind_phys), dimension(lm) :: cldfra1d, qv1d, &
& qc1d, qi1d, qs1d, dz1d, p1d, t1d

Expand Down Expand Up @@ -816,30 +816,18 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, &
! it will raise the low limit from 5 to 10, but the high limit will remain 125.
call calc_effectRad (tlyr(i,:), plyr(i,:)*100., qv_mp(i,:), qc_mp(i,:), &
nc_mp(i,:), qi_mp(i,:), ni_mp(i,:), qs_mp(i,:), &
re_cloud(i,:), re_ice(i,:), re_snow(i,:), 1, lm )
effrl(i,:), effri(i,:), effrs(i,:), 1, lm )
! Scale Thompson's effective radii from meter to micron
do k=1,lm
re_cloud(i,k) = MAX(re_qc_min, MIN(re_cloud(i,k), re_qc_max))
re_ice(i,k) = MAX(re_qi_min, MIN(re_ice(i,k), re_qi_max))
re_snow(i,k) = MAX(re_qs_min, MIN(re_snow(i,k), re_qs_max))
end do
end do
! Scale Thompson's effective radii from meter to micron
do k=1,lm
do i=1,im
re_cloud(i,k) = re_cloud(i,k)*1.e6
re_ice(i,k) = re_ice(i,k)*1.e6
re_snow(i,k) = re_snow(i,k)*1.e6
effrl(i,k) = MAX(re_qc_min, MIN(effrl(i,k), re_qc_max))*1.e6
effri(i,k) = MAX(re_qi_min, MIN(effri(i,k), re_qi_max))*1.e6
effrs(i,k) = MAX(re_qs_min, MIN(effrs(i,k), re_qs_max))*1.e6
end do
effrl(i,lmk) = re_qc_min*1.e6
effri(i,lmk) = re_qi_min*1.e6
effrs(i,lmk) = re_qs_min*1.e6
end do
do k=1,lm
k1 = k + kd
do i=1,im
effrl(i,k1) = re_cloud (i,k)
effri(i,k1) = re_ice (i,k)
effrr(i,k1) = 1000. ! rrain_def=1000.
effrs(i,k1) = re_snow(i,k)
enddo
enddo
effrr(:,:) = 1000. ! rrain_def=1000.
! Update global arrays
do k=1,lm
k1 = k + kd
Expand Down Expand Up @@ -971,8 +959,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, &
ntrac-1, ntcw-1,ntiw-1,ntrw-1, &
ntsw-1,ntgl-1, &
im, lm, lmp, uni_cld, lmfshal, lmfdeep2, &
cldcov(:,1:LM), effrl_inout, &
effri_inout, effrs_inout, &
cldcov(:,1:LM), effrl, effri, effrs, &
lwp_ex, iwp_ex, lwp_fc, iwp_fc, &
dzb, xlat_d, julian, yearlen, gridkm, &
clouds, cldsa, mtopa ,mbota, de_lgth, alpha) ! --- outputs
Expand Down Expand Up @@ -1005,8 +992,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, &
ntrac-1, ntcw-1,ntiw-1,ntrw-1, &
ntsw-1,ntgl-1, &
im, lm, lmp, uni_cld, lmfshal, lmfdeep2, &
cldcov(:,1:LM), effrl_inout, &
effri_inout, effrs_inout, &
cldcov(:,1:LM), effrl, effri, effrs, &
lwp_ex, iwp_ex, lwp_fc, iwp_fc, &
dzb, xlat_d, julian, yearlen, gridkm, &
clouds, cldsa, mtopa ,mbota, de_lgth, alpha) ! --- outputs
Expand All @@ -1017,8 +1003,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, &
ntrac-1, ntcw-1,ntiw-1,ntrw-1, &
ntsw-1,ntgl-1, &
im, lmk, lmp, uni_cld, lmfshal, lmfdeep2, &
cldcov(:,1:LMK), cnvw, effrl_inout, &
effri_inout, effrs_inout, &
cldcov(:,1:LMK), cnvw, effrl, effri, effrs,&
lwp_ex, iwp_ex, lwp_fc, iwp_fc, &
dzb, xlat_d, julian, yearlen, &
clouds, cldsa, mtopa ,mbota, de_lgth, alpha) ! --- outputs
Expand Down
10 changes: 0 additions & 10 deletions physics/module_mp_thompson.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1252,16 +1252,6 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, &
ndt = max(nint(dt_in/dt_inner),1)
dt = dt_in/ndt
if(dt_in .le. dt_inner) dt= dt_in
if(nsteps>1 .and. ndt>1) then
if (present(errmsg) .and. present(errflg)) then
write(errmsg, '(a)') 'Logic error in mp_gt_driver: inner loop cannot be used with subcycling'
errflg = 1
return
else
write(*,'(a)') 'Warning: inner loop cannot be used with subcycling, resetting ndt=1'
ndt = 1
endif
endif

do it = 1, ndt

Expand Down
58 changes: 34 additions & 24 deletions physics/mp_thompson.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -377,6 +377,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, &

! Reduced time step if subcycling is used
real(kind_phys) :: dtstep
integer :: ndt
! Air density
real(kind_phys) :: rho(1:ncol,1:nlev) !< kg m-3
! Water vapor mixing ratio (instead of specific humidity)
Expand Down Expand Up @@ -456,11 +457,39 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, &
errmsg = ''
errflg = 0

! Check initialization state
if (.not.is_initialized) then
write(errmsg, fmt='((a))') 'mp_thompson_run called before mp_thompson_init'
errflg = 1
return
if (first_time_step .and. istep==1 .and. blkno==1) then
! Check initialization state
if (.not.is_initialized) then
write(errmsg, fmt='((a))') 'mp_thompson_run called before mp_thompson_init'
errflg = 1
return
end if
! Check forr optional arguments of aerosol-aware microphysics
if (is_aerosol_aware .and. .not. (present(nc) .and. &
present(nwfa) .and. &
present(nifa) .and. &
present(nwfa2d) .and. &
present(nifa2d) )) then
write(errmsg,fmt='(*(a))') 'Logic error in mp_thompson_run:', &
' aerosol-aware microphysics require all of the', &
' following optional arguments:', &
' nc, nwfa, nifa, nwfa2d, nifa2d'
errflg = 1
return
end if
! Consistency cheecks - subcycling and inner loop at the same time are not supported
if (nsteps>1 .and. dt_inner < dtp) then
write(errmsg,'(*(a))') "Logic error: Subcycling and inner loop cannot be used at the same time"
errflg = 1
return
else if (mpirank==mpiroot .and. nsteps>1) then
write(*,'(a,i0,a,a,f6.2,a)') 'Thompson MP is using ', nsteps, ' substep(s) per time step with an ', &
'effective time step of ', dtp/real(nsteps, kind=kind_phys), ' seconds'
else if (mpirank==mpiroot .and. dt_inner < dtp) then
ndt = max(nint(dtp/dt_inner),1)
write(*,'(a,i0,a,a,f6.2,a)') 'Thompson MP is using ', ndt, ' inner loops per time step with an ', &
'effective time step of ', dtp/real(ndt, kind=kind_phys), ' seconds'
end if
end if

! Set reduced time step if subcycling is used
Expand All @@ -469,25 +498,6 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, &
else
dtstep = dtp
end if
if (first_time_step .and. istep==1 .and. mpirank==mpiroot .and. blkno==1) then
write(*,'(a,i0,a,a,f8.2,a)') 'Thompson MP is using ', nsteps, ' substep(s) per time step', &
' with an effective time step of ', dtstep, ' seconds'
end if

if (first_time_step .and. istep==1) then
if (is_aerosol_aware .and. .not. (present(nc) .and. &
present(nwfa) .and. &
present(nifa) .and. &
present(nwfa2d) .and. &
present(nifa2d) )) then
write(errmsg,fmt='(*(a))') 'Logic error in mp_thompson_run:', &
' aerosol-aware microphysics require all of the', &
' following optional arguments:', &
' nc, nwfa, nifa, nwfa2d, nifa2d'
errflg = 1
return
end if
end if

!> - Convert specific humidity to water vapor mixing ratio.
!> - Also, hydrometeor variables are mass or number mixing ratio
Expand Down

0 comments on commit 899df7f

Please sign in to comment.