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

UPP refactor phase 2 from Bo Cui #233

Merged
merged 4 commits into from
Dec 15, 2020
Merged

UPP refactor phase 2 from Bo Cui #233

Show file tree
Hide file tree
Changes from 3 commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
6ce45e6
20201123 BoCui:Add "implicit none"/Modernize inequality statements
BoCui-NOAA Nov 23, 2020
2545129
sync file CALRAD_WCLOUD_newcrtm.f from EMC_post/develop
BoCui-NOAA Dec 3, 2020
c251756
Merge branch 'develop' into upp_refactor_p2_bc
BoCui-NOAA Dec 3, 2020
b27510f
Merge pull request #2 from BoCui-NOAA/develop
BoCui-NOAA Dec 11, 2020
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
26 changes: 13 additions & 13 deletions sorc/ncep_post.fd/AVIATION.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -104,11 +104,11 @@ SUBROUTINE CALLLWS(U,V,H,LLWS)

Z1 = 10.0 + FIS(I,J)*GI !Height of 10m levels geographic height (from sea level)

IF(Z1.LT.H(I,J,LSM)) THEN !First search location of 10m wind level
IF(Z1<H(I,J,LSM)) THEN !First search location of 10m wind level
K1 = LSM + 1 !to see it is in which pressure levels
ELSE
DO LP = LSM,2,-1 !If not found, keep searching upward
IF(Z1.GE.H(I,J,LP).AND.Z1.LT.H(I,J,LP-1)) THEN
IF(Z1>=H(I,J,LP).AND.Z1<H(I,J,LP-1)) THEN
K1 = LP
END IF
END DO
Expand All @@ -118,14 +118,14 @@ SUBROUTINE CALLLWS(U,V,H,LLWS)

DH = 0.0

IF((HZ1+10).GT.609.6) THEN !Then, search 2000ft(609.6m) location
IF((HZ1+10)>609.6) THEN !Then, search 2000ft(609.6m) location
U2= U10(I,J) + (U(I,J,K1-1)-U10(I,J))*599.6/HZ1 !found it between K1-1 and K1, then linear
V2= V10(I,J) + (V(I,J,K1-1)-V10(I,J))*599.6/HZ1 !interpolate to get wind at 2000ft U2,V2
Z2= FIS(I,J)*GI + 609.6
ELSE !otherwise, keep on search upward
DO LP = K1-1,2,-1
DH=DH+(H(I,J,LP-1) - H(I,J,LP))
IF((DH+HZ1+10).gt.609.6) THEN !found the 2000ft level
IF((DH+HZ1+10)>609.6) THEN !found the 2000ft level
Z2=FIS(I,J)*GI+609.6
RT=(Z2-H(I,J,LP))/(H(I,J,LP-1)-H(I,J,LP))
U2=U(I,J,LP)+RT*(U(I,J,LP-1)-U(I,J,LP))
Expand Down Expand Up @@ -398,11 +398,11 @@ SUBROUTINE CALCAT(U,V,H,U_OLD,V_OLD,H_OLD,CAT)

TRBINDX = ABS(VWS)*(DEF + ABS(CVG))

IF(TRBINDX.LE.4.) THEN
IF(TRBINDX<=4.) THEN
CAT(I,J) = 0.0
ELSE IF(TRBINDX.LE.8.) THEN
ELSE IF(TRBINDX<=8.) THEN
CAT(I,J)=1.0
ELSE IF(TRBINDX.LE.12.) THEN
ELSE IF(TRBINDX<=12.) THEN
CAT(I,J)=2.0
ELSE
CAT(I,J)=3.0
Expand Down Expand Up @@ -546,18 +546,18 @@ SUBROUTINE CALFLTCND (CEILING,FLTCND)
CEIL = CEILING(I,J) * 3.2808 !from m -> feet
VISI = VIS(I,J) / 1609.0 !from m -> miles

IF(CEIL.LT.500.0 .OR. VISI.LT.1.0 ) THEN
IF(CEIL<500.0 .OR. VISI<1.0 ) THEN
FLTCND(I,J) = 1.0

ELSE IF( (CEIL.GE.500.AND.CEIL.LT.1000.0) .OR. &
(VISI.GE.1.0.AND.VISI.LT.3.0) ) THEN
ELSE IF( (CEIL>=500.AND.CEIL<1000.0) .OR. &
(VISI>=1.0.AND.VISI<3.0) ) THEN
FLTCND(I,J) = 2.0

ELSE IF( (CEIL.GE.1000.AND.CEIL.LE.3000.0) .OR. &
(VISI.GE.3.0.AND.VISI.LE.5.0) ) THEN
ELSE IF( (CEIL>=1000.AND.CEIL<=3000.0) .OR. &
(VISI>=3.0.AND.VISI<=5.0) ) THEN
FLTCND(I,J) = 3.0

ELSE IF( CEIL.GT.3000.0 .OR. VISI.GT.5.0) THEN
ELSE IF( CEIL>3000.0 .OR. VISI>5.0) THEN
FLTCND(I,J) = 4.0

END IF
Expand Down
2 changes: 1 addition & 1 deletion sorc/ncep_post.fd/AllGETHERV_GSD.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -45,7 +45,7 @@ SUBROUTINE AllGETHERV(GRID1)
ibufsend(ij)=GRID1(i,j)
enddo
enddo
if(ij .ne. RECVCOUNTS(me+1)) then
if(ij /= RECVCOUNTS(me+1)) then
write(*,*) 'Error: send account is not equal to receive account',me,ij,RECVCOUNTS(me+1)
endif

Expand Down
28 changes: 14 additions & 14 deletions sorc/ncep_post.fd/BNDLYR.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -224,8 +224,8 @@ SUBROUTINE BNDLYR(PBND,TBND,QBND,RHBND,UBND,VBND, &
+PINT(I,J+1,L+1) + PINT(I,J-1,L+1))
DP = PV2-PV1
PMV = 0.5*(PV1+PV2)
IF((PBINT(IW,J,LBND).GE.PMV).AND. &
(PBINT(IW,J,LBND+1).LE.PMV)) THEN
IF((PBINT(IW,J,LBND)>=PMV).AND. &
(PBINT(IW,J,LBND+1)<=PMV)) THEN
PVSUM(I,J,LBND) = PVSUM(I,J,LBND) + DP
UBND(I,J,LBND) = UBND(I,J,LBND) + DP* UH(I,J,L)
VBND(I,J,LBND) = VBND(I,J,LBND) + DP*VH(I,J,L)
Expand All @@ -249,8 +249,8 @@ SUBROUTINE BNDLYR(PBND,TBND,QBND,RHBND,UBND,VBND, &
+PINT(IW,J+1,L+1) + PINT(IE,J+1,L+1))
DP = PV2-PV1
PMV = 0.5*(PV1+PV2)
IF((PBINT(IW,J,LBND).GE.PMV).AND. &
(PBINT(IW,J,LBND+1).LE.PMV)) THEN
IF((PBINT(IW,J,LBND)>=PMV).AND. &
(PBINT(IW,J,LBND+1)<=PMV)) THEN
PVSUM(I,J,LBND) = PVSUM(I,J,LBND)+DP
UBND(I,J,LBND) = UBND(I,J,LBND)+UH(I,J,L)*DP
VBND(I,J,LBND) = VBND(I,J,LBND)+VH(I,J,L)*DP
Expand All @@ -268,7 +268,7 @@ SUBROUTINE BNDLYR(PBND,TBND,QBND,RHBND,UBND,VBND, &
DO LBND=1,NBND
DO J=JSTA,JEND
DO I=1,IM
IF(PSUM(I,J,LBND).NE.0.)THEN
IF(PSUM(I,J,LBND)/=0.)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,7 +289,7 @@ SUBROUTINE BNDLYR(PBND,TBND,QBND,RHBND,UBND,VBND, &
IF(gridtype=='E' .or. gridtype=='B')THEN
DO J=JSTA_M,JEND_M
DO I=2,IM-1
IF(PVSUM(I,J,LBND).NE.0.)THEN
IF(PVSUM(I,J,LBND)/=0.)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
Expand All @@ -307,15 +307,15 @@ SUBROUTINE BNDLYR(PBND,TBND,QBND,RHBND,UBND,VBND, &
DO LBND=1,NBND
DO J=JSTA,JEND
DO I=1,IM
IF(PSUM(I,J,LBND).EQ.0.)THEN
IF(PSUM(I,J,LBND)==0.)THEN
L = LM
PMIN = 9999999.
PBND(I,J,LBND) = (PBINT(I,J,LBND)+PBINT(I,J,LBND+1))*0.5
!
DO LL=1,LM
PM = PMID(I,J,LL)
DELP = ABS(PM-PBND(I,J,LBND))
IF(DELP.LT.PMIN)THEN
IF(DELP<PMIN)THEN
PMIN = DELP
L = LL
ENDIF
Expand Down Expand Up @@ -347,11 +347,11 @@ SUBROUTINE BNDLYR(PBND,TBND,QBND,RHBND,UBND,VBND, &
! RH, BOUNDS CHECK
!
RHBND(I,J,LBND) = QBND(I,J,LBND)/QSBND(I,J,LBND)
IF (RHBND(I,J,LBND).GT.1.0) THEN
IF (RHBND(I,J,LBND)>1.0) THEN
RHBND(I,J,LBND) = 1.0
QBND(I,J,LBND) = RHBND(I,J,LBND)*QSBND(I,J,LBND)
ENDIF
IF (RHBND(I,J,LBND).LT.0.01) THEN
IF (RHBND(I,J,LBND)<0.01) THEN
RHBND(I,J,LBND) = 0.01
QBND(I,J,LBND) = RHBND(I,J,LBND)*QSBND(I,J,LBND)
ENDIF
Expand All @@ -361,7 +361,7 @@ SUBROUTINE BNDLYR(PBND,TBND,QBND,RHBND,UBND,VBND, &
IF(gridtype == 'E')THEN
DO J=JSTA_M,JEND_M
DO I=2,IM-1
IF(PVSUM(I,J,LBND).EQ.0.)THEN
IF(PVSUM(I,J,LBND)==0.)THEN
LV = LM
PMINV = 9999999.
IE = I+MOD(J,2)
Expand All @@ -375,7 +375,7 @@ SUBROUTINE BNDLYR(PBND,TBND,QBND,RHBND,UBND,VBND, &
PINT(IW,J,LL+1) + PINT(IE,J,LL+1) + &
PINT(I,J+1,LL+1) + PINT(I,J-1,LL+1))
DELPV = ABS(PMV-PBND(I,J,LBND))
IF(DELPV.LT.PMINV)THEN
IF(DELPV<PMINV)THEN
PMINV = DELPV
LV = LL
ENDIF
Expand All @@ -391,7 +391,7 @@ SUBROUTINE BNDLYR(PBND,TBND,QBND,RHBND,UBND,VBND, &
ELSE IF(gridtype=='B')THEN
DO J=JSTA_M,JEND_M
DO I=2,IM-1
IF(PVSUM(I,J,LBND).EQ.0.)THEN
IF(PVSUM(I,J,LBND)==0.)THEN
LV=LM
PMINV=9999999.
IE=I+1
Expand All @@ -405,7 +405,7 @@ SUBROUTINE BNDLYR(PBND,TBND,QBND,RHBND,UBND,VBND, &
PINT(IW,J,LL+1)+PINT(IE,J,LL+1)+ &
PINT(IW,J+1,LL+1)+PINT(IE,J+1,LL+1))
DELPV=ABS(PMV-PBND(I,J,LBND))
IF(DELPV.LT.PMINV)THEN
IF(DELPV<PMINV)THEN
PMINV=DELPV
LV=LL
ENDIF
Expand Down
4 changes: 2 additions & 2 deletions sorc/ncep_post.fd/CALCAPE.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -224,7 +224,7 @@ SUBROUTINE CALCAPE(ITYPE,DPBND,P1D,T1D,Q1D,L1D,CAPE, &
!--------------TRIAL MAXIMUM BUOYANCY LEVEL VARIABLES-------------------

DO KB=1,LM
!hc IF (ITYPE.EQ.2.AND.KB.GT.1) cycle
!hc IF (ITYPE==2.AND.KB>1) cycle
IF (ITYPE == 1 .OR. (ITYPE == 2 .AND. KB == 1)) THEN

!$omp parallel do private(i,j,apebtk,apespk,bqk,bqs00k,bqs10k,iq,ittbk, &
Expand All @@ -235,7 +235,7 @@ SUBROUTINE CALCAPE(ITYPE,DPBND,P1D,T1D,Q1D,L1D,CAPE, &
PSFCK = PMID(I,J,NINT(LMH(I,J)))
PKL = PMID(I,J,KB)

!hc IF (ITYPE.EQ.1.AND.(PKL.LT.PSFCK-DPBND.OR.PKL.GT.PSFCK)) cycle
!hc IF (ITYPE==1.AND.(PKL<PSFCK-DPBND.OR.PKL>PSFCK)) cycle
IF (ITYPE ==2 .OR. &
(ITYPE == 1 .AND. (PKL >= PSFCK-DPBND .AND. PKL <= PSFCK)))THEN
IF (ITYPE == 1) THEN
Expand Down
8 changes: 4 additions & 4 deletions sorc/ncep_post.fd/CALCAPE2.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -311,7 +311,7 @@ SUBROUTINE CALCAPE2(ITYPE,DPBND,P1D,T1D,Q1D,L1D, &
!--------------TRIAL MAXIMUM BUOYANCY LEVEL VARIABLES-------------------

DO KB=1,LM
!hc IF (ITYPE.EQ.2.AND.KB.GT.1) cycle
!hc IF (ITYPE==2.AND.KB>1) cycle
IF (ITYPE == 1 .OR. (ITYPE == 2 .AND. KB == 1)) THEN

!$omp parallel do private(i,j,apebtk,apespk,bqk,bqs00k,bqs10k,iq,ittbk, &
Expand All @@ -322,7 +322,7 @@ SUBROUTINE CALCAPE2(ITYPE,DPBND,P1D,T1D,Q1D,L1D, &
PSFCK = PMID(I,J,NINT(LMH(I,J)))
PKL = PMID(I,J,KB)

!hc IF (ITYPE.EQ.1.AND.(PKL.LT.PSFCK-DPBND.OR.PKL.GT.PSFCK)) cycle
!hc IF (ITYPE==1.AND.(PKL<PSFCK-DPBND.OR.PKL>PSFCK)) cycle
IF (ITYPE ==2 .OR. &
(ITYPE == 1 .AND. (PKL >= PSFCK-DPBND .AND. PKL <= PSFCK)))THEN
IF (ITYPE == 1) THEN
Expand Down Expand Up @@ -565,7 +565,7 @@ SUBROUTINE CALCAPE2(ITYPE,DPBND,P1D,T1D,Q1D,L1D, &
ENDIF

! LFC
IF (ITYPE .NE. 1) THEN
IF (ITYPE /= 1) THEN
PRESK2 = PMID(I,J,L+1)
ESATP2 = min(FPVSNEW(TPAR(I,J,L+1)),PRESK2)
QSATP2 = EPS*ESATP2/(PRESK2-ESATP2*ONEPS)
Expand Down Expand Up @@ -752,7 +752,7 @@ SUBROUTINE CALCAPE2(ITYPE,DPBND,P1D,T1D,Q1D,L1D, &
!$omp parallel do private(i,j)
DO J=JSTA,JEND
DO I=1,IM
IF(L12(I,J).NE.LM .AND. L17(I,J).NE.LM) THEN
IF(L12(I,J)/=LM .AND. L17(I,J)/=LM) THEN
DGLD(I,J)=ZINT(I,J,L17(I,J))-ZINT(I,J,L12(I,J))
DGLD(I,J)=MAX(DGLD(I,J),0.)
ENDIF
Expand Down
6 changes: 3 additions & 3 deletions sorc/ncep_post.fd/CALDRG.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -97,7 +97,7 @@ SUBROUTINE CALDRG(DRAGCO)
! COMPUTE A DRAG COEFFICIENT.
!
USTRSQ=USTAR(I,J)*USTAR(I,J)
IF(WSPDSQ .GT. 1.0) DRAGCO(I,J)=USTRSQ/WSPDSQ
IF(WSPDSQ > 1.0) DRAGCO(I,J)=USTRSQ/WSPDSQ

END IF
ENDDO
Expand Down Expand Up @@ -141,7 +141,7 @@ SUBROUTINE CALDRG(DRAGCO)
! COMPUTE A DRAG COEFFICIENT.
!
USTRSQ=USTAR(I,J)*USTAR(I,J)
IF(WSPDSQ .GT. 1.0E-6)DRAGCO(I,J)=USTRSQ/WSPDSQ
IF(WSPDSQ > 1.0E-6)DRAGCO(I,J)=USTRSQ/WSPDSQ
!
END DO
END DO
Expand Down Expand Up @@ -185,7 +185,7 @@ SUBROUTINE CALDRG(DRAGCO)
! COMPUTE A DRAG COEFFICIENT.
!
USTRSQ=USTAR(I,J)*USTAR(I,J)
IF(WSPDSQ .GT. 1.0E-6)DRAGCO(I,J)=USTRSQ/WSPDSQ
IF(WSPDSQ > 1.0E-6)DRAGCO(I,J)=USTRSQ/WSPDSQ
!
END DO
END DO
Expand Down
2 changes: 1 addition & 1 deletion sorc/ncep_post.fd/CALHEL.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -342,7 +342,7 @@ SUBROUTINE CALHEL(DEPTH,UST,VST,HELI,USHR1,VSHR1,USHR6,VSHR6)
VSHR6(I,J) = VMEAN5 - VMEAN1

DENOM = USHR6(I,J)*USHR6(I,J)+VSHR6(I,J)*VSHR6(I,J)
IF (DENOM .NE. 0.0) THEN
IF (DENOM /= 0.0) THEN
UST(I,J) = UMEAN6 + (7.5*VSHR6(I,J)/SQRT(DENOM))
VST(I,J) = VMEAN6 - (7.5*USHR6(I,J)/SQRT(DENOM))
ELSE
Expand Down
2 changes: 1 addition & 1 deletion sorc/ncep_post.fd/CALHEL2.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -354,7 +354,7 @@ SUBROUTINE CALHEL2(LLOW,LUPP,DEPTH,UST,VST,HELI,CANGLE)
VSHR6(I,J) = VMEAN5 - VMEAN1

DENOM = USHR6(I,J)*USHR6(I,J)+VSHR6(I,J)*VSHR6(I,J)
IF (DENOM .NE. 0.0) THEN
IF (DENOM /= 0.0) THEN
UST(I,J) = UMEAN6 + (7.5*VSHR6(I,J)/SQRT(DENOM))
VST(I,J) = VMEAN6 - (7.5*USHR6(I,J)/SQRT(DENOM))
ELSE
Expand Down
4 changes: 2 additions & 2 deletions sorc/ncep_post.fd/CALMCVG.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -95,8 +95,8 @@ SUBROUTINE CALMCVG(Q1D,U1D,V1D,QCNVG)
!$omp parallel do private(i,j,qudx,qvdy,r2dx,r2dy)
DO J=JSTA_M,JEND_M
DO I=2,IM-1
IF(VWND(I,J+1).LT.SPVAL.AND.VWND(I,J-1).LT.SPVAL.AND. &
UWND(I+1,J).LT.SPVAL.AND.UWND(I-1,J).LT.SPVAL) THEN
IF(VWND(I,J+1)<SPVAL.AND.VWND(I,J-1)<SPVAL.AND. &
UWND(I+1,J)<SPVAL.AND.UWND(I-1,J)<SPVAL) THEN
R2DX = 1./(2.*DX(I,J)) !MEB DX?
R2DY = 1./(2.*DY(I,J)) !MEB DY?
QUDX = (Q1D(I+1,J)*UWND(I+1,J)-Q1D(I-1,J)*UWND(I-1,J))*R2DX
Expand Down
Loading