Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Bug fix in initializing post fields and checking undefined points in visibility computation. #324

Merged
merged 2 commits into from
May 27, 2021
Merged

Bug fix in initializing post fields and checking undefined points in visibility computation. #324

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
4f2c1bf
Bug fix in ALLOCATE_ALL.f.
WenMeng-NOAA May 24, 2021
9b6d891
Add checking of unfined points in CALVIS_GSD.f and CALVIS.f.
WenMeng-NOAA May 27, 2021
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
14 changes: 7 additions & 7 deletions sorc/ncep_post.fd/ALLOCATE_ALL.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -79,7 +79,7 @@ SUBROUTINE ALLOCATE_ALL()
!$omp parallel do private(i,j,l)
do l=1,lm
do j=jsta_2l,jend_2u
do i=1,lm
do i=1,im
u(i,j,l)=0.
v(i,j,l)=0.
t(i,j,l)=spval
Expand Down Expand Up @@ -107,7 +107,7 @@ SUBROUTINE ALLOCATE_ALL()
!$omp parallel do private(i,j,l)
do l=1,lp1
do j=jsta_2l,jend_2u
do i=1,lm
do i=1,im
pint(i,j,l)=spval
alpint(i,j,l)=spval
zint(i,j,l)=spval
Expand Down Expand Up @@ -147,7 +147,7 @@ SUBROUTINE ALLOCATE_ALL()
!$omp parallel do private(i,j,l)
do l=1,lm
do j=jsta_2l,jend_2u
do i=1,lm
do i=1,im
cwm(i,j,l)=spval
F_ice(i,j,l)=spval
F_rain(i,j,l)=spval
Expand Down Expand Up @@ -195,7 +195,7 @@ SUBROUTINE ALLOCATE_ALL()
!$omp parallel do private(i,j,l)
do l=1,lm
do j=jsta_2l,jend_2u
do i=1,lm
do i=1,im
NRAIN(i,j,l)=spval
radius_cloud(i,j,l)=spval
radius_ice(i,j,l)=spval
Expand Down Expand Up @@ -1229,7 +1229,7 @@ SUBROUTINE ALLOCATE_ALL()
!Initialization
!$omp parallel do private(i,j)
do j=jsta_2l,jend_2u
do i=1,lm
do i=1,im
dusmass(i,j)=spval
ducmass(i,j)=spval
dusmass25(i,j)=spval
Expand Down Expand Up @@ -1271,7 +1271,7 @@ SUBROUTINE ALLOCATE_ALL()
!Initialization
!$omp parallel do private(i,j)
do j=jsta_2l,jend_2u
do i=1,lm
do i=1,im
acswupt(i,j)=spval
swdnt(i,j)=spval
acswdnt(i,j)=spval
Expand All @@ -1285,7 +1285,7 @@ SUBROUTINE ALLOCATE_ALL()
!Initialization
!$omp parallel do private(i,j)
do j=jsta_2l,jend_2u
do i=1,lm
do i=1,im
ddvdx(i,j)=spval
ddudy(i,j)=spval
uuavg(i,j)=spval
Expand Down
10 changes: 9 additions & 1 deletion sorc/ncep_post.fd/CALVIS.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -55,9 +55,11 @@ SUBROUTINE CALVIS(QV,QC,QR,QI,QS,TT,PP,VIS)
!
! vis = -ln(epsilon)/beta [found in Kunkel (1984)]
!
! 2021-05 Wen Meng -Add checking for undfined points invloved in
! computation.
!------------------------------------------------------------------
use params_mod, only: h1, d608, rd
use ctlblk_mod, only: jsta, jend, im, jsta_2l, jend_2u
use ctlblk_mod, only: jsta, jend, im, jsta_2l, jend_2u, spval
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
implicit none
!
Expand Down Expand Up @@ -89,6 +91,7 @@ SUBROUTINE CALVIS(QV,QC,QR,QI,QS,TT,PP,VIS)
!
DO J=JSTA,JEND
DO I=1,IM
VIS(I,J)=SPVAL
! IF(IICE==0)THEN
! QPRC=QR
! QCLD=QC
Expand All @@ -104,6 +107,10 @@ SUBROUTINE CALVIS(QV,QC,QR,QI,QS,TT,PP,VIS)
! QCLICE=0.
! ENDIF
! ELSE
IF (QR(I,J) < SPVAL .and. QS(I,J) < SPVAL .and. &
QC(I,J) < SPVAL .and. QI(I,J) < SPVAL .and. &
TT(I,J) < SPVAL .and. QV(I,J) < SPVAL .and. &
PP(I,J) < SPVAL) THEN
QPRC=QR(I,J)+QS(I,J)
QCLD=QC(I,J)+QI(I,J)
QRAIN=QR(I,J)
Expand Down Expand Up @@ -164,6 +171,7 @@ SUBROUTINE CALVIS(QV,QC,QR,QI,QS,TT,PP,VIS)
! VIS(I,J)=1.E3*MIN(20.,CONST1/BETAV) ! max of 20km
! Chuang: Per Geoff, the max visibility was changed to be cosistent with visibility ceiling in obs
VIS(I,J) = 1.E3*MIN(24.135,CONST1/BETAV) ! change max to be consistent with obs
ENDIF
ENDDO
ENDDO
!
Expand Down
19 changes: 13 additions & 6 deletions sorc/ncep_post.fd/CALVIS_GSD.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -88,13 +88,14 @@ SUBROUTINE CALVIS_GSD(CZEN,VIS)
! 2017-12 R. Ahmadov, Steve Albers - addition for attenuation from aerosols
! (not related to water vapor or RH at this point)
! 2021-05 Wen Meng Unify CONST1 and VISRH.
! 2021-05 Wen Meng - Add checking for undefined points invloved in computation
!
!------------------------------------------------------------------
!

use vrbls3d, only: qqw, qqi, qqs, qqr, qqg, t, pmid, q, u, v, extcof55, aextc55
use params_mod, only: h1, d608, rd
use ctlblk_mod, only: jm, im, jsta_2l, jend_2u, lm, modelname
use ctlblk_mod, only: jm, im, jsta_2l, jend_2u, lm, modelname, spval

implicit none

Expand Down Expand Up @@ -178,6 +179,7 @@ SUBROUTINE CALVIS_GSD(CZEN,VIS)

EXPONFg = 0.75
! CONST1=-LOG(.02)
! CONST1=3.912
CONST1= 3.000

! visibility with respect to RH is
Expand All @@ -201,6 +203,10 @@ SUBROUTINE CALVIS_GSD(CZEN,VIS)

DO J=jsta_2l,jend_2u
DO I=1,IM
VIS(I,J)=spval
WenMeng-NOAA marked this conversation as resolved.
Show resolved Hide resolved
! -checking undedined points
if(T(I,J,LM)<spval .and. U(I,J,LM)<spval .and. V(I,J,LM)<spval &
.and. PMID(I,J,LM)<spval) then
! - take max hydrometeor mixing ratios in lowest 3 levels (lowest 13 hPa, 100m with RAP/HRRR
qrain = 0.
qsnow = 0.
Expand All @@ -210,11 +216,11 @@ SUBROUTINE CALVIS_GSD(CZEN,VIS)

do k = 1,3
LL=LM-k+1
QCLW = max(qclw, QQW(I,J,ll) )
QCLICE = max(qclice, QQI(I,J,ll) )
Qsnow = max(qsnow, QQS(I,J,ll) )
Qrain = max(qrain, QQR(I,J,ll) )
Qgraupel = max(qgraupel, QQG(I,J,ll) )
if(QQW(I,J,ll)<spval)qclw = max(qclw, QQW(I,J,ll) )
if(QQI(I,J,ll)<spval)qclice = max(qclice, QQI(I,J,ll) )
if(QQS(I,J,ll)<spval)qsnow = max(qsnow, QQS(I,J,ll) )
if(QQR(I,J,ll)<spval)qrain = max(qrain, QQR(I,J,ll) )
if(QQG(I,J,ll)<spval)qgraupel = max(qgraupel, QQG(I,J,ll) )
! - compute relative humidity
Tx=T(I,J,LL)-273.15
POL = 0.99999683 + TX*(-0.90826951E-02 + &
Expand Down Expand Up @@ -336,6 +342,7 @@ SUBROUTINE CALVIS_GSD(CZEN,VIS)
! convert vis from km to [m]
vis(i,j) = vis(i,j) * 1000.

endif !end checking undefined points
ENDDO
ENDDO

Expand Down
18 changes: 6 additions & 12 deletions sorc/ncep_post.fd/MDLFLD.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -3144,7 +3144,8 @@ SUBROUTINE MDLFLD

! IF(MODELNAME/='GFS')THEN
IF(imp_physics/=99)THEN
IF (CPRATE(I,J) > 0. .and. CPRATE(I,J) < SPVAL) THEN
IF (CPRATE(I,J) > 0. .and. CPRATE(I,J) < SPVAL &
.and. PMID(I,J,LM) < spval .and. QR1(I,J) < spval) THEN
! IF (CUPPT(I,J) > 0.) THEN
RAINRATE=(1-SR(I,J))*CPRATE(I,J)*RDTPHS
! RAINRATE=(1-SR(I,J))*CUPPT(I,J)/(TRDLW*3600.)
Expand All @@ -3153,7 +3154,7 @@ SUBROUTINE MDLFLD
TERM3=RAINRATE**0.8333
QROLD=1.2*QR1(I,J)
QR1(I,J)=QR1(I,J)+RAINCON*TERM1*TERM2*TERM3
IF (SR(I,J) > 0.) THEN
IF (SR(I,J) > 0. .and. QS1(I,J) < SPVAL) THEN
SNORATE=SR(I,J)*CPRATE(I,J)*RDTPHS
! SNORATE=SR(I,J)*CUPPT(I,J)/(TRDLW*3600.)
TERM1=(T(I,J,LM)/PMID(I,J,LM))**0.47
Expand Down Expand Up @@ -3210,11 +3211,8 @@ SUBROUTINE MDLFLD
IF(abs(vis(i,j))>24135.1)print*,'bad visbility' &
, i,j,Q1D(i,j),QW1(i,j),QR1(i,j),QI1(i,j) &
, QS1(i,j),T1D(i,j),P1D(i,j),vis(i,j)
IF(Q1D(I,J)<spval.and.T1D(I,J)<spval.and.P1D(I,J)<spval)THEN
GRID1(I,J)=VIS(I,J)
ELSE
GRID1(I,J)=spval
ENDIF

GRID1(I,J)=VIS(I,J)
END DO
END DO
if(grib=="grib2") then
Expand All @@ -3232,11 +3230,7 @@ SUBROUTINE MDLFLD
CALL CALVIS_GSD(CZEN,VIS)
DO J=JSTA,JEND
DO I=1,IM
IF(Q1D(I,J)<spval.and.T1D(I,J)<spval.and.P1D(I,J)<spval)THEN
GRID1(I,J)=VIS(I,J)
ELSE
GRID1(I,J)=spval
ENDIF
GRID1(I,J)=VIS(I,J)
END DO
END DO
if(grib=="grib2") then
Expand Down