Skip to content

Restrict undefined grids from UPP computation Part 3 #348

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

Merged
WenMeng-NOAA merged 14 commits into from
Aug 23, 2021
Merged

Restrict undefined grids from UPP computation Part 3 #348

Show file tree
Hide file tree
Changes from 9 commits
Commits
Show all changes
14 commits
Select commit Hold shift + click to select a range
c22aa56
Modify the computation at defined points.
WenMeng-NOAA Jul 15, 2021
b780f9f
The second part of changes from debug mode.
WenMeng-NOAA Jul 26, 2021
d6301e4
The third part of changes from debug_mode.
WenMeng-NOAA Jul 26, 2021
0de46a5
The fourth part of changes from debug_mode.
WenMeng-NOAA Jul 27, 2021
4cf1e3d
Merge remote-tracking branch 'upstream/develop' into post_bndlyr
WenMeng-NOAA Jul 28, 2021
087253e
The fifth part of changes from debug_mode.
WenMeng-NOAA Jul 29, 2021
e858d08
Merge branch 'NOAA-EMC:develop' into post_bndlyr
WenMeng-NOAA Aug 6, 2021
74795c0
Merge remote-tracking branch 'upstream/develop' into post_bndlyr
WenMeng-NOAA Aug 11, 2021
782baea
Update per comments from code reviewer.
WenMeng-NOAA Aug 11, 2021
275a6c2
Remove legacy sigma level temperature from PRSLEV dataset.
WenMeng-NOAA Aug 19, 2021
4e29797
Fix MCONV computation on undefined grids.
WenMeng-NOAA Aug 20, 2021
b115f57
Fixes for global and regional inline post in debug mode.
WenMeng-NOAA Aug 20, 2021
4437e98
Update VERSION to 10.0.9.
WenMeng-NOAA Aug 22, 2021
da40ba9
Remove duplicated line.
WenMeng-NOAA Aug 23, 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
24 changes: 19 additions & 5 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 @@ -46,7 +46,7 @@ SUBROUTINE ALLOCATE_ALL()
integer ierr,jsx,jex
integer i,j,l,k
! Allocate arrays
allocate(u(im,jsta_2l:jend_2u,lm))
allocate(u(im+1,jsta_2l:jend_2u,lm))
Comment thread
WenMeng-NOAA marked this conversation as resolved.
allocate(v(im,jsta_2l:jvend_2u,lm))
allocate(t(im,jsta_2l:jend_2u,lm))
! CHUANG ADD POTENTIAL TEMP BECAUSE WRF OUTPUT THETA
Expand Down Expand Up @@ -79,9 +79,23 @@ SUBROUTINE ALLOCATE_ALL()
!$omp parallel do private(i,j,l)
do l=1,lm
do j=jsta_2l,jend_2u
do i=1,im
do i=1,im+1
u(i,j,l)=0.
enddo
enddo
enddo
!$omp parallel do private(i,j,l)
do l=1,lm
do j=jsta_2l,jvend_2u
do i=1,im
v(i,j,l)=0.
enddo
enddo
enddo
!$omp parallel do private(i,j,l)
do l=1,lm
do j=jsta_2l,jend_2u
do i=1,im
t(i,j,l)=spval
q(i,j,l)=spval
uh(i,j,l)=spval
Expand Down Expand Up @@ -810,14 +824,14 @@ SUBROUTINE ALLOCATE_ALL()
cldfra(i,j)=spval
cprate(i,j)=spval
cnvcfr(i,j)=spval
ivgtyp(i,j)=spval
isltyp(i,j)=spval
ivgtyp(i,j)=0
isltyp(i,j)=0
hbotd(i,j)=spval
htopd(i,j)=spval
hbots(i,j)=spval
htops(i,j)=spval
cldefi(i,j)=spval
islope(i,j)=spval
islope(i,j)=0
si(i,j)=spval
lspa(i,j)=spval
rswinc(i,j)=spval
Expand Down
36 changes: 6 additions & 30 deletions sorc/ncep_post.fd/BNDLYR.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -32,6 +32,7 @@
!! 02-01-15 MIKE BALDWIN - WRF VERSION
!! 20-11-10 JESSE MENG - USE UPP_PHYSICS MODULE
!! 21-04-01 JESSE MENG - COMPUTATION ON DEFINED POINTS ONLY
!! 21-07-15 Wen Meng - Modify computation on defined points.
!!
!! USAGE: CALL BNDLYR(PBND,TBND,QBND,RHBND,UBND,VBND,
!! WBND,OMGBND,PWTBND,QCNVBND)
Expand Down Expand Up @@ -274,8 +275,6 @@ SUBROUTINE BNDLYR(PBND,TBND,QBND,RHBND,UBND,VBND, &
DO J=JSTA,JEND
DO I=1,IM
IF(PSUM(I,J,LBND)/=0.)THEN
IF(T(I,J,LBND)<spval.and.Q(I,J,LBND)<spval.and.&
UH(I,J,LBND)<spval.and.VH(I,J,LBND)<spval) THEN
RPSUM = 1./PSUM(I,J,LBND)
LVLBND(I,J,LBND)= LVLBND(I,J,LBND)/NSUM(I,J,LBND)
PBND(I,J,LBND) = (PBINT(I,J,LBND)+PBINT(I,J,LBND+1))*0.5
Expand All @@ -289,17 +288,6 @@ SUBROUTINE BNDLYR(PBND,TBND,QBND,RHBND,UBND,VBND, &
END IF
WBND(I,J,LBND) = WBND(I,J,LBND)*RPSUM
QCNVBND(I,J,LBND) = QCNVBND(I,J,LBND)*RPSUM
ELSE
LVLBND(I,J,LBND)= spval
PBND(I,J,LBND) = spval
TBND(I,J,LBND) = spval
QBND(I,J,LBND) = spval
OMGBND(I,J,LBND)= spval
UBND(I,J,LBND) = spval
VBND(I,J,LBND) = spval
WBND(I,J,LBND) = spval
QCNVBND(I,J,LBND)= spval
ENDIF
ENDIF
ENDDO
ENDDO
Expand All @@ -308,14 +296,9 @@ SUBROUTINE BNDLYR(PBND,TBND,QBND,RHBND,UBND,VBND, &
DO J=JSTA_M,JEND_M
DO I=2,IM-1
IF(PVSUM(I,J,LBND)/=0.)THEN
IF(UBND(I,J,LBND)<spval.and.VBND(I,J,LBND)<spval.and.PVSUM(I,J,LBND)<spval)THEN
RPVSUM = 1./PVSUM(I,J,LBND)
UBND(I,J,LBND) = UBND(I,J,LBND)*RPVSUM
VBND(I,J,LBND) = VBND(I,J,LBND)*RPVSUM
ELSE
UBND(I,J,LBND) = spval
VBND(I,J,LBND) = spval
ENDIF
ENDIF
ENDDO
ENDDO
Expand Down Expand Up @@ -355,8 +338,9 @@ SUBROUTINE BNDLYR(PBND,TBND,QBND,RHBND,UBND,VBND, &
VBND(I,J,LBND) = VH(I,J,L)
END IF
WBND(I,J,LBND) = WH(I,J,L)
IF(T(I,J,LBND)<spval.and.Q(I,J,LBND)<spval)THEN
QCNVBND(I,J,LBND) = QCNVG(I,J,L)
OMGBND(I,J,LBND) = OMGA(I,J,L)
IF(T(I,J,L)<spval.and.Q(I,J,L)<spval)THEN
IF(MODELNAME == 'GFS' .OR. MODELNAME == 'FV3R')THEN
ES = FPVSNEW(T(I,J,L))
ES = MIN(ES,PM)
Expand All @@ -365,19 +349,15 @@ SUBROUTINE BNDLYR(PBND,TBND,QBND,RHBND,UBND,VBND, &
QSAT=PQ0/PM*EXP(A2*(T(I,J,L)-A3)/(T(I,J,L)-A4))
END IF
QSBND(I,J,LBND) = QSAT
OMGBND(I,J,LBND) = OMGA(I,J,L)
PWTBND(I,J,LBND) = (Q(I,J,L)+CWM(I,J,L))*DP*GI
ELSE
QCNVBND(I,J,LBND)= spval
QSBND(I,J,LBND) = spval
OMGBND(I,J,LBND) = spval
PWTBND(I,J,LBND) = spval
ENDIF
QSBND(I,J,LBND)=spval
PWTBND(I,J,LBND)=spval
ENDIF
ENDIF !end PSUM(I,J,LBND)==0
!
! RH, BOUNDS CHECK
!
IF(T(I,J,LBND)<spval.and.Q(I,J,LBND)<spval)THEN
RHBND(I,J,LBND) = QBND(I,J,LBND)/QSBND(I,J,LBND)
IF (RHBND(I,J,LBND)>1.0) THEN
RHBND(I,J,LBND) = 1.0
Expand All @@ -387,10 +367,6 @@ SUBROUTINE BNDLYR(PBND,TBND,QBND,RHBND,UBND,VBND, &
RHBND(I,J,LBND) = 0.01
QBND(I,J,LBND) = RHBND(I,J,LBND)*QSBND(I,J,LBND)
ENDIF
ELSE
RHBND(I,J,LBND) = spval
QBND(I,J,LBND) = spval
ENDIF
ENDDO
ENDDO
!
Expand Down
7 changes: 6 additions & 1 deletion sorc/ncep_post.fd/CALDWP.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -12,6 +12,7 @@
!! AMBIENT TEMPERATURE.
!! 98-06-08 T BLACK - CONVERSION FROM 1-D TO 2-D
!! 00-01-04 JIM TUCCILLO - MPI VERSION
!! 21-07-23 Wen Meng - Retrict computation from undefined points
!!
!! USAGE: CALL CALDWP(P1D,Q1D,TDWP,T1D)
!! INPUT ARGUMENT LIST:
Expand Down Expand Up @@ -42,7 +43,7 @@ SUBROUTINE CALDWP(P1D,Q1D,TDWP,T1D)
!
! SET PARAMETERS.
use params_mod, only: eps, oneps, d001, h1m12
use ctlblk_mod, only: jsta, jend, im
use ctlblk_mod, only: jsta, jend, im, spval
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
implicit none
!
Expand All @@ -62,8 +63,12 @@ SUBROUTINE CALDWP(P1D,Q1D,TDWP,T1D)
!$omp parallel do private(i,j)
DO J=JSTA,JEND
DO I=1,IM
IF(P1D(I,j)<spval .and. Q1D(I,J)<spval) THEN
EVP(I,J) = P1D(I,J)*Q1D(I,J)/(EPS+ONEPS*Q1D(I,J))
EVP(I,J) = MAX(H1M12,EVP(I,J)*D001)
ELSE
EVP(I,J) = spval
ENDIF
ENDDO
ENDDO
!
Expand Down
3 changes: 3 additions & 0 deletions sorc/ncep_post.fd/CALLCL.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -19,6 +19,7 @@
!! 00-01-04 JIM TUCCILLO - MPI VERSION
!! 02-04-24 MIKE BALDWIN - WRF VERSION
!! 19-10-30 Bo CUI - REMOVE "GOTO" STATEMENT
!! 21-07-28 W Meng - Restriction compuatation from undefined grids
!!
!! USAGE: CALL CALLCL(P1D,T1D,Q1D,PLCL,ZLCL)
!! INPUT ARGUMENT LIST:
Expand Down Expand Up @@ -88,6 +89,7 @@ SUBROUTINE CALLCL(P1D,T1D,Q1D,PLCL,ZLCL)
DO 30 J=JSTA_M,JEND_M
DO 30 I=2,IM-1
! DO 30 I=1,IM
IF(P1D(I,J)<spval.and.Q1D(I,J)<spval)THEN
EVP = P1D(I,J)*Q1D(I,J)/(EPS+ONEPS*Q1D(I,J))
RMX = EPS*EVP/(P1D(I,J)-EVP)
RKAPA = 1.0 / (D2845*(1.0-D28*RMX))
Expand All @@ -107,6 +109,7 @@ SUBROUTINE CALLCL(P1D,T1D,Q1D,PLCL,ZLCL)
EXIT
ENDIF
20 CONTINUE
ENDIF
30 CONTINUE
!
! END OF ROUTINE.
Expand Down
7 changes: 7 additions & 0 deletions sorc/ncep_post.fd/CALTAU.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -17,6 +17,7 @@
!! 02-01-15 MIKE BALDWIN - WRF VERSION, OUTPUT IS ON MASS-POINTS
!! 05-02-23 H CHUANG - COMPUTE STRESS FOR NMM ON WIND POINTS
!! 05-07-07 BINBIN ZHOU - ADD RSM STRESS for A GRID
!! 21-07-26 W Meng - Restrict computation from undefined grids
!! USAGE: CALL CALTAU(TAUX,TAUY)
!! INPUT ARGUMENT LIST:
!! NONE
Expand Down Expand Up @@ -99,6 +100,8 @@ SUBROUTINE CALTAU(TAUX,TAUY)
DO I=1,IM
!
LMHK = NINT(LMH(I,J))
IF(EL(I,J,LMHK-1)<spval.and.Z0(I,J)<spval.and. &
UZ0(I,J)<spval.and.VZ0(I,J)<spval)THEN
!
! COMPUTE THICKNESS OF LAYER AT MASS POINT.
!
Expand Down Expand Up @@ -128,6 +131,10 @@ SUBROUTINE CALTAU(TAUX,TAUY)
ELSQR = EL(I,J,LMHK-1)*EL(I,J,LMHK-1)
TAUX(I,J) = RHO*ELSQR*DELUDZ*DELUDZ
TAUY(I,J) = RHO*ELSQR*DELVDZ*DELVDZ
ELSE
TAUX(I,J) = spval
TAUY(I,J) = spval
ENDIF

!
END DO
Expand Down
5 changes: 4 additions & 1 deletion sorc/ncep_post.fd/CALTHTE.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -12,6 +12,7 @@
!! 93-06-18 RUSS TREADON
!! 98-06-16 T BLACK - CONVERSION FROM 1-D TO 2-D
!! 00-01-04 JIM TUCCILLO - MPI VERSION
!! 21-07-28 W Meng - Restrict computation from undefined grids
!!
!! USAGE: CALL CALTHTE(P1D,T1D,Q1D,THTE)
!! INPUT ARGUMENT LIST:
Expand Down Expand Up @@ -40,7 +41,7 @@ SUBROUTINE CALTHTE(P1D,T1D,Q1D,THTE)
!
!
use params_mod, only: d00, eps, oneps, d01, h1m12, p1000, h1
use ctlblk_mod, only: jsta, jend, im
use ctlblk_mod, only: jsta, jend, im, spval
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
implicit none
!
Expand Down Expand Up @@ -77,6 +78,7 @@ SUBROUTINE CALTHTE(P1D,T1D,Q1D,THTE)
!$omp parallel do private(i,j,p,t,q,evp,rmx,ckapa,rkapa,arg,denom,tlcl,plcl,fac,eterm,thetae)
DO J=JSTA,JEND
DO I=1,IM
IF(P1D(I,J)<spval.and.T1D(I,J)<spval.and.Q1D(I,J)<spval)THEN
P = P1D(I,J)
T = T1D(I,J)
Q = Q1D(I,J)
Expand All @@ -92,6 +94,7 @@ SUBROUTINE CALTHTE(P1D,T1D,Q1D,THTE)
ETERM = (D3376/TLCL-D00254)*(RMX*KG2G*(H1+D81*RMX))
THETAE = T*FAC*EXP(ETERM)
THTE(I,J)= THETAE
ENDIF
ENDDO
ENDDO
!
Expand Down
3 changes: 3 additions & 0 deletions sorc/ncep_post.fd/CALWXT.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -9,6 +9,7 @@ SUBROUTINE CALWXT_POST(T,Q,PMID,PINT,HTM,LMH,PREC,ZINT,IWX,ZWET)
! 02-01-15 MIKE BALDWIN - WRF VERSION
! 05-07-07 BINBIN ZHOU - ADD PREC FOR RSM
! 19-10-30 Bo CUI - REMOVE "GOTO" STATEMENT
! 21-07-26 Wen Meng - Restrict computation from undefined grids
!
!
! ROUTINE TO COMPUTE PRECIPITATION TYPE USING A DECISION TREE
Expand Down Expand Up @@ -130,12 +131,14 @@ SUBROUTINE CALWXT_POST(T,Q,PMID,PINT,HTM,LMH,PREC,ZINT,IWX,ZWET)
! AND 500 MB
!
IF (PKL<50000.0.OR.PKL>PSFCK-7000.0) CYCLE
IF(QKL<spval)THEN
A=ALOG(QKL*PKL/(610.78*(0.378*QKL+0.622)))
TDKL=(237.3*A)/(17.269-A)+273.15
TDPRE=TKL-TDKL
IF (TDPRE<TDCHK.AND.TKL<TCOLD(I,J)) TCOLD(I,J)=TKL
IF (TDPRE<TDCHK.AND.TKL>TWARM(I,J)) TWARM(I,J)=TKL
IF (TDPRE<TDCHK.AND.L<LICEE(I,J)) LICEE(I,J)=L
ENDIF
775 CONTINUE
!
! IF NO SAT LAYER AT DEW POINT DEP=TDCHK, INCREASE TDCHK
Expand Down
4 changes: 3 additions & 1 deletion sorc/ncep_post.fd/CALWXT_REVISED.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -27,7 +27,7 @@ SUBROUTINE CALWXT_REVISED_POST(T,Q,PMID,PINT,HTM,LMH,PREC,ZINT,IWX)
!
use params_mod, only: h1m12, d00, d608, h1, rog
use ctlblk_mod, only: jsta, jend, modelname, pthresh, im, jsta_2l, jend_2u, lm,&
lp1
lp1, spval
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
implicit none
!
Expand Down Expand Up @@ -121,12 +121,14 @@ SUBROUTINE CALWXT_REVISED_POST(T,Q,PMID,PINT,HTM,LMH,PREC,ZINT,IWX)
! AND 500 MB
!
IF (PKL<50000.0.OR.PKL>PSFCK-7000.0) cycle
IF(QKL<spval)THEN
A=ALOG(QKL*PKL/(610.78*(0.378*QKL+0.622)))
TDKL=(237.3*A)/(17.269-A)+273.15
TDPRE=TKL-TDKL
IF (TDPRE<TDCHK.AND.TKL<TCOLD(I,J)) TCOLD(I,J)=TKL
IF (TDPRE<TDCHK.AND.TKL>TWARM(I,J)) TWARM(I,J)=TKL
IF (TDPRE<TDCHK.AND.L<LICEE(I,J)) LICEE(I,J)=L
ENDIF
775 CONTINUE
!
! IF NO SAT LAYER AT DEW POINT DEP=TDCHK, INCREASE TDCHK
Expand Down
3 changes: 3 additions & 0 deletions sorc/ncep_post.fd/CLDRAD.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2732,10 +2732,13 @@ SUBROUTINE CLDRAD
! qqi(i,j,k)=qqw(i,j,k) ! because GFS only uses cloud water
! qqw(i,j,k)=0.
! end if
if(pint(i,j,k)<spval.and.qqw(i,j,k)<spval.and. &
Comment thread
WenMeng-NOAA marked this conversation as resolved.
qqi(i,j,k)<spval.and.qqs(i,j,k)<spval)then
dp=pint(i,j,k+1)-pint(i,j,k)
opdepth=opdepth+( CU_ir(k) + abscoef*qqw(i,j,k)+ &
!bsf - end
& abscoefi*( qqi(i,j,k)+qqs(i,j,k) ) )*dp
endif
if (opdepth > 1.) exit
enddo
if (opdepth > 1.) num_thick=num_thick+1 ! for debug
Expand Down
7 changes: 6 additions & 1 deletion sorc/ncep_post.fd/CLMAX.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -7,6 +7,7 @@ SUBROUTINE CLMAX(EL0,SQZ,SQ,RQ2L,RQ2H)
! EXTRACTED FROM EXISTING CODE BY L. LOBOCKI, JULY 28, 1992
! 01-10-22 H CHUANG - MODIFIED TO PROCESS HYBRID MODEL OUTPUT
! 02-06-19 MIKE BALDWIN - WRF VERSION
! 21-07-26 W Meng - Restrict computation from undefined grids
!
! INPUT:
! ------
Expand Down Expand Up @@ -41,7 +42,7 @@ SUBROUTINE CLMAX(EL0,SQZ,SQ,RQ2L,RQ2H)
! use vrbls2d, only:
use masks, only: lmh, sm
use params_mod, only: EPSQ2
use ctlblk_mod, only: jsta, jend, lm, im
use ctlblk_mod, only: jsta, jend, lm, im, spval
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
implicit none
!
Expand Down Expand Up @@ -121,9 +122,13 @@ SUBROUTINE CLMAX(EL0,SQZ,SQ,RQ2L,RQ2H)
!$omp parallel do
DO J=JSTA,JEND
DO I=1,IM
IF(HGT(I,J)<spval)THEN
EL0(I,J)= MAX(MIN( &
& ((SM(I,J)*ALPHAS+(1.0-SM(I,J))*ALPHAL)*SQZ(I,J) &
& /(SQ(I,J)+EPSQ2)),EL0M),ELMIN)
ELSE
EL0(I,J)= spval
ENDIF
ENDDO
ENDDO
!
Expand Down
7 changes: 6 additions & 1 deletion sorc/ncep_post.fd/DEWPOINT.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -36,6 +36,7 @@
!! TABLE.
!! - 98-06-12 T BLACK - CONVERSION FROM 1-D TO 2-D
!! - 00-01-04 JIM TUCCILLO - MPI VERSION
!! - 21-07-26 W Meng - Restrict computation from undefined grids
!!
!! USAGE: CALL DEWPOINT( VP, TD)
!! INPUT ARGUMENT LIST:
Expand All @@ -46,7 +47,7 @@
!!
SUBROUTINE DEWPOINT( VP, TD)

use ctlblk_mod, only: jsta, jend, im
use ctlblk_mod, only: jsta, jend, im, spval
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
implicit none
!
Expand Down Expand Up @@ -132,10 +133,14 @@ SUBROUTINE DEWPOINT( VP, TD)
!$omp parallel do private(i,j,w1,w2,jnt)
DO J=JSTA,JEND
DO I=1,IM
IF(VP(I,J)<spval)THEN
W1 = MIN(MAX((A*VP(I,J)+B),1.0),DNTM1)
W2 = AINT(W1)
JNT = INT(W2)
TD(I,J) = TDP(JNT) + (W1-W2)*(TDP(JNT+1)-TDP(JNT))
ELSE
TD(I,J) = spval
ENDIF
ENDDO
ENDDO
!
Expand Down
Loading