Skip to content

Commit

Permalink
Merge pull request NCAR#407 from climbfuji/update_from_dev_emc_202003…
Browse files Browse the repository at this point in the history 
…12_and_other_changes

Update from dev/emc 2020/03/12 and other changes
  • Loading branch information
@climbfuji
climbfuji authored Mar 13, 2020
2 parents db57e18 + 0595482 commit d979604
Show file tree
Hide file tree
Showing 5 changed files with 68 additions and 39 deletions.
8 changes: 4 additions & 4 deletions physics/GFS_stochastics.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -124,7 +124,7 @@ subroutine GFS_stochastics_run (im, km, do_sppt, use_zmtnblck, do_shum, do_skeb,
if (use_zmtnblck)then
sppt_wts(i,k)=(sppt_wts(i,k)-1)*sppt_vwt+1.0
endif
sppt_wts_inv(i,km-k+1)=sppt_wts(i,k)
sppt_wts_inv(i,k)=sppt_wts(i,k)

!if(isppt_deep)then

Expand Down Expand Up @@ -190,16 +190,16 @@ subroutine GFS_stochastics_run (im, km, do_sppt, use_zmtnblck, do_shum, do_skeb,
if (do_shum) then
do k=1,km
gq0(:,k) = gq0(:,k)*(1.0 + shum_wts(:,k))
shum_wts_inv(:,km-k+1) = shum_wts(:,k)
shum_wts_inv(:,k) = shum_wts(:,k)
end do
endif

if (do_skeb) then
do k=1,km
gu0(:,k) = gu0(:,k)+skebu_wts(:,k)*(diss_est(:,k))
gv0(:,k) = gv0(:,k)+skebv_wts(:,k)*(diss_est(:,k))
skebu_wts_inv(:,km-k+1) = skebu_wts(:,k)
skebv_wts_inv(:,km-k+1) = skebv_wts(:,k)
skebu_wts_inv(:,k) = skebu_wts(:,k)
skebv_wts_inv(:,k) = skebv_wts(:,k)
enddo
endif

Expand Down
51 changes: 32 additions & 19 deletions physics/module_mp_thompson.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1007,14 +1007,15 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, &
ids,ide, jds,jde, kds,kde, & ! domain dims
ims,ime, jms,jme, kms,kme, & ! memory dims
its,ite, jts,jte, kts,kte, & ! tile dims
errmsg, errflg)
errmsg, errflg, reset, kdt)

implicit none

!..Subroutine arguments
INTEGER, INTENT(IN):: ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte
its,ite, jts,jte, kts,kte, &
kdt
REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT):: &
qv, qc, qr, qi, qs, qg, ni, nr
REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT):: &
Expand Down Expand Up @@ -1045,6 +1046,7 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, &
vt_dbz_wt
LOGICAL, OPTIONAL, INTENT(IN) :: first_time_step
REAL, INTENT(IN):: dt_in
LOGICAL, INTENT (IN) :: reset

!..Local variables
REAL, DIMENSION(kts:kte):: &
Expand All @@ -1067,6 +1069,8 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, &
INTEGER:: i_start, j_start, i_end, j_end
LOGICAL, OPTIONAL, INTENT(IN) :: diagflag
INTEGER, OPTIONAL, INTENT(IN) :: do_radar_ref
logical :: melti = .false.

! CCPP error handling
character(len=*), optional, intent( out) :: errmsg
integer, optional, intent( out) :: errflg
Expand Down Expand Up @@ -1362,15 +1366,25 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, &
enddo

!> - Call calc_refl10cm()

IF ( PRESENT (diagflag) ) THEN
if (diagflag .and. do_radar_ref == 1) then
!
! Only set melti to true at the output times
if (reset) then
melti=.true.
else
melti=.false.
endif
!
if (present(vt_dbz_wt) .and. present(first_time_step)) then
call calc_refl10cm (qv1d, qc1d, qr1d, nr1d, qs1d, qg1d, &
t1d, p1d, dBZ, kts, kte, i, j, &
vt_dbz_wt(i,:,j), first_time_step)
t1d, p1d, dBZ, kts, kte, i, j, &
melti, kdt,vt_dbz_wt(i,:,j), &
first_time_step)
else
call calc_refl10cm (qv1d, qc1d, qr1d, nr1d, qs1d, qg1d, &
t1d, p1d, dBZ, kts, kte, i, j)
t1d, p1d, dBZ, kts, kte, i, j,melti,kdt)
end if
do k = kts, kte
refl_10cm(i,k,j) = MAX(-35., dBZ(k))
Expand Down Expand Up @@ -1577,7 +1591,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, &
INTEGER:: idx_tc, idx_t, idx_s, idx_g1, idx_g, idx_r1, idx_r, &
idx_i1, idx_i, idx_c, idx, idx_d, idx_n, idx_in

LOGICAL:: melti, no_micro
LOGICAL:: no_micro
LOGICAL, DIMENSION(kts:kte):: L_qc, L_qi, L_qr, L_qs, L_qg
LOGICAL:: debug_flag
INTEGER:: nu_c
Expand Down Expand Up @@ -5204,12 +5218,13 @@ end subroutine calc_effectRad
!! of frozen species remaining from what initially existed at the
!! melting level interface.
subroutine calc_refl10cm (qv1d, qc1d, qr1d, nr1d, qs1d, qg1d, &
t1d, p1d, dBZ, kts, kte, ii, jj, vt_dBZ, first_time_step)
t1d, p1d, dBZ, kts, kte, ii, jj, melti,kdt,vt_dBZ, &
first_time_step)

IMPLICIT NONE

!..Sub arguments
INTEGER, INTENT(IN):: kts, kte, ii, jj
INTEGER, INTENT(IN):: kts, kte, ii, jj, kdt
REAL, DIMENSION(kts:kte), INTENT(IN):: &
qv1d, qc1d, qr1d, nr1d, qs1d, qg1d, t1d, p1d
REAL, DIMENSION(kts:kte), INTENT(INOUT):: dBZ
Expand Down Expand Up @@ -5237,7 +5252,7 @@ subroutine calc_refl10cm (qv1d, qc1d, qr1d, nr1d, qs1d, qg1d, &
DOUBLE PRECISION:: fmelt_s, fmelt_g

INTEGER:: i, k, k_0, kbot, n
LOGICAL:: melti
LOGICAL, INTENT(IN):: melti
LOGICAL, DIMENSION(kts:kte):: L_qr, L_qs, L_qg

DOUBLE PRECISION:: cback, x, eta, f_d
Expand Down Expand Up @@ -5390,18 +5405,16 @@ subroutine calc_refl10cm (qv1d, qc1d, qr1d, nr1d, qs1d, qg1d, &
!+---+-----------------------------------------------------------------+
!..Locate K-level of start of melting (k_0 is level above).
!+---+-----------------------------------------------------------------+
melti = .false.
k_0 = kts
do k = kte-1, kts, -1
if ( (temp(k).gt.273.15) .and. L_qr(k) &
if ( melti ) then
K_LOOP:do k = kte-1, kts, -1
if ((temp(k).gt.273.15) .and. L_qr(k) &
& .and. (L_qs(k+1).or.L_qg(k+1)) ) then
k_0 = MAX(k+1, k_0)
melti=.true.
goto 195
endif
enddo
195 continue

k_0 = MAX(k+1, k_0)
EXIT K_LOOP
endif
enddo K_LOOP
endif
!+---+-----------------------------------------------------------------+
!..Assume Rayleigh approximation at 10 cm wavelength. Rain (all temps)
!.. and non-water-coated snow and graupel when below freezing are
Expand Down
22 changes: 11 additions & 11 deletions physics/mp_thompson.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -38,7 +38,6 @@ subroutine mp_thompson_init(ncol, nlev, is_aerosol_aware, &
! Interface variables
integer, intent(in) :: ncol
integer, intent(in) :: nlev

logical, intent(in) :: is_aerosol_aware
real(kind_phys), optional, intent(inout) :: nwfa2d(1:ncol)
real(kind_phys), optional, intent(inout) :: nifa2d(1:ncol)
Expand Down Expand Up @@ -138,13 +137,13 @@ end subroutine mp_thompson_init
!>\ingroup aathompson
!>\section gen_thompson_hrrr Thompson MP General Algorithm
!>@{
subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, &
subroutine mp_thompson_run(ncol, nlev, kdt, con_g, con_rd, &
spechum, qc, qr, qi, qs, qg, ni, nr, &
is_aerosol_aware, nc, nwfa, nifa, &
nwfa2d, nifa2d, &
tgrs, prsl, phii, omega, dtp, &
prcp, rain, graupel, ice, snow, sr, &
refl_10cm, do_radar_ref, &
refl_10cm, reset, do_radar_ref, &
re_cloud, re_ice, re_snow, &
mpicomm, mpirank, mpiroot, &
errmsg, errflg)
Expand All @@ -156,6 +155,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, &
! Dimensions and constants
integer, intent(in ) :: ncol
integer, intent(in ) :: nlev
integer, intent(in ) :: kdt
real(kind_phys), intent(in ) :: con_g
real(kind_phys), intent(in ) :: con_rd
! Hydrometeors
Expand All @@ -168,12 +168,12 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, &
real(kind_phys), intent(inout) :: ni(1:ncol,1:nlev)
real(kind_phys), intent(inout) :: nr(1:ncol,1:nlev)
! Aerosols
logical, intent(in) :: is_aerosol_aware
real(kind_phys), optional, intent(inout) :: nc(1:ncol,1:nlev)
real(kind_phys), optional, intent(inout) :: nwfa(1:ncol,1:nlev)
real(kind_phys), optional, intent(inout) :: nifa(1:ncol,1:nlev)
real(kind_phys), optional, intent(in ) :: nwfa2d(1:ncol)
real(kind_phys), optional, intent(in ) :: nifa2d(1:ncol)
logical, intent(in) :: is_aerosol_aware,reset
real(kind_phys), optional, intent(inout) :: nc(:,:)
real(kind_phys), optional, intent(inout) :: nwfa(:,:)
real(kind_phys), optional, intent(inout) :: nifa(:,:)
real(kind_phys), optional, intent(in ) :: nwfa2d(:)
real(kind_phys), optional, intent(in ) :: nifa2d(:)
! State variables and timestep information
real(kind_phys), intent(inout) :: tgrs(1:ncol,1:nlev)
real(kind_phys), intent(in ) :: prsl(1:ncol,1:nlev)
Expand Down Expand Up @@ -359,7 +359,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, &
ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde, &
ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme, &
its=its, ite=ite, jts=jts, jte=jte, kts=kts, kte=kte, &
errmsg=errmsg, errflg=errflg)
errmsg=errmsg, errflg=errflg, reset=reset, kdt=kdt)

else
call mp_gt_driver(qv=qv_mp, qc=qc_mp, qr=qr_mp, qi=qi_mp, qs=qs_mp, qg=qg_mp, &
Expand All @@ -376,7 +376,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, &
ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde, &
ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme, &
its=its, ite=ite, jts=jts, jte=jte, kts=kts, kte=kte, &
errmsg=errmsg, errflg=errflg)
errmsg=errmsg, errflg=errflg, reset=reset, kdt=kdt)
end if
if (errflg/=0) return

Expand Down
16 changes: 16 additions & 0 deletions physics/mp_thompson.meta
View file
Original file line number Diff line number Diff line change
Expand Up @@ -147,6 +147,14 @@
type = integer
intent = in
optional = F
[kdt]
standard_name = index_of_time_step
long_name = current forecast iteration
units = index
dimensions = ()
type = integer
intent = in
optional = F
[con_g]
standard_name = gravitational_acceleration
long_name = gravitational acceleration
Expand Down Expand Up @@ -398,6 +406,14 @@
kind = kind_phys
intent = out
optional = F
[reset]
standard_name = flag_for_resetting_radar_reflectivity_calculation
long_name = flag for resetting radar reflectivity calculation
units = flag
dimensions = ()
type = logical
intent = in
optional = F
[do_radar_ref]
standard_name = flag_for_radar_reflectivity
long_name = flag for radar reflectivity
Expand Down
10 changes: 5 additions & 5 deletions physics/mp_thompson_pre.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -53,11 +53,11 @@ subroutine mp_thompson_pre_run(ncol, nlev, kdt, con_g, con_rd, &
real(kind_phys), intent(inout) :: nr(1:ncol,1:nlev)
! Aerosols
logical, intent(in ) :: is_aerosol_aware
real(kind_phys), optional, intent(inout) :: nc(1:ncol,1:nlev)
real(kind_phys), optional, intent(inout) :: nwfa(1:ncol,1:nlev)
real(kind_phys), optional, intent(inout) :: nifa(1:ncol,1:nlev)
real(kind_phys), optional, intent(inout) :: nwfa2d(1:ncol)
real(kind_phys), optional, intent(inout) :: nifa2d(1:ncol)
real(kind_phys), optional, intent(inout) :: nc(:,:)
real(kind_phys), optional, intent(inout) :: nwfa(:,:)
real(kind_phys), optional, intent(inout) :: nifa(:,:)
real(kind_phys), optional, intent(inout) :: nwfa2d(:)
real(kind_phys), optional, intent(inout) :: nifa2d(:)
! State variables and timestep information
real(kind_phys), intent(in ) :: tgrs(1:ncol,1:nlev)
real(kind_phys), intent( out) :: tgrs_save(1:ncol,1:nlev)
Expand Down

0 comments on commit d979604

Please sign in to comment.