diff --git a/sorc/ncep_post.fd/AVIATION.f b/sorc/ncep_post.fd/AVIATION.f index 6a4b396f1..7c8219ec0 100644 --- a/sorc/ncep_post.fd/AVIATION.f +++ b/sorc/ncep_post.fd/AVIATION.f @@ -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,LP).AND.Z1609.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)) @@ -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 @@ -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 diff --git a/sorc/ncep_post.fd/AllGETHERV_GSD.f b/sorc/ncep_post.fd/AllGETHERV_GSD.f index 130d04c01..4aff19d37 100644 --- a/sorc/ncep_post.fd/AllGETHERV_GSD.f +++ b/sorc/ncep_post.fd/AllGETHERV_GSD.f @@ -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 diff --git a/sorc/ncep_post.fd/BNDLYR.f b/sorc/ncep_post.fd/BNDLYR.f index bac24387c..4c4ea74c7 100644 --- a/sorc/ncep_post.fd/BNDLYR.f +++ b/sorc/ncep_post.fd/BNDLYR.f @@ -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) @@ -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 @@ -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 @@ -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 @@ -307,7 +307,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).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 @@ -315,7 +315,7 @@ SUBROUTINE BNDLYR(PBND,TBND,QBND,RHBND,UBND,VBND, & DO LL=1,LM PM = PMID(I,J,LL) DELP = ABS(PM-PBND(I,J,LBND)) - IF(DELP.LT.PMIN)THEN + IF(DELP1.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 @@ -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) @@ -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(DELPV1) cycle IF (ITYPE == 1 .OR. (ITYPE == 2 .AND. KB == 1)) THEN !$omp parallel do private(i,j,apebtk,apespk,bqk,bqs00k,bqs10k,iq,ittbk, & @@ -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.(PKLPSFCK)) cycle IF (ITYPE ==2 .OR. & (ITYPE == 1 .AND. (PKL >= PSFCK-DPBND .AND. PKL <= PSFCK)))THEN IF (ITYPE == 1) THEN diff --git a/sorc/ncep_post.fd/CALCAPE2.f b/sorc/ncep_post.fd/CALCAPE2.f index 7b5ae1534..36b478cd8 100644 --- a/sorc/ncep_post.fd/CALCAPE2.f +++ b/sorc/ncep_post.fd/CALCAPE2.f @@ -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, & @@ -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.(PKLPSFCK)) cycle IF (ITYPE ==2 .OR. & (ITYPE == 1 .AND. (PKL >= PSFCK-DPBND .AND. PKL <= PSFCK)))THEN IF (ITYPE == 1) THEN @@ -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) @@ -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 diff --git a/sorc/ncep_post.fd/CALDRG.f b/sorc/ncep_post.fd/CALDRG.f index 459347ab4..88f0d6038 100644 --- a/sorc/ncep_post.fd/CALDRG.f +++ b/sorc/ncep_post.fd/CALDRG.f @@ -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 @@ -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 @@ -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 diff --git a/sorc/ncep_post.fd/CALHEL.f b/sorc/ncep_post.fd/CALHEL.f index 05184a905..84d5fc841 100644 --- a/sorc/ncep_post.fd/CALHEL.f +++ b/sorc/ncep_post.fd/CALHEL.f @@ -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 diff --git a/sorc/ncep_post.fd/CALHEL2.f b/sorc/ncep_post.fd/CALHEL2.f index af50af5d7..e1560bd49 100644 --- a/sorc/ncep_post.fd/CALHEL2.f +++ b/sorc/ncep_post.fd/CALHEL2.f @@ -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 diff --git a/sorc/ncep_post.fd/CALMCVG.f b/sorc/ncep_post.fd/CALMCVG.f index 220a4f8f7..17d92dbcb 100644 --- a/sorc/ncep_post.fd/CALMCVG.f +++ b/sorc/ncep_post.fd/CALMCVG.f @@ -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)=1.) THEN +! IF (Fice>=1.) THEN QI1(I,J)=WC - ELSE IF (Fice .LE. 0.) THEN + ELSE IF (Fice <= 0.) THEN QW1(I,J)=WC ELSE QI1(I,J)=Fice*WC QW1(I,J)=WC-QI1(I,J) ENDIF - IF (QW1(I,J).GT.0. .AND. Frain.GT.0.) THEN - IF (Frain .GE. 1.) THEN + IF (QW1(I,J)>0. .AND. Frain>0.) THEN + IF (Frain >= 1.) THEN QR1(I,J)=QW1(I,J) QW1(I,J)=0. ELSE @@ -155,12 +155,12 @@ SUBROUTINE CALMICT_new(P1D,T1D,Q1D,C1D,FI1D,FR1D,FS1D,CUREFL, & !--- Based on code from GSMCOLUMN in model to determine reflectivity from rain ! RQR=0. - IF (QR1(I,J) .GT. EPSQ) THEN + IF (QR1(I,J) > EPSQ) THEN RQR=RHO*QR1(I,J) - IF (RQR .LE. RQR_DRmin) THEN + IF (RQR <= RQR_DRmin) THEN N0r=MAX(N0rmin, CN0r_DMRmin*RQR) INDEXR=MDRmin - ELSE IF (RQR .GE. RQR_DRmax) THEN + ELSE IF (RQR >= RQR_DRmax) THEN N0r=CN0r_DMRmax*RQR INDEXR=MDRmax ELSE @@ -177,13 +177,13 @@ SUBROUTINE CALMICT_new(P1D,T1D,Q1D,C1D,FI1D,FR1D,FS1D,CUREFL, & NRAIN=N0r*1.E-6*REAL(INDEXR) NRAIN1(I,J)=NRAIN Zrain=0.72*N0r*DRmm*DRmm*DRmm*DRmm*DRmm*DRmm*DRmm - ENDIF !--- End IF (QR1(I,J) .GT. EPSQ) block + ENDIF !--- End IF (QR1(I,J) > EPSQ) block ! !--- Based on code from GSMCOLUMN in model to determine partition of ! total ice into cloud ice & snow (precipitation ice) ! RQLICE=0. - IF (QI1(I,J) .GT. EPSQ) THEN + IF (QI1(I,J) > EPSQ) THEN QICE=QI1(I,J) ! ! -> Small ice particles are assumed to have a mean diameter of 50 microns. @@ -247,12 +247,12 @@ SUBROUTINE CALMICT_new(P1D,T1D,Q1D,C1D,FI1D,FR1D,FS1D,CUREFL, & HAIL=.FALSE. NLICE=MAX(NLI_min, MIN(NLImax, NLICE) ) XLI=RQLICE/(NLICE*RimeF) -new_size: IF (XLI .LE. MASSI(MDImin) ) THEN +new_size: IF (XLI <= MASSI(MDImin) ) THEN INDEXS=MDImin - ELSE IF (XLI .LE. MASSI(450) ) THEN new_size + ELSE IF (XLI <= MASSI(450) ) THEN new_size DLI=9.5885E5*XLI**.42066 ! DLI in microns INDEXS=MIN(MDImax, MAX(MDImin, INT(DLI) ) ) - ELSE IF (XLI .LE. MASSI(MDImax) ) THEN new_size + ELSE IF (XLI <= MASSI(MDImax) ) THEN new_size DLI=3.9751E6*XLI**.49870 ! DLI in microns INDEXS=MIN(MDImax, MAX(MDImin, INT(DLI) ) ) ELSE new_size @@ -279,7 +279,7 @@ SUBROUTINE CALMICT_new(P1D,T1D,Q1D,C1D,FI1D,FR1D,FS1D,CUREFL, & ENDIF if (NLICE1(I,J) /= 0.0) Zice=Cice*RQLICE*RQLICE/NLICE1(I,J) IF (TC>=0.) Zice=Cwet*Zice ! increased for wet ice - ENDIF ! End IF (QI1(I,J) .GT. 0.) THEN + ENDIF ! End IF (QI1(I,J) > 0.) THEN ! !--- Assumed enhanced radar reflectivity when rain and ice coexist ! above an assumed threshold mass content, RQmix @@ -305,11 +305,11 @@ SUBROUTINE CALMICT_new(P1D,T1D,Q1D,C1D,FI1D,FR1D,FS1D,CUREFL, & ! 10 Zice=Zice+Zsmice Ztot=Zrain+Zice+Zconv - IF (Ztot .GT. Zmin) DBZ1(I,J)= 10.*ALOG10(Ztot) - IF (Zrain .GT. Zmin) DBZR1(I,J)=10.*ALOG10(Zrain) - IF (Zice .GT. Zmin) DBZI1(I,J)=10.*ALOG10(Zice) -! IF (Zconv .GT. Zmin) DBZC1(I,J)=10.*ALOG10(Zsmice) - IF (Zconv .GT. Zmin) DBZC1(I,J)=10.*ALOG10(Zconv) + IF (Ztot > Zmin) DBZ1(I,J)= 10.*ALOG10(Ztot) + IF (Zrain > Zmin) DBZR1(I,J)=10.*ALOG10(Zrain) + IF (Zice > Zmin) DBZI1(I,J)=10.*ALOG10(Zice) +! IF (Zconv > Zmin) DBZC1(I,J)=10.*ALOG10(Zsmice) + IF (Zconv > Zmin) DBZC1(I,J)=10.*ALOG10(Zconv) ENDDO ENDDO ! @@ -427,7 +427,7 @@ SUBROUTINE CALMICT_old(P1D,T1D,Q1D,C1D,FI1D,FR1D,FS1D,CUREFL, & Zrain=0. !--- Radar reflectivity from rain Zice=0. !--- Radar reflectivity from ice Zconv=CUREFL(I,J) !--- Radar reflectivity from convection - IF (C1D(I,J) .LE. EPSQ) THEN + IF (C1D(I,J) <= EPSQ) THEN ! !--- Skip rest of calculatiions if no condensate is present ! @@ -444,17 +444,17 @@ SUBROUTINE CALMICT_old(P1D,T1D,Q1D,C1D,FI1D,FR1D,FS1D,CUREFL, & TC=T1D(I,J)-TFRZ Fice=FI1D(I,J) Frain=FR1D(I,J) - IF (TC.LE.T_ICE .OR. Fice.GE.1.) THEN -! IF (Fice.GE.1.) THEN + IF (TC<=T_ICE .OR. Fice>=1.) THEN +! IF (Fice>=1.) THEN QI1(I,J)=WC - ELSE IF (Fice .LE. 0.) THEN + ELSE IF (Fice <= 0.) THEN QW1(I,J)=WC ELSE QI1(I,J)=Fice*WC QW1(I,J)=WC-QI1(I,J) ENDIF - IF (QW1(I,J).GT.0. .AND. Frain.GT.0.) THEN - IF (Frain .GE. 1.) THEN + IF (QW1(I,J)>0. .AND. Frain>0.) THEN + IF (Frain >= 1.) THEN QR1(I,J)=QW1(I,J) QW1(I,J)=0. ELSE @@ -473,12 +473,12 @@ SUBROUTINE CALMICT_old(P1D,T1D,Q1D,C1D,FI1D,FR1D,FS1D,CUREFL, & ! !--- Based on code from GSMCOLUMN in model to determine reflectivity from rain ! - IF (QR1(I,J) .GT. EPSQ) THEN + IF (QR1(I,J) > EPSQ) THEN RQR=RHO*QR1(I,J) - IF (RQR .LE. RQR_DRmin) THEN + IF (RQR <= RQR_DRmin) THEN N0r=MAX(N0rmin, CN0r_DMRmin*RQR) INDEXR=MDRmin - ELSE IF (RQR .GE. RQR_DRmax) THEN + ELSE IF (RQR >= RQR_DRmax) THEN N0r=CN0r_DMRmax*RQR INDEXR=MDRmax ELSE @@ -494,12 +494,12 @@ SUBROUTINE CALMICT_old(P1D,T1D,Q1D,C1D,FI1D,FR1D,FS1D,CUREFL, & !--- Number concentration of rain drops (convert INDEXR to m) ! NRAIN1(I,J)=N0r*1.E-6*REAL(INDEXR) - ENDIF !--- End IF (QR1(I,J) .GT. EPSQ) block + ENDIF !--- End IF (QR1(I,J) > EPSQ) block ! !--- Based on code from GSMCOLUMN in model to determine partition of ! total ice into cloud ice & snow (precipitation ice) ! - IF (QI1(I,J) .GT. EPSQ) THEN + IF (QI1(I,J) > EPSQ) THEN QICE=QI1(I,J) RHO=P1D(I,J)/(RD*T1D(I,J)*(1.+ONEPS*Q1D(I,J))) RRHO=1./RHO @@ -519,11 +519,11 @@ SUBROUTINE CALMICT_old(P1D,T1D,Q1D,C1D,FI1D,FR1D,FS1D,CUREFL, & ! * QLICE - time-averaged mixing ratio of large ice ! * NLICE1 - time-averaged number concentration of large ice ! - IF (TC.GE.0. .OR. WVQW.LT.QSIgrd) THEN + IF (TC>=0. .OR. WVQW=-8. .AND. TC<=-3.) FLARGE=.5*FLARGE ENDIF FSMALL=(1.-FLARGE)/FLARGE XSIMASS=RRHO*MASSI(MDImin)*FSMALL @@ -534,18 +534,18 @@ SUBROUTINE CALMICT_old(P1D,T1D,Q1D,C1D,FI1D,FR1D,FS1D,CUREFL, & FLIMASS=XLIMASS/(XLIMASS+XSIMASS) QLICE=FLIMASS*QICE NLICE1(I,J)=QLICE/XLIMASS - IF (NLICE1(I,J).LT.NLImin .OR. NLICE1(I,J).GT.NLImax) THEN + IF (NLICE1(I,J)NLImax) THEN ! !--- Force NLICE1 to be between NLImin and NLImax ! DUM=MAX(NLImin, MIN(NLImax, NLICE1(I,J)) ) XLI=RHO*(QICE/DUM-XSIMASS)/RimeF - IF (XLI .LE. MASSI(MDImin) ) THEN + IF (XLI <= MASSI(MDImin) ) THEN INDEXS=MDImin - ELSE IF (XLI .LE. MASSI(450) ) THEN + ELSE IF (XLI <= MASSI(450) ) THEN DLI=9.5885E5*XLI**.42066 ! DLI in microns INDEXS=MIN(MDImax, MAX(MDImin, INT(DLI) ) ) - ELSE IF (XLI .LE. MASSI(MDImax) ) THEN + ELSE IF (XLI <= MASSI(MDImax) ) THEN DLI=3.9751E6*XLI**.49870 ! DLI in microns INDEXS=MIN(MDImax, MAX(MDImin, INT(DLI) ) ) ELSE @@ -555,14 +555,14 @@ SUBROUTINE CALMICT_old(P1D,T1D,Q1D,C1D,FI1D,FR1D,FS1D,CUREFL, & ! are reached for number concentration (NLImax) and mean size ! (MDImax). Done to increase fall out of ice. ! - IF (DUM .GE. NLImax) & + IF (DUM >= NLImax) & RimeF=RHO*(QICE/NLImax-XSIMASS)/MASSI(INDEXS) - ENDIF ! End IF (XLI .LE. MASSI(MDImin) ) + ENDIF ! End IF (XLI <= MASSI(MDImin) ) XLIMASS=RRHO*RimeF*MASSI(INDEXS) FLIMASS=XLIMASS/(XLIMASS+XSIMASS) QLICE=FLIMASS*QICE NLICE1(I,J)=QLICE/XLIMASS - ENDIF ! End IF (NLICE.LT.NLImin ... + ENDIF ! End IF (NLICE 0.) THEN ! !--- Calculate total (convective + grid-scale) radar reflectivity 10 Ztot=Zrain+Zice+Zconv - IF (Ztot .GT. Zmin) DBZ1(I,J)= 10.*ALOG10(Ztot) - IF (Zrain .GT. Zmin) DBZR1(I,J)=10.*ALOG10(Zrain) - IF (Zice .GT. Zmin) DBZI1(I,J)=10.*ALOG10(Zice) - IF (Zconv .GT. Zmin) DBZC1(I,J)=10.*ALOG10(Zconv) + IF (Ztot > Zmin) DBZ1(I,J)= 10.*ALOG10(Ztot) + IF (Zrain > Zmin) DBZR1(I,J)=10.*ALOG10(Zrain) + IF (Zice > Zmin) DBZI1(I,J)=10.*ALOG10(Zice) + IF (Zconv > Zmin) DBZC1(I,J)=10.*ALOG10(Zconv) ENDDO ENDDO ! diff --git a/sorc/ncep_post.fd/CALPBL.f b/sorc/ncep_post.fd/CALPBL.f index e32d3f1aa..bbf262bd4 100644 --- a/sorc/ncep_post.fd/CALPBL.f +++ b/sorc/ncep_post.fd/CALPBL.f @@ -196,7 +196,7 @@ SUBROUTINE CALPBL(PBLRI) ! BETWEEN HEIGHTS, AND PREVIOUS (RIBP) AND CURRENT (RIB) BULK ! RICHARDSON NUMBERS. L IS BOUNDARY-LAYER TOP LEVEL NUMBER. ! -------------------------------------------------------------------- - IF (RIB.GE.RICR.AND.ICALPBL(I,J).EQ.0) THEN + IF (RIB>=RICR.AND.ICALPBL(I,J)==0) THEN PBLRI(I,J) = ZMID(I,J,L)+(ZMID(I,J,L-1)-ZMID(I,J,L))* & (RICR-RIBP(I,J))/(RIB-RIBP(I,J)) ICALPBL(I,J) = 1 diff --git a/sorc/ncep_post.fd/CALPBLREGIME.f b/sorc/ncep_post.fd/CALPBLREGIME.f index 632129b43..db3dbe95a 100644 --- a/sorc/ncep_post.fd/CALPBLREGIME.f +++ b/sorc/ncep_post.fd/CALPBLREGIME.f @@ -5,17 +5,17 @@ !! ABSTRACT: !! THIS ROUTINE COMPUTES THE BULK RICHARDSON NUMBER BASED ON ALGORITHMS !! FROM WRF SURFACE LAYER AND THEN DERIVE PBL REGIME AS FOLLOWS: -!! 1. BR .GE. 0.2; +!! 1. BR >= 0.2; !! REPRESENTS NIGHTTIME STABLE CONDITIONS (REGIME=1), !! -!! 2. BR .LT. 0.2 .AND. BR .GT. 0.0; +!! 2. BR < 0.2 .AND. BR > 0.0; !! REPRESENTS DAMPED MECHANICAL TURBULENT CONDITIONS !! (REGIME=2), !! -!! 3. BR .EQ. 0.0 +!! 3. BR == 0.0 !! REPRESENTS FORCED CONVECTION CONDITIONS (REGIME=3), !! -!! 4. BR .LT. 0.0 +!! 4. BR < 0.0 !! REPRESENTS FREE CONVECTION CONDITIONS (REGIME=4). !! . !! diff --git a/sorc/ncep_post.fd/CALPW.f b/sorc/ncep_post.fd/CALPW.f index d349b29ff..c880080d4 100644 --- a/sorc/ncep_post.fd/CALPW.f +++ b/sorc/ncep_post.fd/CALPW.f @@ -160,7 +160,7 @@ SUBROUTINE CALPW(PW,IDECID) !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM - IF (T(I,J,L) .GE. TFRZ) THEN + IF (T(I,J,L) >= TFRZ) THEN Qdum(I,J) = 0. ELSE Qdum(I,J) = QQW(I,J,L) + QQR(I,J,L) diff --git a/sorc/ncep_post.fd/CALRAD_WCLOUD_newcrtm.f b/sorc/ncep_post.fd/CALRAD_WCLOUD_newcrtm.f index 9b63193be..6d2aec892 100644 --- a/sorc/ncep_post.fd/CALRAD_WCLOUD_newcrtm.f +++ b/sorc/ncep_post.fd/CALRAD_WCLOUD_newcrtm.f @@ -1678,7 +1678,7 @@ SUBROUTINE CALRAD_WCLOUD ichan=ixchan igot=iget(800) if(igot>0) then - if(lvls(ixchan,igot).eq.1)then + if(lvls(ixchan,igot)==1)then nc=nc+1 do j=jsta,jend do i=1,im @@ -1700,7 +1700,7 @@ SUBROUTINE CALRAD_WCLOUD ichan=ixchan igot=iget(806) if(igot>0) then - if(lvls(ixchan,igot).eq.1)then + if(lvls(ixchan,igot)==1)then nc=nc+1 do j=jsta,jend do i=1,im @@ -1722,7 +1722,7 @@ SUBROUTINE CALRAD_WCLOUD ichan=ixchan igot=iget(812) if(igot>0) then - if(lvls(ixchan,igot).eq.1)then + if(lvls(ixchan,igot)==1)then nc=nc+1 do j=jsta,jend do i=1,im @@ -1745,7 +1745,7 @@ SUBROUTINE CALRAD_WCLOUD igot=iget(818) if(igot>0) then print*,'ixchan,lvls=',ixchan,lvls(ixchan,igot) - if(lvls(ixchan,igot).eq.1)then + if(lvls(ixchan,igot)==1)then nc=nc+1 do j=jsta,jend do i=1,im @@ -1767,7 +1767,7 @@ SUBROUTINE CALRAD_WCLOUD ichan=ixchan igot=iget(825) if(igot>0) then - if(lvls(ixchan,igot).eq.1)then + if(lvls(ixchan,igot)==1)then nc=nc+1 do j=jsta,jend do i=1,im @@ -1789,7 +1789,7 @@ SUBROUTINE CALRAD_WCLOUD ichan=ixchan igot=iget(832) if(igot>0) then - if(lvls(ixchan,igot).eq.1)then + if(lvls(ixchan,igot)==1)then nc=nc+1 do j=jsta,jend do i=1,im @@ -1811,7 +1811,7 @@ SUBROUTINE CALRAD_WCLOUD ichan=ixchan igot=iget(839) if(igot>0) then - if(lvls(ixchan,igot).eq.1)then + if(lvls(ixchan,igot)==1)then nc=nc+1 do j=jsta,jend do i=1,im @@ -1833,7 +1833,7 @@ SUBROUTINE CALRAD_WCLOUD ichan=ixchan igot=iget(846) if(igot>0) then - if(lvls(ixchan,igot).eq.1)then + if(lvls(ixchan,igot)==1)then nc=nc+1 do j=jsta,jend do i=1,im @@ -1853,7 +1853,7 @@ SUBROUTINE CALRAD_WCLOUD nc=0 do ichan=1,4 igot=iget(860) - if(lvls(ichan,igot).eq.1)then + if(lvls(ichan,igot)==1)then nc=nc+1 do j=jsta,jend do i=1,im @@ -1872,7 +1872,7 @@ SUBROUTINE CALRAD_WCLOUD nc=0 do ichan=1,4 igot=iget(864) - if(lvls(ichan,igot).eq.1)then + if(lvls(ichan,igot)==1)then nc=nc+1 do j=jsta,jend do i=1,im @@ -1891,7 +1891,7 @@ SUBROUTINE CALRAD_WCLOUD nc=0 do ichan=1,4 igot=iget(865) - if(lvls(ichan,igot).eq.1)then + if(lvls(ichan,igot)==1)then nc=nc+1 do j=jsta,jend do i=1,im @@ -1948,7 +1948,7 @@ SUBROUTINE CALRAD_WCLOUD ichan=ixchan igot=iget(876) if(igot>0) then - if(lvls(ixchan,igot).eq.1)then + if(lvls(ixchan,igot)==1)then nc=nc+1 do j=jsta,jend do i=1,im @@ -1970,7 +1970,7 @@ SUBROUTINE CALRAD_WCLOUD ichan=ixchan igot=iget(868) if(igot>0) then - if(lvls(ixchan,igot).eq.1)then + if(lvls(ixchan,igot)==1)then nc=nc+1 do j=jsta,jend do i=1,im @@ -1992,7 +1992,7 @@ SUBROUTINE CALRAD_WCLOUD ichan=ixchan igot=iget(872) if(igot>0) then - if(lvls(ixchan,igot).eq.1)then + if(lvls(ixchan,igot)==1)then nc=nc+1 do j=jsta,jend do i=1,im @@ -2226,13 +2226,13 @@ REAL FUNCTION EFFR(pmid,t,q,qqw,qqi,qqr,f_rimef, nlice, nrain, & - if(mp_opt.eq.6) then !WSM6 SCHEME + if(mp_opt==6) then !WSM6 SCHEME n0_r = wsm6_n0r n0_g = wsm6_n0g n0_s = wsm6_n0s - elseif(mp_opt.eq.2)then !LIN SCHEME + elseif(mp_opt==2)then !LIN SCHEME n0_r = lin_n0r n0_g = lin_n0g @@ -2253,13 +2253,13 @@ REAL FUNCTION EFFR(pmid,t,q,qqw,qqi,qqr,f_rimef, nlice, nrain, & rho=pmid/(rd*t*(1.+D608*q)) - if(mp_opt.eq.6)then + if(mp_opt==6)then SELECT CASE(species) CASE("C") - if ( qqw.gt.min_qc ) then !cloud diameter: assume constant # concentration + if ( qqw>min_qc ) then !cloud diameter: assume constant # concentration effr = 1.0E6*(( 6. * rho * qqw ) / & (pi * wsm6_rhor * wsm6_cnp))**(1/3.) @@ -2267,21 +2267,21 @@ REAL FUNCTION EFFR(pmid,t,q,qqw,qqi,qqr,f_rimef, nlice, nrain, & CASE("R") - if ( qqr.gt.min_qr ) then !rain diameter: assume gamma distribution + if ( qqr>min_qr ) then !rain diameter: assume gamma distribution effr = 1.0E6*( ( 6. * rho * qqr ) / & ( pi * wsm6_rhor * n0_r * gamma_crg ) ) ** (1/(1+beta_crg ) ) endif CASE("G") - if ( qqg.gt.min_qg ) then !graupel diameter: assume gamma distribution + if ( qqg>min_qg ) then !graupel diameter: assume gamma distribution effr = 1.0E6*( ( 6. * rho * qqg ) / & ( pi * wsm6_rhog * n0_g * gamma_crg ) ) ** (1/(1+beta_crg ) ) endif CASE("S") - if ( qqs.gt.min_qs ) then !snow diameter: assume gamma distribution + if ( qqs>min_qs ) then !snow diameter: assume gamma distribution effr = 1.0E6*( ( 6. * rho * qqs ) / & ( pi * wsm6_rhos * n0_s * gamma_s ) ) ** ( 1/(1+beta_s) ) endif @@ -2291,7 +2291,7 @@ REAL FUNCTION EFFR(pmid,t,q,qqw,qqi,qqr,f_rimef, nlice, nrain, & CASE("I") - if ( qqi.gt.min_qi ) then !ice diameter + if ( qqi>min_qi ) then !ice diameter ! wsm6_nci = min(max(5.38e7*(rho*max(qqi,wsm6_qmin)),1.e3),1.e6) ! xmi = rho * qqi / wsm6_nci ! effr = 1.0E6*min( sqrt(xmi), wsm6_dimax) @@ -2308,7 +2308,7 @@ REAL FUNCTION EFFR(pmid,t,q,qqw,qqi,qqr,f_rimef, nlice, nrain, & END SELECT - elseif(mp_opt.eq.2)then + elseif(mp_opt==2)then SELECT CASE(species) @@ -2349,7 +2349,7 @@ REAL FUNCTION EFFR(pmid,t,q,qqw,qqi,qqr,f_rimef, nlice, nrain, & END SELECT - elseif(mp_opt.eq.8 .or. mp_opt.eq.28)then + elseif(mp_opt==8 .or. mp_opt==28)then ! rain section @@ -2433,18 +2433,18 @@ REAL FUNCTION EFFR(pmid,t,q,qqw,qqi,qqr,f_rimef, nlice, nrain, & CASE("C") - if(qqw .ge. min_qc) then + if(qqw >= min_qc) then rc = MAX(1.E-12, qqw * rho) - if (mp_opt.eq.8) then + if (mp_opt==8) then ncc2 = nthom_nt_c - elseif (mp_opt.eq.28) then + elseif (mp_opt==28) then ncc2 = MAX(1.E-6, qqnw * rho) endif - if (ncc2 .lt. 10.e6) then - nu_c = 15 + if (ncc2 < 10.e6) then + nu_c = 15 else nu_c = min (15, NINT(1000.e6/ncc2) + 2) endif @@ -2481,7 +2481,7 @@ REAL FUNCTION EFFR(pmid,t,q,qqw,qqi,qqr,f_rimef, nlice, nrain, & CASE("I") - if(qqi .ge. min_qi) then + if(qqi >= min_qi) then ri = MAX(1.E-12, qqi * rho) nci2 = MAX(1.E-6, qqni * rho) @@ -2501,12 +2501,12 @@ REAL FUNCTION EFFR(pmid,t,q,qqw,qqi,qqr,f_rimef, nlice, nrain, & rs = MAX(1.E-12, qqs * rho) - if(qqs .ge. min_qs) then + if(qqs >= min_qs) then tc0 = min(-0.1, t-273.15) smob = rs*oams - if (nthom_bm_s.gt.(2.0-1.e-3) .and. nthom_bm_s.lt.(2.0+1.e-3))then + if (nthom_bm_s>(2.0-1.e-3) .and. nthom_bm_s<(2.0+1.e-3))then smo2 = smob else loga = nthom_sa(1) + nthom_sa(2)*tc0 + nthom_sa(3)*nthom_bm_s+ & @@ -2556,8 +2556,8 @@ REAL FUNCTION EFFR(pmid,t,q,qqw,qqi,qqr,f_rimef, nlice, nrain, & CASE("G") - if(qqg .ge. min_qg) then - + if(qqg >= min_qg) then + rg2 = MAX(1.E-12, qqg * rho) ygra1 = alog10(max(1.E-9, rg2)) @@ -2580,7 +2580,7 @@ REAL FUNCTION EFFR(pmid,t,q,qqw,qqi,qqr,f_rimef, nlice, nrain, & END SELECT - elseif(mp_opt.eq.11)then ! GFDL + elseif(mp_opt==11)then ! GFDL SELECT CASE(species) @@ -2597,11 +2597,11 @@ REAL FUNCTION EFFR(pmid,t,q,qqw,qqi,qqr,f_rimef, nlice, nrain, & ! cloud ice (heymsfield and mcfarquhar, 1996) if (qqi > min_qi) then - if ((t-gfdl_tice) .lt. - 50) then + if ((t-gfdl_tice) < - 50) then effr = gfdl_beta / 9.917 * exp ((1 - 0.891) * log (1.0e3 * qqi)) * 1.0e3 - elseif ((t-gfdl_tice) .lt. - 40.) then + elseif ((t-gfdl_tice) < - 40.) then effr = gfdl_beta / 9.337 * exp ((1 - 0.920) * log (1.0e3 * qqi)) * 1.0e3 - elseif ((t-gfdl_tice) .lt. - 30.) then + elseif ((t-gfdl_tice) < - 30.) then effr = gfdl_beta / 9.208 * exp ((1 - 0.945) * log (1.0e3 * qqi)) * 1.0e3 else effr = gfdl_beta / 9.387 * exp ((1 - 0.969) * log (1.0e3 * qqi)) * 1.0e3 @@ -2641,7 +2641,7 @@ REAL FUNCTION EFFR(pmid,t,q,qqw,qqi,qqr,f_rimef, nlice, nrain, & END SELECT - elseif(mp_opt.eq.5.or.mp_opt.eq.85.or.mp_opt.eq.95)then + elseif(mp_opt==5.or.mp_opt==85.or.mp_opt==95)then SELECT CASE (species) diff --git a/sorc/ncep_post.fd/CALRH_GFS.f b/sorc/ncep_post.fd/CALRH_GFS.f index e5c02b0ca..b6ff5da40 100644 --- a/sorc/ncep_post.fd/CALRH_GFS.f +++ b/sorc/ncep_post.fd/CALRH_GFS.f @@ -179,9 +179,9 @@ elemental function fpvsnew(t) x=xmin+(jx-1)*xinc tr=con_ttp/x - if(x.ge.tliq) then + if(x>=tliq) then tbpvs(jx)=con_psat*(tr**xponal)*exp(xponbl*(1.-tr)) - elseif(x.lt.tice) then + elseif(x=tliq) then tbpvs(jx+1)=con_psat*(tr**xponal)*exp(xponbl*(1.-tr)) - elseif(xp1.lt.tice) then + elseif(xp1= HLOWER .AND. & + (ZMIDLOC - HTSFC(I,J)) <= HUPPER ) THEN DZ=(ZINT(I,J,L)-ZINT(I,J,L+1)) - IF (WH(I,J,L) .lt. 0) THEN + IF (WH(I,J,L) < 0) THEN ! ANY DOWNWARD MOTION IN 2-5 km LAYER KILLS COMPUTATION AND ! SETS RESULTANT UPDRAFT HELICTY TO ZERO diff --git a/sorc/ncep_post.fd/CALVESSEL.f b/sorc/ncep_post.fd/CALVESSEL.f index cf5d11b4d..9dae6d633 100644 --- a/sorc/ncep_post.fd/CALVESSEL.f +++ b/sorc/ncep_post.fd/CALVESSEL.f @@ -17,14 +17,14 @@ SUBROUTINE CALVESSEL(ICEG) DO I=1,IM ! CALCULATE SPEED SPD10(i,j)=SQRT(U10H(I,J)**2+V10H(I,J)**2) - if (SPD10(i,j).gt.50) then + if (SPD10(i,j)>50) then iceg(i,j)=0. CYCLE endif ! Reverse of land mask use le instead of ge from original code !! MASK CHECK - if((sice(i,j).ge.0.5).or.(sm(i,j).le.0.5)) then + if((sice(i,j)>=0.5).or.(sm(i,j)<=0.5)) then ICEG(i,j)=0. CYCLE endif @@ -33,14 +33,14 @@ SUBROUTINE CALVESSEL(ICEG) !!! TEMPERATURE CHECK SST_C=SST(I,J)-C2K TSHLTR_C=TSHLTR(I,J)-C2K - if((SST_C.lt.-1.7).OR. & - (SST_C.gt.12.0)) then + if((SST_C<-1.7).OR. & + (SST_C>12.0)) then ICEG(I,j)=0. CYCLE endif - if((TSHLTR_C.gt.0.).OR. & - (TSHLTR_C.lt.-40.)) then + if((TSHLTR_C>0.).OR. & + (TSHLTR_C<-40.)) then ICEG(I,j)=0. CYCLE endif @@ -51,7 +51,7 @@ SUBROUTINE CALVESSEL(ICEG) +(1.84E-06)*PR(i,j)**3 !! ICE GROWTH CHECK - if (ICEG(i,j).LT.0.) THEN + if (ICEG(i,j)<0.) THEN ICEG(I,J)=0. else ! Convert to m/s from cm/hr diff --git a/sorc/ncep_post.fd/CALVIS.f b/sorc/ncep_post.fd/CALVIS.f index 168bb3325..5acb9204c 100644 --- a/sorc/ncep_post.fd/CALVIS.f +++ b/sorc/ncep_post.fd/CALVIS.f @@ -89,10 +89,10 @@ SUBROUTINE CALVIS(QV,QC,QR,QI,QS,TT,PP,VIS) ! DO J=JSTA,JEND DO I=1,IM -! IF(IICE.EQ.0)THEN +! IF(IICE==0)THEN ! QPRC=QR ! QCLD=QC -! IF(TT.LT.CELKEL)THEN +! IF(TT=50.)THEN ! VOVERMD=(1.+QV)/RHOAIR+QPRC/RHOICE+QCLD/RHOWAT ! CONCLC = QCLD/VOVERMD*1000. ! CONCLP = 0. @@ -148,7 +148,7 @@ SUBROUTINE CALVIS(QV,QC,QR,QI,QS,TT,PP,VIS) ! CONCFC = 0. ! CONCFP = 0. ! ENDIF -! ELSEIF(METH.EQ.'R')THEN +! ELSEIF(METH=='R')THEN VOVERMD=(1.+QV(I,J))/RHOAIR+(QCLW+QRAIN)/RHOWAT+ & (QCLICE+QSNOW)/RHOICE CONCLC = MAX(0., QCLW/VOVERMD*1000.) diff --git a/sorc/ncep_post.fd/CALVIS_GSD.f b/sorc/ncep_post.fd/CALVIS_GSD.f index 33ebf61c5..95ff6efb6 100644 --- a/sorc/ncep_post.fd/CALVIS_GSD.f +++ b/sorc/ncep_post.fd/CALVIS_GSD.f @@ -255,23 +255,23 @@ SUBROUTINE CALVIS_GSD(CZEN,VIS) +(v(i,j,lm-3)-v(i,j,lm))**2 ) shear_fac = min(1.,max(0.,(shear-4.)/2.) ) - if (visrh.lt.10.) visrh = visrh + (10.-visrh)* & + if (visrh<10.) visrh = visrh + (10.-visrh)* & shear_fac - if (shear.gt.4.) shear4_cnt = shear4_cnt +1 - if (shear.gt.5.) shear5_cnt = shear5_cnt +1 - if (shear.gt.6.) shear8_cnt = shear8_cnt +1 + if (shear>4.) shear4_cnt = shear4_cnt +1 + if (shear>5.) shear5_cnt = shear5_cnt +1 + if (shear>6.) shear8_cnt = shear8_cnt +1 - if (shear.gt.4..and.visrh.lt.10) & + if (shear>4..and.visrh<10) & shear4_cnt_lowvis = shear4_cnt_lowvis +1 - if (shear.gt.5..and.visrh.lt.10) & + if (shear>5..and.visrh<10) & shear5_cnt_lowvis = shear5_cnt_lowvis +1 - if (shear.gt.6..and.visrh.lt.10) & + if (shear>6..and.visrh<10) & shear8_cnt_lowvis = shear8_cnt_lowvis +1 - if (visrh.lt.10.) visrh10_cnt = visrh10_cnt+1 - if (czen(i,j).lt.0.) night_cnt = night_cnt + 1 - if (czen(i,j).lt.0.1) lowsun_cnt = lowsun_cnt + 1 + if (visrh<10.) visrh10_cnt = visrh10_cnt+1 + if (czen(i,j)<0.) night_cnt = night_cnt + 1 + if (czen(i,j)<0.1) lowsun_cnt = lowsun_cnt + 1 TV=T(I,J,lm)*(H1+D608*Q(I,J,lm)) @@ -291,7 +291,7 @@ SUBROUTINE CALVIS_GSD(CZEN,VIS) coef_snow = coeffp_dry*(1.-temp_fac) & + coeffp_wet* temp_fac - if (t(i,j,lm).lt. 270. .and. temp_fac.eq.1.) & + if (t(i,j,lm)< 270. .and. temp_fac==1.) & write (6,*) 'Problem w/ temp_fac - calvis' ! Key calculation of attenuation from each hydrometeor type (cloud, snow, graupel, rain, ice) @@ -301,21 +301,21 @@ SUBROUTINE CALVIS_GSD(CZEN,VIS) + coeffg*concfg**exponfg +1.E-10 ! Addition of attenuation from aerosols if option selected - if(method .eq. 2 .or. method .eq. 3)then ! aerosol method + if(method == 2 .or. method == 3)then ! aerosol method BETAV = BETAV + aextc55(i,j,lm)*1000. endif - if (i.eq.290 .and. j.eq.112) then + if (i==290 .and. j==112) then write (6,*) 'BETAV, extcof55 =',BETAV,extcof55(i,j,lm) end if ! Calculation of visibility based on hydrometeor and aerosols. (RH effect not yet included.) VIS(I,J)=MIN(90.,CONST1/BETAV+extcof55(i,j,lm)) ! max of 90km - if (vis(i,j).lt.vis_min) vis_min = vis(i,j) - if (visrh.lt.visrh_min) visrh_min = visrh + if (vis(i,j)PSFCK-7000.0) CYCLE 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.LT.TDCHK.AND.TKL.LT.TCOLD(I,J)) TCOLD(I,J)=TKL - IF (TDPRE.LT.TDCHK.AND.TKL.GT.TWARM(I,J)) TWARM(I,J)=TKL - IF (TDPRE.LT.TDCHK.AND.L.LT.LICEE(I,J)) LICEE(I,J)=L + IF (TDPRETWARM(I,J)) TWARM(I,J)=TKL + IF (TDPRE 6) ! - IF (TCOLD(I,J).EQ.T(I,J,LMHK).AND.TDCHK.LT.6.0) THEN + IF (TCOLD(I,J)==T(I,J,LMHK).AND.TDCHK<6.0) THEN TDCHK=TDCHK+2.0 ELSE jcontinue=.false. @@ -154,19 +154,19 @@ SUBROUTINE CALWXT_POST(T,Q,PMID,PINT,HTM,LMH,PREC,ZINT,IWX,ZWET) DO 850 J=JSTA,JEND DO 850 I=1,IM KARR(I,J)=0 - IF (PREC(I,J).LE.PTHRESH) cycle + IF (PREC(I,J)<=PTHRESH) cycle LMHK=NINT(LMH(I,J)) TLMHK=T(I,J,LMHK) ! ! DECISION TREE TIME ! - IF (TCOLD(I,J).GT.269.15) THEN - IF (TLMHK.LE.273.15) THEN + IF (TCOLD(I,J)>269.15) THEN + IF (TLMHK<=273.15) THEN ! TURN ON THE FLAG FOR ! FREEZING RAIN = 4 ! IF ITS NOT ON ALREADY ! IZR=MOD(IWX(I,J),8)/4 -! IF (IZR.LT.1) IWX(I,J)=IWX(I,J)+4 +! IF (IZR<1) IWX(I,J)=IWX(I,J)+4 IWX(I,J)=IWX(I,J)+4 cycle ELSE @@ -174,7 +174,7 @@ SUBROUTINE CALWXT_POST(T,Q,PMID,PINT,HTM,LMH,PREC,ZINT,IWX,ZWET) ! RAIN = 8 ! IF ITS NOT ON ALREADY ! IRAIN=IWX(I,J)/8 -! IF (IRAIN.LT.1) IWX(I,J)=IWX(I,J)+8 +! IF (IRAIN<1) IWX(I,J)=IWX(I,J)+8 IWX(I,J)=IWX(I,J)+8 cycle ENDIF @@ -193,13 +193,13 @@ SUBROUTINE CALWXT_POST(T,Q,PMID,PINT,HTM,LMH,PREC,ZINT,IWX,ZWET) ! & tlmhk,twrmk) DO 1900 J=JSTA,JEND DO 1900 I=1,IM -! IF (I .EQ. 324 .AND. J .EQ. 390) THEN +! IF (I == 324 .AND. J == 390) THEN ! LMHK=NINT(LMH(I,J)) ! DO L=LMHK,1,-1 ! print *, 'TW NCEP ', TWET(I,J,L) ! ENDDO ! ENDIF - IF(KARR(I,J).GT.0)THEN + IF(KARR(I,J)>0)THEN LMHK=NINT(LMH(I,J)) LICE=LICEE(I,J) !meb @@ -227,15 +227,15 @@ SUBROUTINE CALWXT_POST(T,Q,PMID,PINT,HTM,LMH,PREC,ZINT,IWX,ZWET) DO 1945 L=LMHK,LICE,-1 DZKL=ZINT(I,J,L)-ZINT(I,J,L+1) AREA1=(TWET(I,J,L)-269.15)*DZKL - IF (TWET(I,J,L).GE.269.15) AREAP4=AREAP4+AREA1 + IF (TWET(I,J,L)>=269.15) AREAP4=AREAP4+AREA1 1945 CONTINUE ! - IF (AREAP4.LT.3000.0) THEN + IF (AREAP4<3000.0) THEN ! TURN ON THE FLAG FOR ! SNOW = 1 ! IF ITS NOT ON ALREADY ! ISNO=MOD(IWX(I,J),2) -! IF (ISNO.LT.1) IWX(I,J)=IWX(I,J)+1 +! IF (ISNO<1) IWX(I,J)=IWX(I,J)+1 IWX(I,J)=IWX(I,J)+1 CYCLE ENDIF @@ -247,14 +247,14 @@ SUBROUTINE CALWXT_POST(T,Q,PMID,PINT,HTM,LMH,PREC,ZINT,IWX,ZWET) ! DO 1955 L=LMHK,1,-1 PINTK2=PINT(I,J,L) - IF(PINTK1.LT.PM150) THEN + IF(PINTK1=TWRMK) IWRML=1 ! - IF (IWRML.EQ.0.OR.IFRZL.EQ.0) THEN + IF (IWRML==0.OR.IFRZL==0) THEN DZKL=ZINT(I,J,L)-ZINT(I,J,L+1) AREA1=(TWET(I,J,L)-273.15)*DZKL - IF(IFRZL.EQ.0.AND.TWET(I,J,L).GE.273.15)SURFW=SURFW+AREA1 - IF(IWRML.EQ.0.AND.TWET(I,J,L).LE.273.15)SURFC=SURFC+AREA1 + IF(IFRZL==0.AND.TWET(I,J,L)>=273.15)SURFW=SURFW+AREA1 + IF(IWRML==0.AND.TWET(I,J,L)<=273.15)SURFC=SURFC+AREA1 ENDIF 2050 CONTINUE - IF(SURFC.LT.-3000.0.OR. & - (AREAS8.LT.-3000.0.AND.SURFW.LT.50.0)) THEN + IF(SURFC<-3000.0.OR. & + (AREAS8<-3000.0.AND.SURFW<50.0)) THEN ! TURN ON THE FLAG FOR ! ICE PELLETS = 2 ! IF ITS NOT ON ALREADY ! IIP=MOD(IWX(I,J),4)/2 -! IF (IIP.LT.1) IWX(I,J)=IWX(I,J)+2 +! IF (IIP<1) IWX(I,J)=IWX(I,J)+2 IWX(I,J)=IWX(I,J)+2 CYCLE ENDIF ! - IF(TLMHK.LT.273.15) THEN + IF(TLMHK<273.15) THEN ! TURN ON THE FLAG FOR ! FREEZING RAIN = 4 ! IF ITS NOT ON ALREADY ! IZR=MOD(IWX(K),8)/4 -! IF (IZR.LT.1) IWX(K)=IWX(K)+4 +! IF (IZR<1) IWX(K)=IWX(K)+4 IWX(I,J)=IWX(I,J)+4 ELSE ! TURN ON THE FLAG FOR ! RAIN = 8 ! IF ITS NOT ON ALREADY ! IRAIN=IWX(K)/8 -! IF (IRAIN.LT.1) IWX(K)=IWX(K)+8 +! IF (IRAIN<1) IWX(K)=IWX(K)+8 IWX(I,J)=IWX(I,J)+8 ENDIF ENDIF diff --git a/sorc/ncep_post.fd/CALWXT_RAMER.f b/sorc/ncep_post.fd/CALWXT_RAMER.f index a91f77bcd..b758ece46 100644 --- a/sorc/ncep_post.fd/CALWXT_RAMER.f +++ b/sorc/ncep_post.fd/CALWXT_RAMER.f @@ -81,7 +81,7 @@ SUBROUTINE CALWXT_RAMER_POST(T,Q,PMID,PINT,LMH,PREC,PTYP) ! ! SKIP THIS POINT IF NO PRECIP THIS TIME STEP ! - IF (PREC(I,J).LE.PTHRESH) cycle + IF (PREC(I,J)<=PTHRESH) cycle LMHK=NINT(LMH(I,J)) ! @@ -95,13 +95,13 @@ SUBROUTINE CALWXT_RAMER_POST(T,Q,PMID,PINT,LMH,PREC,PTYP) k2 = 0 ! layer of maximum rh ! IF (trace) WRITE (20,*) 'rhq(1)', rhq(i,j,1),'me=',me - IF (rhq(I,J,1).lt.rhprcp) THEN + IF (rhq(I,J,1)=rhprcp.or.toodry==0) THEN + IF (toodry/=0) THEN dpdrh = alog(pq(I,J,L)/pq(I,J,L-1)) / & (rhq(I,J,L)-RHQ(I,J,L-1)) pbot = exp(alog(pq(I,J,L))+(rhprcp-rhq(I,J,L))*dpdrh) @@ -141,7 +141,7 @@ SUBROUTINE CALWXT_RAMER_POST(T,Q,PMID,PINT,LMH,PREC,PTYP) 'dpdrh,pbot,rhprcp-rhq(I,J,L),L,ptw,toodry', & dpdrh, pbot, rhprcp - rhq(I,J,L), & L,ptw,toodry - ELSE IF (rhq(I,J,L).ge.rhprcp) THEN + ELSE IF (rhq(I,J,L)>=rhprcp) THEN ptw = pq(I,J,L) IF (trace) WRITE (*,*) 'HERE1: ptw,toodry',ptw, toodry ELSE @@ -158,8 +158,8 @@ SUBROUTINE CALWXT_RAMER_POST(T,Q,PMID,PINT,LMH,PREC,PTYP) ! IF (trace) WRITE (*,*) 'HERE3:pbot,ptw,deltag', & & pbot, ptw, deltag - IF (pbot/ptw.ge.deltag) THEN -!lin If (pbot-ptw.lt.deltag) Goto 2003 + IF (pbot/ptw>=deltag) THEN +!lin If (pbot-ptw=273.15+2.0) THEN ptyp(i,j) = 8 ! liquid IF (trace) PRINT *, 'liquid',i,j,'me=',me icefrac = 0.0 cycle END IF ! - IF (twmax.le.twice) THEN + IF (twmax<=twice) THEN icefrac = 1.0 ptyp(i,j) = 1 ! solid cycle @@ -188,12 +188,12 @@ SUBROUTINE CALWXT_RAMER_POST(T,Q,PMID,PINT,LMH,PREC,PTYP) ! Check to see if we had no success with locating a generating level. ! IF (trace) WRITE (*,*) 'HERE6: k1,ptyp', k1, ptyp(i,j),'me=',me - IF (k1.eq.0) THEN + IF (k1==0) THEN rate = flag cycle END IF ! - IF (ptop.eq.pq(I,J,k1)) THEN + IF (ptop==pq(I,J,k1)) THEN twtop = twq(I,J,k1) rhtop = rhq(I,J,k1) k2 = k1 @@ -215,10 +215,10 @@ SUBROUTINE CALWXT_RAMER_POST(T,Q,PMID,PINT,LMH,PREC,PTYP) 20 CONTINUE ! ! Gross check for solid precip, initialize ice fraction. - IF (i.eq.1.and.j.eq.1) WRITE (*,*) 'twmax=',twmax,twice,'twtop=',twtop - IF (twtop.le.twice) THEN + IF (i==1.and.j==1) WRITE (*,*) 'twmax=',twmax,twice,'twtop=',twtop + IF (twtop<=twice) THEN icefrac = 1.0 - IF (twmax.le.twmelt) THEN ! gross check for solid precip. + IF (twmax<=twmelt) THEN ! gross check for solid precip. IF (trace) PRINT *, 'solid' ptyp(i,j) = 1 ! solid precip cycle @@ -235,11 +235,11 @@ SUBROUTINE CALWXT_RAMER_POST(T,Q,PMID,PINT,LMH,PREC,PTYP) IF (trace) PRINT *, ptop, twtop - 273.15, icefrac,'me=',me IF (trace) WRITE (*,*) 'P,Tw,frac,twq(I,J,k1)', ptop, & & twtop - 273.15, icefrac, twq(I,J,k1),'me=',me - IF (icefrac.ge.1.0) THEN ! starting as all ice + IF (icefrac>=1.0) THEN ! starting as all ice IF (trace) WRITE (*,*) 'ICEFRAC=1', icefrac ! print *, 'twq twmwelt twtop ', twq(I,J,k1), twmelt, twtop - IF (twq(I,J,k1).lt.twmelt) GO TO 40 ! cannot commence melting - IF (twq(I,J,k1).eq.twtop) GO TO 40 ! both equal twmelt, nothing h + IF (twq(I,J,k1)twice) GO TO 40 ! cannot commence freezing + IF (twq(I,J,k1)==twtop) THEN wgt1 = 0.5 ELSE wgt1 = (twice-twq(I,J,k1)) / (twtop-twq(I,J,k1)) @@ -270,7 +270,7 @@ SUBROUTINE CALWXT_RAMER_POST(T,Q,PMID,PINT,LMH,PREC,PTYP) icefrac = icefrac + dpk * dtavg / mye IF (trace) WRITE (*,*) 'HERE10: wgt1,rhtop,rhq(I,J,k1),dtavg', & wgt1, rhtop, rhq(I,J,k1), dtavg,'me=',me - ELSE IF ((twq(I,J,k1).le.twmelt).and.(twq(I,J,k1).lt.twmelt)) THEN ! mix + ELSE IF ((twq(I,J,k1)<=twmelt).and.(twq(I,J,k1)373.15) THEN esat = flag RETURN END IF ! ! Avoid floating underflow. - IF (k.lt.173.15) THEN + IF (k<173.15) THEN esat = 3.777647E-05 RETURN END IF @@ -428,13 +428,13 @@ REAL*4 FUNCTION tdofesat(es,flag,flg) ! COMMON /flagflg/ flag, flg ! ! Flag ridiculous values. - IF (es.lt.0.0.or.es.gt.lim2) THEN + IF (es<0.0.or.es>lim2) THEN tdofesat = flag RETURN END IF ! ! Avoid floating underflow. - IF (es.lt.lim1) THEN + IF (es=t) RETURN ! - IF (t.lt.100.0) THEN + IF (t<100.0) THEN k = t + 273.15 kd = td + 273.15 - IF (kd.ge.k) RETURN + IF (kd>=k) RETURN cflag = 1 ELSE k = t @@ -474,10 +474,10 @@ FUNCTION xmytw_post(t,td,p) if (kd == 0.0) write(0,*)' kd=',kd,' t=',t,' p=',p,' td=',td ! ed = c0 - c1 * kd - c2 / kd - IF (ed.lt.-14.0.or.ed.gt.7.0) RETURN + IF (ed<-14.0.or.ed>7.0) RETURN ed = exp(ed) ew = c0 - c1 * k - c2 / k - IF (ew.lt.-14.0.or.ew.gt.7.0) RETURN + IF (ew<-14.0.or.ew>7.0) RETURN ew = exp(ew) fp = p * f s = (ew-ed) / (k-kd) @@ -485,16 +485,16 @@ FUNCTION xmytw_post(t,td,p) ! DO 10 l = 1, 5 ew = c0 - c1 * kw - c2 / kw - IF (ew.lt.-14.0.or.ew.gt.7.0) RETURN + IF (ew<-14.0.or.ew>7.0) RETURN ew = exp(ew) de = fp * (k-kw) + ed - ew - IF (abs(de/ew).lt.1E-5) exit + IF (abs(de/ew)<1E-5) exit s = ew * (c1-c2/(kw*kw)) - fp kw = kw - de / s 10 CONTINUE ! ! print *, 'kw ', kw - IF (cflag.ne.0) THEN + IF (cflag/=0) THEN xmytw_post= kw - 273.15 ELSE xmytw_post = kw diff --git a/sorc/ncep_post.fd/CALWXT_REVISED.f b/sorc/ncep_post.fd/CALWXT_REVISED.f index 1531973fe..5f72611d6 100644 --- a/sorc/ncep_post.fd/CALWXT_REVISED.f +++ b/sorc/ncep_post.fd/CALWXT_REVISED.f @@ -93,7 +93,7 @@ SUBROUTINE CALWXT_REVISED_POST(T,Q,PMID,PINT,HTM,LMH,PREC,ZINT,IWX) ! ! SKIP THIS POINT IF NO PRECIP THIS TIME STEP ! - IF (PREC(I,J).LE.PTHRESH) cycle + IF (PREC(I,J)<=PTHRESH) cycle ! ! FIND COLDEST AND WARMEST TEMPS IN SATURATED LAYER BETWEEN ! 70 MB ABOVE GROUND AND 500 MB @@ -120,19 +120,19 @@ SUBROUTINE CALWXT_REVISED_POST(T,Q,PMID,PINT,HTM,LMH,PREC,ZINT,IWX) ! SKIP PAST THIS IF THE LAYER IS NOT BETWEEN 70 MB ABOVE GROUND ! AND 500 MB ! - IF (PKL.LT.50000.0.OR.PKL.GT.PSFCK-7000.0) cycle + IF (PKL<50000.0.OR.PKL>PSFCK-7000.0) cycle 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.LT.TDCHK.AND.TKL.LT.TCOLD(I,J)) TCOLD(I,J)=TKL - IF (TDPRE.LT.TDCHK.AND.TKL.GT.TWARM(I,J)) TWARM(I,J)=TKL - IF (TDPRE.LT.TDCHK.AND.L.LT.LICEE(I,J)) LICEE(I,J)=L + IF (TDPRETWARM(I,J)) TWARM(I,J)=TKL + IF (TDPRE 6) ! - IF (TCOLD(I,J).EQ.T(I,J,LMHK).AND.TDCHK.LT.6.0) THEN + IF (TCOLD(I,J)==T(I,J,LMHK).AND.TDCHK<6.0) THEN TDCHK=TDCHK+2.0 ELSE jcontinue=.false. @@ -145,19 +145,19 @@ SUBROUTINE CALWXT_REVISED_POST(T,Q,PMID,PINT,HTM,LMH,PREC,ZINT,IWX) DO 850 J=JSTA,JEND DO 850 I=1,IM KARR(I,J)=0 - IF (PREC(I,J).LE.PTHRESH) cycle + IF (PREC(I,J)<=PTHRESH) cycle LMHK=NINT(LMH(I,J)) TLMHK=T(I,J,LMHK) ! ! DECISION TREE TIME ! - IF (TCOLD(I,J).GT.269.15) THEN - IF (TLMHK.LE.273.15) THEN + IF (TCOLD(I,J)>269.15) THEN + IF (TLMHK<=273.15) THEN ! TURN ON THE FLAG FOR ! FREEZING RAIN = 4 ! IF ITS NOT ON ALREADY ! IZR=MOD(IWX(I,J),8)/4 -! IF (IZR.LT.1) IWX(I,J)=IWX(I,J)+4 +! IF (IZR<1) IWX(I,J)=IWX(I,J)+4 IWX(I,J)=IWX(I,J)+4 cycle ELSE @@ -165,7 +165,7 @@ SUBROUTINE CALWXT_REVISED_POST(T,Q,PMID,PINT,HTM,LMH,PREC,ZINT,IWX) ! RAIN = 8 ! IF ITS NOT ON ALREADY ! IRAIN=IWX(I,J)/8 -! IF (IRAIN.LT.1) IWX(I,J)=IWX(I,J)+8 +! IF (IRAIN<1) IWX(I,J)=IWX(I,J)+8 IWX(I,J)=IWX(I,J)+8 cycle ENDIF @@ -183,7 +183,7 @@ SUBROUTINE CALWXT_REVISED_POST(T,Q,PMID,PINT,HTM,LMH,PREC,ZINT,IWX) !!$omp& tlmhk,twrmk) DO 1900 J=JSTA,JEND DO 1900 I=1,IM - IF(KARR(I,J).GT.0)THEN + IF(KARR(I,J)>0)THEN LMHK=NINT(LMH(I,J)) LICE=LICEE(I,J) !meb @@ -215,20 +215,20 @@ SUBROUTINE CALWXT_REVISED_POST(T,Q,PMID,PINT,HTM,LMH,PREC,ZINT,IWX) DZKL=ZINT(I,J,L)-ZINT(I,J,L+1) AREA1=(TWET(I,J,L)-269.15)*DZKL AREA0=(TWET(I,J,L)-273.15)*DZKL - IF (TWET(I,J,L).GE.269.15) AREAP4=AREAP4+AREA1 - IF (TWET(I,J,L).GE.273.15) AREAP0=AREAP0+AREA0 + IF (TWET(I,J,L)>=269.15) AREAP4=AREAP4+AREA1 + IF (TWET(I,J,L)>=273.15) AREAP0=AREAP0+AREA0 1945 CONTINUE ! -! IF (AREAP4.LT.3000.0) THEN +! IF (AREAP4<3000.0) THEN ! TURN ON THE FLAG FOR ! SNOW = 1 ! IF ITS NOT ON ALREADY ! ISNO=MOD(IWX(I,J),2) -! IF (ISNO.LT.1) IWX(I,J)=IWX(I,J)+1 +! IF (ISNO<1) IWX(I,J)=IWX(I,J)+1 ! IWX(I,J)=IWX(I,J)+1 ! GO TO 1900 ! ENDIF - IF (AREAP0.LT.350.0) THEN + IF (AREAP0<350.0) THEN ! TURN ON THE FLAG FOR ! SNOW = 1 IWX(I,J)=IWX(I,J)+1 @@ -242,14 +242,14 @@ SUBROUTINE CALWXT_REVISED_POST(T,Q,PMID,PINT,HTM,LMH,PREC,ZINT,IWX) ! DO 1955 L=LMHK,1,-1 PINTK2=PINT(I,J,L) - IF(PINTK1.LT.PM150) THEN + IF(PINTK1=TWRMK) IWRML=1 ! - IF (IWRML.EQ.0.OR.IFRZL.EQ.0) THEN + IF (IWRML==0.OR.IFRZL==0) THEN DZKL=ZINT(I,J,L)-ZINT(I,J,L+1) AREA1=(TWET(I,J,L)-273.15)*DZKL - IF(IFRZL.EQ.0.AND.TWET(I,J,L).GE.273.15)SURFW=SURFW+AREA1 - IF(IWRML.EQ.0.AND.TWET(I,J,L).LE.273.15)SURFC=SURFC+AREA1 + IF(IFRZL==0.AND.TWET(I,J,L)>=273.15)SURFW=SURFW+AREA1 + IF(IWRML==0.AND.TWET(I,J,L)<=273.15)SURFC=SURFC+AREA1 ENDIF 2050 CONTINUE - IF(SURFC.LT.-3000.0.OR. & - & (AREAS8.LT.-3000.0.AND.SURFW.LT.50.0)) THEN + IF(SURFC<-3000.0.OR. & + & (AREAS8<-3000.0.AND.SURFW<50.0)) THEN ! TURN ON THE FLAG FOR ! ICE PELLETS = 2 ! IF ITS NOT ON ALREADY ! IIP=MOD(IWX(I,J),4)/2 -! IF (IIP.LT.1) IWX(I,J)=IWX(I,J)+2 +! IF (IIP<1) IWX(I,J)=IWX(I,J)+2 IWX(I,J)=IWX(I,J)+2 cycle ENDIF ! - IF(TLMHK.LT.273.15) THEN + IF(TLMHK<273.15) THEN ! TURN ON THE FLAG FOR ! FREEZING RAIN = 4 ! IF ITS NOT ON ALREADY ! IZR=MOD(IWX(K),8)/4 -! IF (IZR.LT.1) IWX(K)=IWX(K)+4 +! IF (IZR<1) IWX(K)=IWX(K)+4 IWX(I,J)=IWX(I,J)+4 ELSE ! TURN ON THE FLAG FOR ! RAIN = 8 ! IF ITS NOT ON ALREADY ! IRAIN=IWX(K)/8 -! IF (IRAIN.LT.1) IWX(K)=IWX(K)+8 +! IF (IRAIN<1) IWX(K)=IWX(K)+8 IWX(I,J)=IWX(I,J)+8 ENDIF ENDIF diff --git a/sorc/ncep_post.fd/CANRES.f b/sorc/ncep_post.fd/CANRES.f index cab10032e..7ecaeeec8 100644 --- a/sorc/ncep_post.fd/CANRES.f +++ b/sorc/ncep_post.fd/CANRES.f @@ -25,7 +25,7 @@ SUBROUTINE CANRES(SOLAR,SFCTMP,Q2,SFCPRS,SMC, & ! SMC: VOLUMETRIC SOIL MOISTURE ! ZSOIL: SOIL DEPTH (NEGATIVE SIGN, AS IT IS BELOW GROUND) ! NSOIL: NO. OF SOIL LAYERS -! IROOT: NO. OF SOIL LAYERS IN ROOT ZONE (1.LE.NROOT.LE.NSOIL) +! IROOT: NO. OF SOIL LAYERS IN ROOT ZONE (1<=NROOT<=NSOIL) ! XLAI: LEAF AREA INDEX ! SMCWLT: WILTING POINT ! SMCREF: REFERENCE SOIL MOISTURE @@ -219,7 +219,7 @@ SUBROUTINE CANRES(SOLAR,SFCTMP,Q2,SFCPRS,SMC, & ! ZSOIL(4)=-2.0 DO N=1,NSOIL - IF(N.EQ.1)THEN + IF(N==1)THEN ZSOIL(N)=-1.0*SLDPTH(N) ELSE ZSOIL(N)=ZSOIL(N-1)-SLDPTH(N) @@ -274,8 +274,8 @@ SUBROUTINE CANRES(SOLAR,SFCTMP,Q2,SFCPRS,SMC, & ! ---------------------------------------------------------------------- GX = (SMC(1)-SMCWLT)/(SMCREF-SMCWLT) - IF (GX .GT. 1.) GX = 1. - IF (GX .LT. 0.) GX = 0. + IF (GX > 1.) GX = 1. + IF (GX < 0.) GX = 0. !#### USING SOIL DEPTH AS WEIGHTING FACTOR PART(1) = (ZSOIL(1)/ZSOIL(NROOTS)) * GX @@ -283,11 +283,11 @@ SUBROUTINE CANRES(SOLAR,SFCTMP,Q2,SFCPRS,SMC, & !#### USING ROOT DISTRIBUTION AS WEIGHTING FACTOR !C PART(1) = RTDIS(1) * GX - IF (NROOTS .GT. 1) THEN + IF (NROOTS > 1) THEN DO K = 2, NROOTS GX = (SMC(K)-SMCWLT)/(SMCREF-SMCWLT) - IF (GX .GT. 1.) GX = 1. - IF (GX .LT. 0.) GX = 0. + IF (GX > 1.) GX = 1. + IF (GX < 0.) GX = 0. !#### USING SOIL DEPTH AS WEIGHTING FACTOR PART(K) = ((ZSOIL(K)-ZSOIL(K-1))/ZSOIL(NROOTS)) * GX diff --git a/sorc/ncep_post.fd/CLDRAD.f b/sorc/ncep_post.fd/CLDRAD.f index adcbb06b6..958f49edd 100644 --- a/sorc/ncep_post.fd/CLDRAD.f +++ b/sorc/ncep_post.fd/CLDRAD.f @@ -258,7 +258,7 @@ SUBROUTINE CLDRAD ! THE BEST (SIX LAYER) AND BOUNDARY LAYER LIFTED INDICES ARE ! COMPUTED AND POSTED IN SUBROUTINE MISCLN. ! - IF (IGET(030).GT.0.OR.IGET(572)>0) THEN + IF (IGET(030)>0.OR.IGET(572)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -323,7 +323,7 @@ SUBROUTINE CLDRAD IF ((IGET(032) > 0))THEN ! dong add missing value for cape GRID1 = spval - IF ( (LVLS(1,IGET(032)).GT.0) )THEN + IF ( (LVLS(1,IGET(032))>0) )THEN ITYPE = 1 DPBND = 10.E2 dummy = 0. @@ -693,21 +693,21 @@ SUBROUTINE CLDRAD ENDDO ID(1:25)=0 ITHEAT = NINT(THEAT) - IF (ITHEAT .NE. 0) THEN + IF (ITHEAT /= 0) THEN IFINCR = MOD(IFHR,ITHEAT) ELSE IFINCR=0 END IF ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITHEAT ELSE ID(18) = IFHR-IFINCR ENDIF - IF(IFMIN .GE. 1)ID(18)=ID(18)*60 - IF (ID(18).LT.0) ID(18) = 0 + IF(IFMIN >= 1)ID(18)=ID(18)*60 + IF (ID(18)<0) ID(18) = 0 if(grib=="grib2" )then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(292)) @@ -743,21 +743,21 @@ SUBROUTINE CLDRAD ENDDO ID(1:25)=0 ITHEAT = NINT(THEAT) - IF (ITHEAT .NE. 0) THEN + IF (ITHEAT /= 0) THEN IFINCR = MOD(IFHR,ITHEAT) ELSE IFINCR=0 END IF ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITHEAT ELSE ID(18) = IFHR-IFINCR ENDIF - IF(IFMIN .GE. 1)ID(18)=ID(18)*60 - IF (ID(18).LT.0) ID(18) = 0 + IF(IFMIN >= 1)ID(18)=ID(18)*60 + IF (ID(18)<0) ID(18) = 0 if(grib=="grib2" )then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(293)) @@ -778,7 +778,7 @@ SUBROUTINE CLDRAD ENDIF ! ! TOTAL COLUMN moisture convergence - IF (IGET(295).GT.0) THEN + IF (IGET(295)>0) THEN CALL CALPW(GRID1(1,jsta),13) if(grib=="grib2" )then cfld=cfld+1 @@ -788,7 +788,7 @@ SUBROUTINE CLDRAD ENDIF ! ! TOTAL COLUMN RH - IF (IGET(312).GT.0) THEN + IF (IGET(312)>0) THEN CALL CALPW(GRID1(1,jsta),14) if(grib=="grib2" )then cfld=cfld+1 @@ -814,7 +814,7 @@ SUBROUTINE CLDRAD ENDIF ! ! BOTTOM AND/OR TOP OF SUPERCOOLED (<0C) LIQUID WATER LAYER - IF (IGET(287).GT.0 .OR. IGET(288).GT.0) THEN + IF (IGET(287)>0 .OR. IGET(288)>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=-5000. @@ -824,36 +824,36 @@ SUBROUTINE CLDRAD LM=NINT(LMH(I,J)) DO L=LM,1,-1 QCLD=QQW(I,J,L)+QQR(I,J,L) - IF (QCLD.GE.QCLDmin .AND. T(I,J,L).LT.TFRZ) THEN + IF (QCLD>=QCLDmin .AND. T(I,J,L) 0) THEN !-- Supercooled liquid exists, so get top & bottom heights. In this case, ! be conservative and select the lower interface height at the bottom of the ! layer and the top interface height at the top of the layer. GRID1(I,J)=ZINT(I,J,LBOT+1) DO L=1,LM QCLD=QQW(I,J,L)+QQR(I,J,L) - IF (QCLD.GE.QCLDmin .AND. T(I,J,L).LT.TFRZ) THEN + IF (QCLD>=QCLDmin .AND. T(I,J,L) 0) ENDDO !--- End I loop ENDDO !--- End J loop - IF (IGET(287).GT.0) THEN + IF (IGET(287)>0) THEN if(grib=="grib2" )then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(287)) datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend) endif ENDIF - IF (IGET(288).GT.0) THEN + IF (IGET(288)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -877,7 +877,7 @@ SUBROUTINE CLDRAD ! ! Convective cloud efficiency parameter used in convection ranges ! from 0.2 (EFIMN in cuparm in model) to 1.0 (Ferrier, Feb '02) - IF (IGET(197).GT.0) THEN + IF (IGET(197)>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J) = CLDEFI(I,J) @@ -985,13 +985,13 @@ SUBROUTINE CLDRAD !*** BLOCK 2. 2-D CLOUD FIELDS. ! GSD maximum cloud fraction in (PBL + 1 km) (J. Kenyon, 8 Aug 2019) - IF (IGET(799).GT.0) THEN + IF (IGET(799)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=0.0 DO K = 1,LM - IF (ZMID(I,J,LM-K+1) .LE. PBLH(I,J)+1000.0) THEN + IF (ZMID(I,J,LM-K+1) <= PBLH(I,J)+1000.0) THEN GRID1(I,J)=max(GRID1(I,J),CFR(I,J,LM-K+1)*100.0) ENDIF ENDDO @@ -1043,9 +1043,9 @@ SUBROUTINE CLDRAD ENDDO ID(1:25)=0 ITCLOD = NINT(TCLOD) - IF(ITCLOD .ne. 0) then + IF(ITCLOD /= 0) then IFINCR = MOD(IFHR,ITCLOD) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITCLOD*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITCLOD*60) ELSE IFINCR = 0 endif @@ -1053,13 +1053,13 @@ SUBROUTINE CLDRAD ID(19) = IFHR IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN !USE MIN FOR OFF-HR FORECAST ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITCLOD ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 if(grib=="grib2" )then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(300)) @@ -1119,23 +1119,23 @@ SUBROUTINE CLDRAD ENDDO ID(1:25)=0 ITCLOD = NINT(TCLOD) - IF(ITCLOD .ne. 0) then + IF(ITCLOD /= 0) then IFINCR = MOD(IFHR,ITCLOD) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITCLOD*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITCLOD*60) ELSE IFINCR = 0 endif ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN !USE MIN FOR OFF-HR FORECAST + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN !USE MIN FOR OFF-HR FORECAST ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITCLOD ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 if(grib=="grib2" )then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(301)) @@ -1156,7 +1156,7 @@ SUBROUTINE CLDRAD ENDIF ! ! HIGH CLOUD FRACTION. - IF (IGET(039).GT.0) THEN + IF (IGET(039)>0) THEN ! GRID1=SPVAL !$omp parallel do private(i,j) DO J=JSTA,JEND @@ -1196,23 +1196,23 @@ SUBROUTINE CLDRAD ENDDO ID(1:25)=0 ITCLOD = NINT(TCLOD) - IF(ITCLOD .ne. 0) then + IF(ITCLOD /= 0) then IFINCR = MOD(IFHR,ITCLOD) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITCLOD*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITCLOD*60) ELSE IFINCR = 0 endif ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN !USE MIN FOR OFF-HR FORECAST + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN !USE MIN FOR OFF-HR FORECAST ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITCLOD ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 if(grib=="grib2" )then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(302)) @@ -1269,7 +1269,7 @@ SUBROUTINE CLDRAD END IF ENDDO ENDDO - IF (IGET(161).GT.0) THEN + IF (IGET(161)>0) THEN if(grib=="grib2" )then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(161)) @@ -1303,15 +1303,15 @@ SUBROUTINE CLDRAD DO J=JSTA,JEND DO I=1,IM ! RSUM = NCFRST(I,J)+NCFRCV(I,J) -! IF (RSUM.GT.0.0) THEN +! IF (RSUM>0.0) THEN ! EGRID1(I,J)=(ACFRST(I,J)+ACFRCV(I,J))/RSUM ! ELSE ! EGRID1(I,J) = D00 ! ENDIF !ADDED BRAD'S MODIFICATION RSUM = D00 - IF (NCFRST(I,J) .GT. 0) RSUM=ACFRST(I,J)/NCFRST(I,J) - IF (NCFRCV(I,J) .GT. 0) & + IF (NCFRST(I,J) > 0) RSUM=ACFRST(I,J)/NCFRST(I,J) + IF (NCFRCV(I,J) > 0) & RSUM=MAX(RSUM, ACFRCV(I,J)/NCFRCV(I,J)) GRID1(I,J) = RSUM*100. ENDDO @@ -1320,23 +1320,23 @@ SUBROUTINE CLDRAD IF(MODELNAME == 'NMM' .OR. MODELNAME == 'GFS')THEN ID(1:25)= 0 ITCLOD = NINT(TCLOD) - IF(ITCLOD .ne. 0) then + IF(ITCLOD /= 0) then IFINCR = MOD(IFHR,ITCLOD) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITCLOD*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITCLOD*60) ELSE IFINCR = 0 endif ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN !USE MIN FOR OFF-HR FORECAST + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN !USE MIN FOR OFF-HR FORECAST ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITCLOD ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 ENDIF if(grib=="grib2" )then cfld=cfld+1 @@ -1358,13 +1358,13 @@ SUBROUTINE CLDRAD ENDIF ! ! TIME AVERAGED STRATIFORM CLOUD FRACTION. - IF (IGET(139).GT.0) THEN + IF (IGET(139)>0) THEN IF(MODELNAME /= 'NMM')THEN GRID1=SPVAL ELSE DO J=JSTA,JEND DO I=1,IM - IF (NCFRST(I,J).GT.0.0) THEN + IF (NCFRST(I,J)>0.0) THEN GRID1(I,J) = ACFRST(I,J)/NCFRST(I,J)*100. ELSE GRID1(I,J) = D00 @@ -1372,25 +1372,25 @@ SUBROUTINE CLDRAD ENDDO ENDDO END IF - IF(MODELNAME.EQ.'NMM')THEN + IF(MODELNAME=='NMM')THEN ID(1:25)=0 ITCLOD = NINT(TCLOD) - IF(ITCLOD .ne. 0) then + IF(ITCLOD /= 0) then IFINCR = MOD(IFHR,ITCLOD) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITCLOD*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITCLOD*60) ELSE IFINCR = 0 endif ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITCLOD ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 ENDIF if(grib=="grib2" )then cfld=cfld+1 @@ -1406,13 +1406,13 @@ SUBROUTINE CLDRAD ENDIF ! ! TIME AVERAGED CONVECTIVE CLOUD FRACTION. - IF (IGET(143).GT.0) THEN + IF (IGET(143)>0) THEN IF(MODELNAME /= 'NMM')THEN GRID1=SPVAL ELSE DO J=JSTA,JEND DO I=1,IM - IF (NCFRCV(I,J).GT.0.0) THEN + IF (NCFRCV(I,J)>0.0) THEN GRID1(I,J) = ACFRCV(I,J)/NCFRCV(I,J)*100. ELSE GRID1(I,J) = D00 @@ -1420,25 +1420,25 @@ SUBROUTINE CLDRAD ENDDO ENDDO END IF - IF(MODELNAME.EQ.'NMM')THEN + IF(MODELNAME=='NMM')THEN ID(1:25)=0 ITCLOD = NINT(TCLOD) - IF(ITCLOD .ne. 0) then + IF(ITCLOD /= 0) then IFINCR = MOD(IFHR,ITCLOD) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITCLOD*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITCLOD*60) ELSE IFINCR = 0 endif ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITCLOD ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 ENDIF if(grib=="grib2" )then cfld=cfld+1 @@ -1454,13 +1454,13 @@ SUBROUTINE CLDRAD ENDIF ! ! CLOUD BASE AND TOP FIELDS - IF((IGET(148).GT.0) .OR. (IGET(149).GT.0) .OR. & - (IGET(168).GT.0) .OR. (IGET(178).GT.0) .OR. & - (IGET(179).GT.0) .OR. (IGET(194).GT.0) .OR. & - (IGET(408).GT.0) .OR. & - (IGET(409).GT.0) .OR. (IGET(406).GT.0) .OR. & - (IGET(195).GT.0) .OR. (IGET(260).GT.0) .OR. & - (IGET(275).GT.0)) THEN + IF((IGET(148)>0) .OR. (IGET(149)>0) .OR. & + (IGET(168)>0) .OR. (IGET(178)>0) .OR. & + (IGET(179)>0) .OR. (IGET(194)>0) .OR. & + (IGET(408)>0) .OR. & + (IGET(409)>0) .OR. (IGET(406)>0) .OR. & + (IGET(195)>0) .OR. (IGET(260)>0) .OR. & + (IGET(275)>0)) THEN ! !--- Calculate grid-scale cloud base & top arrays (Ferrier, Feb '02) ! @@ -1481,33 +1481,33 @@ SUBROUTINE CLDRAD ITOPDCu(I,J) = 100 IBOTSCu(I,J) = 0 ITOPSCu(I,J) = 100 - if (hbot(i,j) .ne. spval) then + if (hbot(i,j) /= spval) then IBOTCu(I,J) = NINT(HBOT(I,J)) endif - if (hbotd(i,j) .ne. spval) then + if (hbotd(i,j) /= spval) then IBOTDCu(I,J) = NINT(HBOTD(I,J)) endif - if (hbots(i,j) .ne. spval) then + if (hbots(i,j) /= spval) then IBOTSCu(I,J) = NINT(HBOTS(I,J)) endif - if (htop(i,j) .ne. spval) then + if (htop(i,j) /= spval) then ITOPCu(I,J) = NINT(HTOP(I,J)) endif - if (htopd(i,j) .ne. spval) then + if (htopd(i,j) /= spval) then ITOPDCu(I,J) = NINT(HTOPD(I,J)) endif - if (htops(i,j) .ne. spval) then + if (htops(i,j) /= spval) then ITOPSCu(I,J) = NINT(HTOPS(I,J)) endif - IF (IBOTCu(I,J)-ITOPCu(I,J) .LE. 1) THEN + IF (IBOTCu(I,J)-ITOPCu(I,J) <= 1) THEN IBOTCu(I,J) = 0 ITOPCu(I,J) = 100 ENDIF - IF (IBOTDCu(I,J)-ITOPDCu(I,J) .LE. 1) THEN + IF (IBOTDCu(I,J)-ITOPDCu(I,J) <= 1) THEN IBOTDCu(I,J) = 0 ITOPDCu(I,J) = 100 ENDIF - IF (IBOTSCu(I,J)-ITOPSCu(I,J) .LE. 1) THEN + IF (IBOTSCu(I,J)-ITOPSCu(I,J) <= 1) THEN IBOTSCu(I,J) = 0 ITOPSCu(I,J) = 100 ENDIF @@ -1532,7 +1532,7 @@ SUBROUTINE CLDRAD IBOTGr(I,J)=0 DO L=NINT(LMH(I,J)),1,-1 QCLD=QQW(I,J,L)+QQI(I,J,L)+QQS(I,J,L) - IF (QCLD .GE. QCLDmin) THEN + IF (QCLD >= QCLDmin) THEN IBOTGr(I,J)=L EXIT ENDIF @@ -1540,7 +1540,7 @@ SUBROUTINE CLDRAD ITOPGr(I,J)=100 DO L=1,NINT(LMH(I,J)) QCLD=QQW(I,J,L)+QQI(I,J,L)+QQS(I,J,L) - IF (QCLD .GE. QCLDmin) THEN + IF (QCLD >= QCLDmin) THEN ITOPGr(I,J)=L EXIT ENDIF @@ -1581,7 +1581,7 @@ SUBROUTINE CLDRAD endif ! !--- Combined (convective & grid-scale) cloud base & cloud top levels - IF(MODELNAME .EQ. 'NCAR' .OR. MODELNAME == 'RAPR')THEN + IF(MODELNAME == 'NCAR' .OR. MODELNAME == 'RAPR')THEN IBOTT(I,J) = IBOTGr(I,J) ITOPT(I,J) = ITOPGr(I,J) ELSE @@ -1595,7 +1595,7 @@ SUBROUTINE CLDRAD ENDIF !--- End IF tests ! ! CONVECTIVE CLOUD TOP HEIGHT - IF (IGET(758).GT.0) THEN + IF (IGET(758)>0) THEN DO J=JSTA,JEND DO I=1,IM @@ -1615,25 +1615,25 @@ SUBROUTINE CLDRAD ! !--- "TOTAL" CLOUD BASE FIELDS (convective + grid-scale; Ferrier, Feb '02) ! - IF ((IGET(148).GT.0) .OR. (IGET(178).GT.0) .OR.(IGET(260).GT.0) ) THEN + IF ((IGET(148)>0) .OR. (IGET(178)>0) .OR.(IGET(260)>0) ) THEN DO J=JSTA,JEND DO I=1,IM IBOT=IBOTT(I,J) !-- Cloud base ("bottoms") IF(MODELNAME == 'RAPR') then - IF (IBOT .LE. 0) THEN + IF (IBOT <= 0) THEN CLDP(I,J) = SPVAL CLDZ(I,J) = SPVAL - ELSE IF (IBOT .LE. NINT(LMH(I,J))) THEN + ELSE IF (IBOT <= NINT(LMH(I,J))) THEN CLDP(I,J) = PMID(I,J,IBOT) - IF (IBOT .EQ. LM) THEN + IF (IBOT == LM) THEN CLDZ(I,J) = ZINT(I,J,LM) ELSE CLDZ(I,J) = HTM(I,J,IBOT+1)*T(I,J,IBOT+1) & *(Q(I,J,IBOT+1)*D608+H1)*ROG* & (LOG(PINT(I,J,IBOT+1))-LOG(CLDP(I,J)))& +ZINT(I,J,IBOT+1) - ENDIF !--- End IF (IBOT .EQ. LM) ... - ENDIF !--- End IF (IBOT .LE. 0) ... + ENDIF !--- End IF (IBOT == LM) ... + ENDIF !--- End IF (IBOT <= 0) ... ELSE IF (IBOT>0 .AND. IBOT<=NINT(LMH(I,J))) THEN CLDP(I,J) = PMID(I,J,IBOT) @@ -1641,12 +1641,12 @@ SUBROUTINE CLDRAD ELSE CLDP(I,J) = -50000. CLDZ(I,J) = -5000. - ENDIF !--- End IF (IBOT .LE. 0) ... + ENDIF !--- End IF (IBOT <= 0) ... ENDIF ENDDO !--- End DO I loop ENDDO !--- End DO J loop ! CLOUD BOTTOM PRESSURE - IF (IGET(148).GT.0) THEN + IF (IGET(148)>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J) = CLDP(I,J) @@ -1659,7 +1659,7 @@ SUBROUTINE CLDRAD endif ENDIF ! CLOUD BOTTOM HEIGHT - IF (IGET(178).GT.0) THEN + IF (IGET(178)>0) THEN !--- Parameter was set to 148 in operational code (Ferrier, Feb '02) DO J=JSTA,JEND DO I=1,IM @@ -1679,7 +1679,7 @@ SUBROUTINE CLDRAD ! "GSD CLOUD BOTTOM HEIGHT". An alternative (experimental) ! GSD cloud ceiling algorithm is offered further below. - IF (IGET(408).GT.0) THEN + IF (IGET(408)>0) THEN !- imported from RUC post ! -- constants for effect of snow on ceiling ! Also found in calvis.f @@ -1720,7 +1720,7 @@ SUBROUTINE CLDRAD watericemax = max(watericemax,watericetotal(k)) end do - if (watericemax.ge.cloud_def_p) then + if (watericemax>=cloud_def_p) then ! Cloud base !==================== @@ -1728,13 +1728,13 @@ SUBROUTINE CLDRAD ! --- Check out no. of points with thin cloud layers near surface do k=2,3 pabovesfc(k) = pint(i,j,lm) - pint(i,j,lm-k+1) - if (watericetotal(k).lt.cloud_def_p) then + if (watericetotal(k)cloud_def_p) then nfogn(k)= nfogn(k)+1 end if end if @@ -1743,12 +1743,12 @@ SUBROUTINE CLDRAD ! Eliminate fog layers near surface in watericetotal array loop1778 : do k=2,3 ! --- Do this only when at least 10 mb (1000 Pa) above surface -! if (pabovesfc(k).gt.1000.) then - if (watericetotal(k).lt.cloud_def_p) then - if (watericetotal(1).gt.cloud_def_p) then +! if (pabovesfc(k)>1000.) then + if (watericetotal(k)cloud_def_p) then nfog = nfog+1 do k1=1,k-1 - if (watericetotal(k1).ge.cloud_def_p) then + if (watericetotal(k1)>=cloud_def_p) then watericetotal(k1)=0. end if end do @@ -1760,15 +1760,15 @@ SUBROUTINE CLDRAD !! At surface? !commented out 16aug11 -! if (watericetotal(1).gt.cloud_def_p) then +! if (watericetotal(1)>cloud_def_p) then ! zcldbase = zmid(i,j,lm) ! go to 3788 ! end if !! Aloft? loop371: do k=2,lm k1 = k - if (watericetotal(k).gt.cloud_def_p) then - if (k1.le.4) then + if (watericetotal(k)>cloud_def_p) then + if (k1<=4) then ! -- If within 4 levels of surface, just use lowest cloud level ! as ceiling WITHOUT vertical interpolation. zcldbase = zmid(i,j,lm-k1+1) @@ -1788,18 +1788,18 @@ SUBROUTINE CLDRAD ! -- consider lowering of ceiling due to falling snow ! -- extracted from calvis.f (visibility diagnostic) - if (QQS(i,j,LM).gt.0.) then + if (QQS(i,j,LM)>0.) then TV=T(I,J,lm)*(H1+D608*Q(I,J,lm)) RHOAIR=PMID(I,J,lm)/(RD*TV) vovermd = (1.+Q(i,j,LM))/rhoair + QQS(i,j,LM)/rhoice concfp = QQS(i,j,LM)/vovermd*1000. betav = coeffp*concfp**exponfp + 1.e-10 vertvis = 1000.*min(90., const1/betav) - if (vertvis .lt. zcldbase-FIS(I,J)*GI ) then + if (vertvis < zcldbase-FIS(I,J)*GI ) then zcldbase = FIS(I,J)*GI + vertvis loop3741: do k2=2,LM k1 = k2 - if (ZMID(i,j,lm-k2+1) .gt. zcldbase) then + if (ZMID(i,j,lm-k2+1) > zcldbase) then pcldbase = pmid(i,j,lm-k1+2) + (zcldbase-ZMID(i,j,lm-k1+2)) & *(pmid(i,j,lm-k1+1)-pmid(i,j,lm-k1+2) ) & /(zmid(i,j,lm-k1+1)-zmid(i,j,lm-k1+2) ) @@ -1853,16 +1853,16 @@ SUBROUTINE CLDRAD ! 1 I,J,k1,zmid(i,j,lm-k1+1),zmid(i,j,lm-k1),PBLH(I,J),RHB(k1) loop745: do k2=3,20 - if (zpbltop.lt.ZMID(i,j,LM-k2+1)) then - if (rhb(k2-1).gt.95. ) then + if (zpbltop95. ) then zcldbase = ZMID(i,j,LM-k2+2) - if (CLDZ(i,j).lt.-100.) then + if (CLDZ(i,j)<-100.) then npblcld = npblcld+1 CLDZ(i,j) = zcldbase CLDP(I,J) = PMID(i,j,LM-k2+2) exit loop745 end if - if ( zcldbase.lt.CLDZ(I,J)) then + if ( zcldbase0) then + if(CLDZ(I,J)<-100.) then CLDZ(I,J)=ZMID(I,J,IBOT) else - if(ZMID(I,J,IBOT).lt.CLDZ(I,J)) then + if(ZMID(I,J,IBOT)=0..and.zcld<160.) nlifr = nlifr+1 end do end do write(6,*)'No. pts w/ LIFR ceiling =',nlifr ! GSD CLOUD BOTTOM HEIGHTS - IF (IGET(408).GT.0) THEN + IF (IGET(408)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -1918,7 +1918,7 @@ SUBROUTINE CLDRAD ! BEGIN EXPERIMENTAL GSD CEILING DIAGNOSTICS... ! J. Kenyon, 4 Feb 2017: this approach uses model-state cloud fractions - IF (IGET(487).GT.0) THEN + IF (IGET(487)>0) THEN ! set some constants for ceiling adjustment in snow (retained from legacy algorithm, also in calvis.f) rhoice = 970. coeffp = 10.36 @@ -1938,15 +1938,15 @@ SUBROUTINE CLDRAD cldfra_max = max(cldfra_max,cldfra(k)) ! determine the column-maximum cloud fraction end do - if (cldfra_max .ge. ceiling_thresh_cldfra) then ! threshold cloud fraction found in column, get ceiling + if (cldfra_max >= ceiling_thresh_cldfra) then ! threshold cloud fraction found in column, get ceiling ! threshold cloud fraction (possible ceiling) found somewhere in column, so proceed... ! first, search for and eliminate fog layers near surface (retained from legacy diagnostic) do k=2,3 ! Ming, k=3 will never be reached in this logic - if (cldfra(k) .lt. ceiling_thresh_cldfra) then ! these two lines: - if (cldfra(1) .gt. ceiling_thresh_cldfra) then ! ...look for surface-based fog beneath less-cloudy layers + if (cldfra(k) < ceiling_thresh_cldfra) then ! these two lines: + if (cldfra(1) > ceiling_thresh_cldfra) then ! ...look for surface-based fog beneath less-cloudy layers do k1=1,k-1 ! now perform the clearing for k=1 up to k-1 - if (cldfra(k1) .ge. ceiling_thresh_cldfra) then + if (cldfra(k1) >= ceiling_thresh_cldfra) then cldfra(k1)=0. end if end do @@ -1960,8 +1960,8 @@ SUBROUTINE CLDRAD ceil(I,J) = zceil ! default is no ceiling found loop471:do k=2,lm k1 = k - if (cldfra(k) .ge. ceiling_thresh_cldfra) then ! go to 472 ! found ceiling - if (k1 .le. 4) then ! within 4 levels of surface, no interpolation + if (cldfra(k) >= ceiling_thresh_cldfra) then ! go to 472 ! found ceiling + if (k1 <= 4) then ! within 4 levels of surface, no interpolation zceil = zmid(i,j,lm-k1+1) else ! use linear interpolation zceil = zmid(i,j,lm-k1+1) + (ceiling_thresh_cldfra-cldfra(k1)) & @@ -1972,23 +1972,23 @@ SUBROUTINE CLDRAD ! consider lowering of ceiling due to falling snow (retained from legacy diagnostic) ! ...this is extracted from calvis.f (visibility diagnostic) - if (QQS(i,j,LM).gt.0.) then + if (QQS(i,j,LM)>0.) then TV=T(I,J,lm)*(H1+D608*Q(I,J,lm)) RHOAIR=PMID(I,J,lm)/(RD*TV) vovermd = (1.+Q(i,j,LM))/rhoair + QQS(i,j,LM)/rhoice concfp = QQS(i,j,LM)/vovermd*1000. betav = coeffp*concfp**exponfp + 1.e-10 vertvis = 1000.*min(90., const1/betav) - if (vertvis .lt. zceil-FIS(I,J)*GI ) then + if (vertvis < zceil-FIS(I,J)*GI ) then zceil = FIS(I,J)*GI + vertvis do k2=2,LM k1 = k2 - if (ZMID(i,j,lm-k2+1) .gt. zceil) cycle loop471 + if (ZMID(i,j,lm-k2+1) > zceil) cycle loop471 end do exit loop471 end if end if - endif ! cldfra(k) .ge. ceiling_thresh_cldfra + endif ! cldfra(k) >= ceiling_thresh_cldfra end do loop471 else @@ -2019,7 +2019,7 @@ SUBROUTINE CLDRAD ! the GSD cloud-base height, and parameter 798 will be the ! corresponding cloud-base pressure. (J. Kenyon, 4 Nov 2019) - IF ((IGET(711).GT.0) .OR. (IGET(798).GT.0)) THEN + IF ((IGET(711)>0) .OR. (IGET(798)>0)) THEN ! set minimum cloud fraction to represent a ceiling ceiling_thresh_cldfra = 0.4 ! set some constants for ceiling adjustment in snow (retained from legacy algorithm, also in calvis.f) @@ -2046,9 +2046,9 @@ SUBROUTINE CLDRAD ! less-cloudy layers. We will regard these ! instances as surface-based fog, too thin ! to impose a ceiling. - if (cldfra(1) .ge. ceiling_thresh_cldfra) then ! possible thin fog; look higher + if (cldfra(1) >= ceiling_thresh_cldfra) then ! possible thin fog; look higher do k=2,3 - if (cldfra(k) .lt. 0.6) then ! confirmed thin fog, extending just below k + if (cldfra(k) < 0.6) then ! confirmed thin fog, extending just below k cldfra(1:k-1) = 0.0 ! clear fog up to k-1 end if end do @@ -2056,8 +2056,8 @@ SUBROUTINE CLDRAD !-- Search 1: no summation principle do k=2,lm - if (cldfra(k) .ge. ceiling_thresh_cldfra) then ! found ceiling - if (k .le. 4) then ! within 4 levels of surface, no interpolation + if (cldfra(k) >= ceiling_thresh_cldfra) then ! found ceiling + if (k <= 4) then ! within 4 levels of surface, no interpolation zceil1 = zmid(i,j,lm-k+1) else zceil1 = zmid(i,j,lm-k+1) + (ceiling_thresh_cldfra-cldfra(k)) & @@ -2085,13 +2085,13 @@ SUBROUTINE CLDRAD cfr_layer_sum(1:lm)=0.0 ! initialize a column of zeros previous_sum=0.0 do k=4,lm-1 - if ( (cldfra(k) .ge. 0.05 ) .and. & ! criterion 1 - (cldfra(k) .gt. cldfra(k-1)) .and. & ! criterion 2 - (cldfra(k) .ge. cldfra(k+1)) ) & ! criterion 3 + if ( (cldfra(k) >= 0.05 ) .and. & ! criterion 1 + (cldfra(k) > cldfra(k-1)) .and. & ! criterion 2 + (cldfra(k) >= cldfra(k+1)) ) & ! criterion 3 ! Explanation, by criterion: ! (1) a reasonably large cloud fraction exists, - ! (2) the cloud fraction is .GT. the adjoining cloud fraction below, - ! (3) the cloud fraction is .GE. the adjoining cloud fraction above (note that .GE. + ! (2) the cloud fraction is > the adjoining cloud fraction below, + ! (3) the cloud fraction is >= the adjoining cloud fraction above (note that >= ! is used here, in case k is the lowest of several overcast model layers) then ! If all criteria satisfied, then we will consider the local-maximum cldfra(k) as @@ -2100,7 +2100,7 @@ SUBROUTINE CLDRAD cfr_layer_sum(k) = min(1.0, previous_sum + cldfra(k)) previous_sum = min(1.0, cfr_layer_sum(k)) - if (cfr_layer_sum(k) .ge. ceiling_thresh_cldfra) then + if (cfr_layer_sum(k) >= ceiling_thresh_cldfra) then zceil2 = zmid(i,j,lm-k+1) + (ceiling_thresh_cldfra-cfr_layer_sum(k)) & * (zmid(i,j,lm-k+2)-zmid(i,j,lm-k+1)) & / (cfr_layer_sum(k-1) - cfr_layer_sum(k)) @@ -2116,14 +2116,14 @@ SUBROUTINE CLDRAD !-- Search for "indefinite ceiling" (vertical visibility) conditions: consider ! lowering of apparent ceiling due to falling snow (retained from legacy ! diagnostic); this is extracted from calvis.f (visibility diagnostic) - if (QQS(i,j,LM).gt.1.e-10) then + if (QQS(i,j,LM)>1.e-10) then TV=T(I,J,lm)*(H1+D608*Q(I,J,lm)) RHOAIR=PMID(I,J,lm)/(RD*TV) vovermd = (1.+Q(i,j,LM))/rhoair + QQS(i,j,LM)/rhoice concfp = QQS(i,j,LM)/vovermd*1000. betav = coeffp*concfp**exponfp + 1.e-10 vertvis = 1000.*min(90., const1/betav) - if (vertvis .lt. zceil-FIS(I,J)*GI ) then ! if vertvis is more restictive than zceil found above; set zceil to vertvis + if (vertvis < zceil-FIS(I,J)*GI ) then ! if vertvis is more restictive than zceil found above; set zceil to vertvis ! note that FIS is geopotential of the surface (ground), and GI is 1/g zceil = FIS(I,J)*GI + vertvis end if @@ -2159,7 +2159,7 @@ SUBROUTINE CLDRAD CLDZ(I,J) = max(min(CLDZ(I,J), 20000.0),0.0) !set bounds ! find pressure at CLDZ do k=1,lm-2 - if ( zmid(i,j,lm-k+1) .ge. CLDZ(i,j) ) then + if ( zmid(i,j,lm-k+1) >= CLDZ(i,j) ) then CLDP(I,J) = pmid(i,j,lm-k+2) + (CLDZ(i,j)-zmid(i,j,lm-k+2)) & *(pmid(i,j,lm-k+1)-pmid(i,j,lm-k+2) ) & /(zmid(i,j,lm-k+1)-zmid(i,j,lm-k+2) ) @@ -2170,7 +2170,7 @@ SUBROUTINE CLDRAD ENDDO ! GSD CLOUD BOTTOM HEIGHT - IF (IGET(711).GT.0) THEN + IF (IGET(711)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -2185,7 +2185,7 @@ SUBROUTINE CLDRAD ENDIF ! GSD CLOUD BOTTOM PRESSURE - IF (IGET(798).GT.0) THEN + IF (IGET(798)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -2203,7 +2203,7 @@ SUBROUTINE CLDRAD ! END OF EXPERIMENTAL GSD CEILING DIAGNOSTICS ! B. ZHOU: CEILING - IF (IGET(260).GT.0) THEN + IF (IGET(260)>0) THEN CALL CALCEILING(CLDZ,TCLD,CEILING) DO J=JSTA,JEND DO I=1,IM @@ -2251,7 +2251,7 @@ SUBROUTINE CLDRAD DO J=JSTA,JEND DO I=1,IM IBOT=IBOTCu(I,J) - IF (IBOT.GT.0 .AND. IBOT.LE.NINT(LMH(I,J))) THEN + IF (IBOT>0 .AND. IBOT<=NINT(LMH(I,J))) THEN GRID1(I,J) = PMID(I,J,IBOT) ELSE GRID1(I,J) = -50000. @@ -2274,11 +2274,11 @@ SUBROUTINE CLDRAD ! !--- Deep convective cloud base pressures (Ferrier, Feb '02) ! - IF (IGET(192) .GT. 0) THEN + IF (IGET(192) > 0) THEN DO J=JSTA,JEND DO I=1,IM IBOT=IBOTDCu(I,J) - IF (IBOT.GT.0 .AND. IBOT.LE.NINT(LMH(I,J))) THEN + IF (IBOT>0 .AND. IBOT<=NINT(LMH(I,J))) THEN GRID1(I,J) = PMID(I,J,IBOT) ELSE GRID1(I,J) = -50000. @@ -2293,11 +2293,11 @@ SUBROUTINE CLDRAD ENDIF !--- Shallow convective cloud base pressures (Ferrier, Feb '02) ! - IF (IGET(190) .GT. 0) THEN + IF (IGET(190) > 0) THEN DO J=JSTA,JEND DO I=1,IM IBOT=IBOTSCu(I,J) - IF (IBOT.GT.0 .AND. IBOT.LE.NINT(LMH(I,J))) THEN + IF (IBOT>0 .AND. IBOT<=NINT(LMH(I,J))) THEN GRID1(I,J) = PMID(I,J,IBOT) ELSE GRID1(I,J) = -50000. @@ -2312,11 +2312,11 @@ SUBROUTINE CLDRAD ENDIF !--- Base of grid-scale cloudiness (Ferrier, Feb '02) ! - IF (IGET(194) .GT. 0) THEN + IF (IGET(194) > 0) THEN DO J=JSTA,JEND DO I=1,IM IBOT=IBOTGr(I,J) - IF (IBOT.GT.0 .AND. IBOT.LE.NINT(LMH(I,J))) THEN + IF (IBOT>0 .AND. IBOT<=NINT(LMH(I,J))) THEN GRID1(I,J) = PMID(I,J,IBOT) ELSE GRID1(I,J) = -50000. @@ -2332,7 +2332,7 @@ SUBROUTINE CLDRAD !--- Base of low cloud ! - IF (IGET(303) .GT. 0) THEN + IF (IGET(303) > 0) THEN DO J=JSTA,JEND DO I=1,IM ! IF(PBOTL(I,J) > SMALL)THEN @@ -2344,22 +2344,22 @@ SUBROUTINE CLDRAD ENDDO ID(1:25)=0 ITCLOD = NINT(TCLOD) - IF(ITCLOD .ne. 0) then + IF(ITCLOD /= 0) then IFINCR = MOD(IFHR,ITCLOD) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITCLOD*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITCLOD*60) ELSE IFINCR = 0 ENDIF ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITCLOD ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 if(grib=="grib2" )then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(303)) @@ -2375,7 +2375,7 @@ SUBROUTINE CLDRAD ENDIF !--- Base of middle cloud ! - IF (IGET(306) .GT. 0) THEN + IF (IGET(306) > 0) THEN DO J=JSTA,JEND DO I=1,IM IF(PBOTM(I,J) > SMALL)THEN @@ -2387,22 +2387,22 @@ SUBROUTINE CLDRAD ENDDO ID(1:25)=0 ITCLOD = NINT(TCLOD) - IF(ITCLOD .ne. 0) then + IF(ITCLOD /= 0) then IFINCR = MOD(IFHR,ITCLOD) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITCLOD*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITCLOD*60) ELSE IFINCR = 0 ENDIF ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITCLOD ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 if(grib=="grib2" )then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(306)) @@ -2418,7 +2418,7 @@ SUBROUTINE CLDRAD ENDIF !--- Base of high cloud ! - IF (IGET(309) .GT. 0) THEN + IF (IGET(309) > 0) THEN DO J=JSTA,JEND DO I=1,IM IF(PBOTH(I,J) > SMALL)THEN @@ -2430,22 +2430,22 @@ SUBROUTINE CLDRAD ENDDO ID(1:25)=0 ITCLOD = NINT(TCLOD) - IF(ITCLOD .ne. 0) then + IF(ITCLOD /= 0) then IFINCR = MOD(IFHR,ITCLOD) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITCLOD*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITCLOD*60) ELSE IFINCR = 0 ENDIF ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITCLOD ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 if(grib=="grib2" )then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(309)) @@ -2466,8 +2466,8 @@ SUBROUTINE CLDRAD ! !--- "TOTAL" CLOUD TOP FIELDS (convective + grid-scale; Ferrier, Feb '02) ! - IF ((IGET(149).GT.0) .OR. (IGET(179).GT.0) .OR. & - (IGET(168).GT.0) .OR. (IGET(275).GT.0)) THEN + IF ((IGET(149)>0) .OR. (IGET(179)>0) .OR. & + (IGET(168)>0) .OR. (IGET(275)>0)) THEN DO J=JSTA,JEND DO I=1,IM ITOP=ITOPT(I,J) @@ -2484,13 +2484,13 @@ SUBROUTINE CLDRAD CLDZ(I,J) = -5000. ENDIF CLDT(I,J) = -500. - ENDIF !--- End IF (ITOP.GT.0 .AND. ITOP.LE.LMH(I,J)) ... + ENDIF !--- End IF (ITOP>0 .AND. ITOP<=LMH(I,J)) ... ENDDO !--- End DO I loop ENDDO !--- End DO J loop ! ! CLOUD TOP PRESSURE ! - IF (IGET(149).GT.0) THEN + IF (IGET(149)>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J) = CLDP(I,J) @@ -2504,7 +2504,7 @@ SUBROUTINE CLDRAD ENDIF ! CLOUD TOP HEIGHT ! - IF (IGET(179).GT.0) THEN + IF (IGET(179)>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J) = CLDZ(I,J) @@ -2519,7 +2519,7 @@ SUBROUTINE CLDRAD ENDIF ! GSD COULD TOP HEIGHTS AND PRESSURE - IF ((IGET(409).GT.0) .OR. (IGET(406).GT.0)) THEN + IF ((IGET(409)>0) .OR. (IGET(406)>0)) THEN Cloud_def_p = 0.0000001 @@ -2534,9 +2534,9 @@ SUBROUTINE CLDRAD watericetotal(k) = QQW(i,j,ll) + QQI(i,j,ll) enddo - if (watericetotal(LM).le.cloud_def_p) then + if (watericetotal(LM)<=cloud_def_p) then loop373 : do k=LM-1,2,-1 - if (watericetotal(k).gt.cloud_def_p) then + if (watericetotal(k)>cloud_def_p) then zcldtop = zmid(i,j,lm-k+1) + (cloud_def_p-watericetotal(k)) & * (zmid(i,j,lm-k)-zmid(i,j,lm-k+1)) & / (watericetotal(k+1) - watericetotal(k)) @@ -2548,7 +2548,7 @@ SUBROUTINE CLDRAD end if ITOP=ITOPT(I,J) - IF (ITOP.GT.0 .AND. ITOP.LE.NINT(LMH(I,J))) THEN + IF (ITOP>0 .AND. ITOP<=NINT(LMH(I,J))) THEN CLDP(I,J) = PMID(I,J,ITOP) CLDT(I,J) = T(I,J,ITOP) ELSE @@ -2556,17 +2556,17 @@ SUBROUTINE CLDRAD IF(MODELNAME == 'RAPR') CLDP(I,J) = SPVAL ! CLDZ(I,J) = -5000. CLDT(I,J) = -500. - ENDIF !--- End IF (ITOP.GT.0 .AND. ITOP.LE.LMH(I,J)) ... + ENDIF !--- End IF (ITOP>0 .AND. ITOP<=LMH(I,J)) ... !- include convective clouds ITOP=ITOPCu(I,J) - if(ITOP.lt.lm+1) then + if(ITOPzcldtop) then ! print *,'change cloud top for convective cloud, zcldtop, ! 1 ZMID(I,J,ITOP),ITOP,i,j' ! 1 ,zcldtop,ZMID(I,J,ITOP),ITOP,i,j @@ -2575,7 +2575,7 @@ SUBROUTINE CLDRAD endif ! check consistency of cloud base and cloud top - if(CLDZ(I,J).gt.-100. .and. zcldtop.lt.-100.) then + if(CLDZ(I,J)>-100. .and. zcldtop<-100.) then zcldtop = CLDZ(I,J) + 200. endif @@ -2586,7 +2586,7 @@ SUBROUTINE CLDRAD ! ! GSD CLOUD TOP PRESSURE ! - IF (IGET(406).GT.0) THEN + IF (IGET(406)>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J) = CLDP(I,J) @@ -2600,7 +2600,7 @@ SUBROUTINE CLDRAD ENDIF ! GSD CLOUD TOP HEIGHT ! - IF (IGET(409).GT.0) THEN + IF (IGET(409)>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J) = CLDZ(I,J) @@ -2616,7 +2616,7 @@ SUBROUTINE CLDRAD ! ! CLOUD TOP TEMPS ! - IF (IGET(168).GT.0) THEN + IF (IGET(168)>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J) = CLDT(I,J) @@ -2630,7 +2630,7 @@ SUBROUTINE CLDRAD ENDIF ! !huang CLOUD TOP BRIGHTNESS TEMPERATURE - IF (IGET(275).GT.0) THEN + IF (IGET(275)>0) THEN num_thick=0 ! for debug GRID1=spval DO J=JSTA,JEND @@ -2677,7 +2677,7 @@ SUBROUTINE CLDRAD !! k=0 !! 20 opdepthu=opdepthd !! k=k+1 -!!! if(k.eq.1) then +!!! if(k==1) then !!! dp=pint(i,j,itop+k)-pmid(i,j,itop) !!! opdepthd=opdepthu+(abscoef*(0.75*qqw(i,j,itop)+ !!! & 0.25*qqw(i,j,itop+1))+abscoefi* @@ -2690,16 +2690,16 @@ SUBROUTINE CLDRAD !!! end if !! !! lmhh=nint(lmh(i,j)) -!! if (opdepthd.lt.1..and. k.lt.lmhh) then +!! if (opdepthd<1..and. k=prs(i,j,k-1).and.prsctt<=prs(i,j,k)) then !!! fac=(prsctt-prs(i,j,k-1))/(prs(i,j,k)-prs(i,j,k-1)) !!! ctt(i,j)=tmk(i,j,k-1)+ !!! & fac*(tmk(i,j,k)-tmk(i,j,k-1))-celkel @@ -2742,7 +2742,7 @@ SUBROUTINE CLDRAD DO J=JSTA,JEND DO I=1,IM ITOP=ITOPCu(I,J) - IF (ITOP.GT.0 .AND. ITOP.LE.NINT(LMH(I,J))) THEN + IF (ITOP>0 .AND. ITOP<=NINT(LMH(I,J))) THEN GRID1(I,J) = PMID(I,J,ITOP) ELSE GRID1(I,J) = -50000. @@ -2765,11 +2765,11 @@ SUBROUTINE CLDRAD ! !--- Deep convective cloud top pressures (Ferrier, Feb '02) ! - IF (IGET(193) .GT. 0) THEN + IF (IGET(193) > 0) THEN DO J=JSTA,JEND DO I=1,IM ITOP=ITOPDCu(I,J) - IF (ITOP.GT.0 .AND. ITOP.LE.NINT(LMH(I,J))) THEN + IF (ITOP>0 .AND. ITOP<=NINT(LMH(I,J))) THEN GRID1(I,J) = PMID(I,J,ITOP) ELSE GRID1(I,J) = -50000. @@ -2784,11 +2784,11 @@ SUBROUTINE CLDRAD END IF !--- Shallow convective cloud top pressures (Ferrier, Feb '02) ! - IF (IGET(191) .GT. 0) THEN + IF (IGET(191) > 0) THEN DO J=JSTA,JEND DO I=1,IM ITOP=ITOPSCu(I,J) - IF (ITOP.GT.0 .AND. ITOP.LE.NINT(LMH(I,J))) THEN + IF (ITOP>0 .AND. ITOP<=NINT(LMH(I,J))) THEN GRID1(I,J) = PMID(I,J,ITOP) ELSE GRID1(I,J) = -50000. @@ -2804,11 +2804,11 @@ SUBROUTINE CLDRAD ! !--- Top of grid-scale cloudiness (Ferrier, Feb '02) ! - IF (IGET(195) .GT. 0) THEN + IF (IGET(195) > 0) THEN DO J=JSTA,JEND DO I=1,IM ITOP=ITOPGr(I,J) - IF (ITOP.GT.0 .AND. ITOP.LE.NINT(LMH(I,J))) THEN + IF (ITOP>0 .AND. ITOP<=NINT(LMH(I,J))) THEN GRID1(I,J) = PMID(I,J,ITOP) ELSE GRID1(I,J) = -50000. @@ -2824,7 +2824,7 @@ SUBROUTINE CLDRAD !--- top of low cloud ! - IF (IGET(304) .GT. 0) THEN + IF (IGET(304) > 0) THEN DO J=JSTA,JEND DO I=1,IM IF(PTOPL(I,J) > SMALL)THEN @@ -2836,22 +2836,22 @@ SUBROUTINE CLDRAD ENDDO ID(1:25)=0 ITCLOD = NINT(TCLOD) - IF(ITCLOD .ne. 0) then + IF(ITCLOD /= 0) then IFINCR = MOD(IFHR,ITCLOD) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITCLOD*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITCLOD*60) ELSE IFINCR = 0 ENDIF ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITCLOD ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 if(grib=="grib2" )then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(304)) @@ -2867,7 +2867,7 @@ SUBROUTINE CLDRAD ENDIF !--- top of middle cloud ! - IF (IGET(307) .GT. 0) THEN + IF (IGET(307) > 0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J) = PTOPM(I,J) @@ -2875,22 +2875,22 @@ SUBROUTINE CLDRAD ENDDO ID(1:25)=0 ITCLOD = NINT(TCLOD) - IF(ITCLOD .ne. 0) then + IF(ITCLOD /= 0) then IFINCR = MOD(IFHR,ITCLOD) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITCLOD*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITCLOD*60) ELSE IFINCR = 0 ENDIF ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITCLOD ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 if(grib=="grib2" )then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(307)) @@ -2906,7 +2906,7 @@ SUBROUTINE CLDRAD ENDIF !--- top of high cloud ! - IF (IGET(310) .GT. 0) THEN + IF (IGET(310) > 0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J) = PTOPH(I,J) @@ -2914,22 +2914,22 @@ SUBROUTINE CLDRAD ENDDO ID(1:25)=0 ITCLOD = NINT(TCLOD) - IF(ITCLOD .ne. 0) then + IF(ITCLOD /= 0) then IFINCR = MOD(IFHR,ITCLOD) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITCLOD*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITCLOD*60) ELSE IFINCR = 0 ENDIF ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITCLOD ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 if(grib=="grib2" )then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(310)) @@ -2946,7 +2946,7 @@ SUBROUTINE CLDRAD !--- T of low cloud top ! - IF (IGET(305) .GT. 0) THEN + IF (IGET(305) > 0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J) = TTOPL(I,J) @@ -2954,22 +2954,22 @@ SUBROUTINE CLDRAD ENDDO ID(1:25)=0 ITCLOD = NINT(TCLOD) - IF(ITCLOD .ne. 0) then + IF(ITCLOD /= 0) then IFINCR = MOD(IFHR,ITCLOD) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITCLOD*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITCLOD*60) ELSE IFINCR = 0 ENDIF ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITCLOD ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 if(grib=="grib2" )then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(305)) @@ -2985,7 +2985,7 @@ SUBROUTINE CLDRAD ENDIF !--- Base of middle cloud ! - IF (IGET(308) .GT. 0) THEN + IF (IGET(308) > 0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J) = TTOPM(I,J) @@ -2993,22 +2993,22 @@ SUBROUTINE CLDRAD ENDDO ID(1:25)=0 ITCLOD = NINT(TCLOD) - IF(ITCLOD .ne. 0) then + IF(ITCLOD /= 0) then IFINCR = MOD(IFHR,ITCLOD) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITCLOD*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITCLOD*60) ELSE IFINCR = 0 ENDIF ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITCLOD ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 if(grib=="grib2" )then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(308)) @@ -3024,7 +3024,7 @@ SUBROUTINE CLDRAD ENDIF !--- Base of high cloud ! - IF (IGET(311) .GT. 0) THEN + IF (IGET(311) > 0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J) = TTOPH(I,J) @@ -3032,22 +3032,22 @@ SUBROUTINE CLDRAD ENDDO ID(1:25)=0 ITCLOD = NINT(TCLOD) - IF(ITCLOD .ne. 0) then + IF(ITCLOD /= 0) then IFINCR = MOD(IFHR,ITCLOD) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITCLOD*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITCLOD*60) ELSE IFINCR = 0 ENDIF ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITCLOD ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 if(grib=="grib2" )then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(311)) @@ -3063,7 +3063,7 @@ SUBROUTINE CLDRAD ! !--- Convective cloud fractions from modified Slingo (1987) ! - IF (IGET(196) .GT. 0.or.IGET(570)>0) THEN + IF (IGET(196) > 0.or.IGET(570)>0) THEN GRID1=SPVAL DO J=JSTA,JEND DO I=1,IM @@ -3087,7 +3087,7 @@ SUBROUTINE CLDRAD ! !--- Boundary layer cloud fractions ! - IF (IGET(342) .GT. 0) THEN + IF (IGET(342) > 0) THEN GRID1=SPVAL DO J=JSTA,JEND DO I=1,IM @@ -3096,22 +3096,22 @@ SUBROUTINE CLDRAD ENDDO ID(1:25)=0 ITCLOD = NINT(TCLOD) - IF(ITCLOD .ne. 0) then + IF(ITCLOD /= 0) then IFINCR = MOD(IFHR,ITCLOD) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITCLOD*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITCLOD*60) ELSE IFINCR = 0 ENDIF ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITCLOD ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 if(grib=="grib2" )then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(342)) @@ -3128,7 +3128,7 @@ SUBROUTINE CLDRAD ! !--- Cloud work function ! - IF (IGET(313) .GT. 0) THEN + IF (IGET(313) > 0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=cldwork(I,J) @@ -3136,22 +3136,22 @@ SUBROUTINE CLDRAD ENDDO ID(1:25)=0 ITCLOD = NINT(TCLOD) - IF(ITCLOD .ne. 0) then + IF(ITCLOD /= 0) then IFINCR = MOD(IFHR,ITCLOD) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITCLOD*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITCLOD*60) ELSE IFINCR = 0 ENDIF ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITCLOD ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 if(grib=="grib2" )then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(313)) @@ -3170,13 +3170,13 @@ SUBROUTINE CLDRAD ! ! ! TIME AVERAGED SURFACE SHORT WAVE INCOMING RADIATION. - IF (IGET(126).GT.0) THEN - IF(MODELNAME .EQ. 'NCAR'.OR.MODELNAME.EQ.'RSM' .OR. MODELNAME == 'RAPR')THEN + IF (IGET(126)>0) THEN + IF(MODELNAME == 'NCAR'.OR.MODELNAME=='RSM' .OR. MODELNAME == 'RAPR')THEN GRID1=SPVAL ID(1:25)=0 ELSE ! print*,'ARDSW in CLDRAD=',ARDSW - IF(ARDSW.GT.0.)THEN + IF(ARDSW>0.)THEN RRNUM=1./ARDSW ELSE RRNUM=0. @@ -3192,22 +3192,22 @@ SUBROUTINE CLDRAD ENDDO ID(1:25)=0 ITRDSW = NINT(TRDSW) - IF(ITRDSW .ne. 0) then + IF(ITRDSW /= 0) then IFINCR = MOD(IFHR,ITRDSW) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITRDSW*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITRDSW*60) ELSE IFINCR = 0 endif ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITRDSW ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 END IF if(grib=="grib2" )then cfld=cfld+1 @@ -3223,13 +3223,13 @@ SUBROUTINE CLDRAD ENDIF ! ! TIME AVERAGED SURFACE UV-B INCOMING RADIATION. - IF (IGET(298).GT.0) THEN - IF(MODELNAME .EQ. 'NCAR'.OR.MODELNAME.EQ.'RSM' .OR. MODELNAME == 'RAPR')THEN + IF (IGET(298)>0) THEN + IF(MODELNAME == 'NCAR'.OR.MODELNAME=='RSM' .OR. MODELNAME == 'RAPR')THEN GRID1=SPVAL ID(1:25)=0 ELSE ! print*,'ARDSW in CLDRAD=',ARDSW - IF(ARDSW.GT.0.)THEN + IF(ARDSW>0.)THEN RRNUM=1./ARDSW ELSE RRNUM=0. @@ -3246,22 +3246,22 @@ SUBROUTINE CLDRAD ID(1:25)=0 ID(02)=129 ITRDSW = NINT(TRDSW) - IF(ITRDSW .ne. 0) then + IF(ITRDSW /= 0) then IFINCR = MOD(IFHR,ITRDSW) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITRDSW*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITRDSW*60) ELSE IFINCR = 0 endif ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITRDSW ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 END IF if(grib=="grib2" )then cfld=cfld+1 @@ -3277,13 +3277,13 @@ SUBROUTINE CLDRAD ENDIF ! ! TIME AVERAGED SURFACE UV-B CLEAR SKY INCOMING RADIATION. - IF (IGET(297).GT.0) THEN - IF(MODELNAME .EQ. 'NCAR'.OR.MODELNAME.EQ.'RSM' .OR. MODELNAME == 'RAPR')THEN + IF (IGET(297)>0) THEN + IF(MODELNAME == 'NCAR'.OR.MODELNAME=='RSM' .OR. MODELNAME == 'RAPR')THEN GRID1=SPVAL ID(1:25)=0 ELSE ! print*,'ARDSW in CLDRAD=',ARDSW - IF(ARDSW.GT.0.)THEN + IF(ARDSW>0.)THEN RRNUM=1./ARDSW ELSE RRNUM=0. @@ -3300,22 +3300,22 @@ SUBROUTINE CLDRAD ID(1:25)=0 ID(02)=129 ITRDSW = NINT(TRDSW) - IF(ITRDSW .ne. 0) then + IF(ITRDSW /= 0) then IFINCR = MOD(IFHR,ITRDSW) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITRDSW*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITRDSW*60) ELSE IFINCR = 0 endif ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITRDSW ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 END IF if(grib=="grib2" )then cfld=cfld+1 @@ -3331,12 +3331,12 @@ SUBROUTINE CLDRAD ENDIF ! ! TIME AVERAGED SURFACE LONG WAVE INCOMING RADIATION. - IF (IGET(127).GT.0) THEN - IF(MODELNAME .EQ. 'NCAR'.OR.MODELNAME.EQ.'RSM' .OR. MODELNAME == 'RAPR')THEN + IF (IGET(127)>0) THEN + IF(MODELNAME == 'NCAR'.OR.MODELNAME=='RSM' .OR. MODELNAME == 'RAPR')THEN GRID1=SPVAL ID(1:25)=0 ELSE - IF(ARDLW.GT.0.)THEN + IF(ARDLW>0.)THEN RRNUM=1./ARDLW ELSE RRNUM=0. @@ -3352,22 +3352,22 @@ SUBROUTINE CLDRAD ENDDO ID(1:25)=0 ITRDLW = NINT(TRDLW) - IF(ITRDLW .ne. 0) then + IF(ITRDLW /= 0) then IFINCR = MOD(IFHR,ITRDLW) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITRDLW*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITRDLW*60) ELSE IFINCR = 0 endif ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITRDLW ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 END IF if(grib=="grib2" )then cfld=cfld+1 @@ -3383,12 +3383,12 @@ SUBROUTINE CLDRAD ENDIF ! ! TIME AVERAGED SURFACE SHORT WAVE OUTGOING RADIATION. - IF (IGET(128).GT.0) THEN - IF(MODELNAME .EQ. 'NCAR'.OR.MODELNAME.EQ.'RSM' .OR. MODELNAME == 'RAPR')THEN + IF (IGET(128)>0) THEN + IF(MODELNAME == 'NCAR'.OR.MODELNAME=='RSM' .OR. MODELNAME == 'RAPR')THEN GRID1=SPVAL ID(1:25)=0 ELSE - IF(ARDSW.GT.0.)THEN + IF(ARDSW>0.)THEN RRNUM=1./ARDSW ELSE RRNUM=0. @@ -3404,22 +3404,22 @@ SUBROUTINE CLDRAD ENDDO ID(1:25)=0 ITRDSW = NINT(TRDSW) - IF(ITRDSW .ne. 0) then + IF(ITRDSW /= 0) then IFINCR = MOD(IFHR,ITRDSW) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITRDSW*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITRDSW*60) ELSE IFINCR = 0 endif ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITRDSW ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 END IF if(grib=="grib2" )then cfld=cfld+1 @@ -3435,12 +3435,12 @@ SUBROUTINE CLDRAD ENDIF ! ! TIME AVERAGED SURFACE LONG WAVE OUTGOING RADIATION. - IF (IGET(129).GT.0) THEN - IF(MODELNAME .EQ. 'NCAR'.OR.MODELNAME.EQ.'RSM' .OR. MODELNAME == 'RAPR')THEN + IF (IGET(129)>0) THEN + IF(MODELNAME == 'NCAR'.OR.MODELNAME=='RSM' .OR. MODELNAME == 'RAPR')THEN GRID1=SPVAL ID(1:25)=0 ELSE - IF(ARDLW.GT.0.)THEN + IF(ARDLW>0.)THEN RRNUM=1./ARDLW ELSE RRNUM=0. @@ -3456,22 +3456,22 @@ SUBROUTINE CLDRAD ENDDO ID(1:25)=0 ITRDLW = NINT(TRDLW) - IF(ITRDLW .ne. 0) then + IF(ITRDLW /= 0) then IFINCR = MOD(IFHR,ITRDLW) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITRDLW*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITRDLW*60) ELSE IFINCR = 0 endif ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITRDLW ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 END IF if(grib=="grib2" )then cfld=cfld+1 @@ -3487,12 +3487,12 @@ SUBROUTINE CLDRAD ENDIF ! ! TIME AVERAGED TOP OF THE ATMOSPHERE SHORT WAVE RADIATION. - IF (IGET(130).GT.0) THEN - IF(MODELNAME .EQ. 'NCAR'.OR.MODELNAME.EQ.'RSM' .OR. MODELNAME == 'RAPR')THEN + IF (IGET(130)>0) THEN + IF(MODELNAME == 'NCAR'.OR.MODELNAME=='RSM' .OR. MODELNAME == 'RAPR')THEN GRID1=SPVAL ID(1:25)=0 ELSE - IF(ARDSW.GT.0.)THEN + IF(ARDSW>0.)THEN RRNUM=1./ARDSW ELSE RRNUM=0. @@ -3508,22 +3508,22 @@ SUBROUTINE CLDRAD ENDDO ID(1:25)=0 ITRDSW = NINT(TRDSW) - IF(ITRDSW .ne. 0) then + IF(ITRDSW /= 0) then IFINCR = MOD(IFHR,ITRDSW) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITRDSW*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITRDSW*60) ELSE IFINCR = 0 endif ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITRDSW ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 END IF if(grib=="grib2" )then cfld=cfld+1 @@ -3539,12 +3539,12 @@ SUBROUTINE CLDRAD ENDIF ! ! TIME AVERAGED TOP OF THE ATMOSPHERE LONG WAVE RADIATION. - IF (IGET(131).GT.0) THEN - IF(MODELNAME .EQ. 'NCAR'.OR.MODELNAME.EQ.'RSM' .OR. MODELNAME == 'RAPR')THEN + IF (IGET(131)>0) THEN + IF(MODELNAME == 'NCAR'.OR.MODELNAME=='RSM' .OR. MODELNAME == 'RAPR')THEN GRID1=SPVAL ID(1:25)=0 ELSE - IF(ARDLW.GT.0.)THEN + IF(ARDLW>0.)THEN RRNUM=1./ARDLW ELSE RRNUM=0. @@ -3560,22 +3560,22 @@ SUBROUTINE CLDRAD ENDDO ID(1:25)=0 ITRDLW = NINT(TRDLW) - IF(ITRDLW .ne. 0) then + IF(ITRDLW /= 0) then IFINCR = MOD(IFHR,ITRDLW) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITRDLW*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITRDLW*60) ELSE IFINCR = 0 endif ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITRDLW ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 END IF if(grib=="grib2" )then cfld=cfld+1 @@ -3591,8 +3591,8 @@ SUBROUTINE CLDRAD ENDIF ! ! CURRENT TOP OF THE ATMOSPHERE LONG WAVE RADIATION. - IF (IGET(274).GT.0) THEN - IF(MODELNAME .EQ. 'NCAR'.OR.MODELNAME.EQ.'RSM')THEN + IF (IGET(274)>0) THEN + IF(MODELNAME == 'NCAR'.OR.MODELNAME=='RSM')THEN GRID1=SPVAL ELSE DO J=JSTA,JEND @@ -3609,14 +3609,14 @@ SUBROUTINE CLDRAD ENDIF ! ! CLOUD TOP BRIGHTNESS TEMPERATURE FROM TOA OUTGOING LW. - IF (IGET(265).GT.0) THEN + IF (IGET(265)>0) THEN GRID1=SPVAL - IF(MODELNAME .EQ. 'NCAR'.OR.MODELNAME.EQ.'RSM' .OR. MODELNAME == 'RAPR')THEN + IF(MODELNAME == 'NCAR'.OR.MODELNAME=='RSM' .OR. MODELNAME == 'RAPR')THEN GRID1=SPVAL ELSE DO J=JSTA,JEND DO I=1,IM - IF(RLWTOA(I,J) .LT. SPVAL) & + IF(RLWTOA(I,J) < SPVAL) & & GRID1(I,J) = (RLWTOA(I,J)*STBOL)**0.25 ENDDO ENDDO @@ -3629,10 +3629,10 @@ SUBROUTINE CLDRAD ENDIF ! ! CURRENT INCOMING SW RADIATION AT THE SURFACE. - IF (IGET(156).GT.0) THEN + IF (IGET(156)>0) THEN DO J=JSTA,JEND DO I=1,IM - IF(CZMEAN(I,J).GT.1.E-6) THEN + IF(CZMEAN(I,J)>1.E-6) THEN FACTRS=CZEN(I,J)/CZMEAN(I,J) ELSE FACTRS=0.0 @@ -3649,15 +3649,15 @@ SUBROUTINE CLDRAD ENDIF ! ! CURRENT INCOMING LW RADIATION AT THE SURFACE. - IF (IGET(157).GT.0) THEN + IF (IGET(157)>0) THEN ! dong add missing value to DLWRF GRID1 = spval DO J=JSTA,JEND DO I=1,IM - IF(MODELNAME.eq.'RSM' .OR. MODELNAME == 'RAPR') THEN !add by Binbin: RSM has direct RLWIN output + IF(MODELNAME=='RSM' .OR. MODELNAME == 'RAPR') THEN !add by Binbin: RSM has direct RLWIN output GRID1(I,J)=RLWIN(I,J) ELSE - IF(SIGT4(I,J).GT.0.0) THEN + IF(SIGT4(I,J)>0.0) THEN LLMH=NINT(LMH(I,J)) TLMH=T(I,J,LLMH) FACTRL=5.67E-8*TLMH*TLMH*TLMH*TLMH/SIGT4(I,J) @@ -3677,11 +3677,11 @@ SUBROUTINE CLDRAD ENDIF ! ! CURRENT OUTGOING SW RADIATION AT THE SURFACE. - IF (IGET(141).GT.0) THEN + IF (IGET(141)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM - IF(CZMEAN(I,J).GT.1.E-6) THEN + IF(CZMEAN(I,J)>1.E-6) THEN FACTRS=CZEN(I,J)/CZMEAN(I,J) ELSE FACTRS=0.0 @@ -3698,7 +3698,7 @@ SUBROUTINE CLDRAD ENDIF ! Instantaneous clear-sky upwelling SW at the surface - IF (IGET(743).GT.0) THEN + IF (IGET(743)>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J) = SWUPBC(I,J) @@ -3712,7 +3712,7 @@ SUBROUTINE CLDRAD ENDIF ! CURRENT OUTGOING LW RADIATION AT THE SURFACE. - IF (IGET(142).GT.0) THEN + IF (IGET(142)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -3727,7 +3727,7 @@ SUBROUTINE CLDRAD ENDIF ! Instantaneous clear-sky downwelling LW at the surface - IF (IGET(744).GT.0) THEN + IF (IGET(744)>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J) = LWDNBC(I,J) @@ -3741,7 +3741,7 @@ SUBROUTINE CLDRAD ENDIF ! Instantaneous clear-sky upwelling LW at the surface - IF (IGET(745).GT.0) THEN + IF (IGET(745)>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J) = LWUPBC(I,J) @@ -3755,7 +3755,7 @@ SUBROUTINE CLDRAD ENDIF ! Instantaneous MEAN_FRP - IF (IGET(740).GT.0) THEN + IF (IGET(740)>0) THEN print *,"GETTING INTO MEAN_FRP PART" DO J=JSTA,JEND DO I=1,IM @@ -3771,11 +3771,11 @@ SUBROUTINE CLDRAD ENDIF ! CURRENT (instantaneous) INCOMING CLEARSKY SW RADIATION AT THE SURFACE. - IF (IGET(262).GT.0) THEN + IF (IGET(262)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM - IF(CZMEAN(I,J).GT.1.E-6) THEN + IF(CZMEAN(I,J)>1.E-6) THEN FACTRS=CZEN(I,J)/CZMEAN(I,J) ELSE FACTRS=0.0 @@ -3791,7 +3791,7 @@ SUBROUTINE CLDRAD ENDIF ! Instantaneous clear-sky downwelling SW at surface (GSD version) - IF (IGET(742).GT.0) THEN + IF (IGET(742)>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J) = SWDNBC(I,J) @@ -3805,7 +3805,7 @@ SUBROUTINE CLDRAD ENDIF ! Instantaneous SWDDNI - IF (IGET(772).GT.0)THEN + IF (IGET(772)>0)THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -3820,7 +3820,7 @@ SUBROUTINE CLDRAD ENDIF ! Instantaneous clear-sky SWDDNI - IF (IGET(796).GT.0) THEN + IF (IGET(796)>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J) = SWDDNIC(I,J) @@ -3834,7 +3834,7 @@ SUBROUTINE CLDRAD ENDIF ! Instantaneous SWDDIF - IF (IGET(773).GT.0) THEN + IF (IGET(773)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -3849,7 +3849,7 @@ SUBROUTINE CLDRAD ENDIF ! Instantaneous clear-sky SWDDIF - IF (IGET(797).GT.0) THEN + IF (IGET(797)>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J) = SWDDIFC(I,J) @@ -3863,7 +3863,7 @@ SUBROUTINE CLDRAD ENDIF ! TIME AVERAGED INCOMING CLEARSKY SW RADIATION AT THE SURFACE. - IF (IGET(383).GT.0) THEN + IF (IGET(383)>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J) = ASWINC(I,J) @@ -3871,22 +3871,22 @@ SUBROUTINE CLDRAD ENDDO ID(1:25)=0 ITRDSW = NINT(TRDSW) - IF(ITRDSW .ne. 0) then + IF(ITRDSW /= 0) then IFINCR = MOD(IFHR,ITRDSW) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITRDSW*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITRDSW*60) ELSE IFINCR = 0 endif ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITRDSW ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 if(grib=="grib2" )then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(383)) @@ -3901,7 +3901,7 @@ SUBROUTINE CLDRAD ENDIF ! ! TIME AVERAGED OUTGOING CLEARSKY SW RADIATION AT THE SURFACE. - IF (IGET(386).GT.0) THEN + IF (IGET(386)>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J) = ASWOUTC(I,J) @@ -3909,22 +3909,22 @@ SUBROUTINE CLDRAD ENDDO ID(1:25)=0 ITRDSW = NINT(TRDSW) - IF(ITRDSW .ne. 0) then + IF(ITRDSW /= 0) then IFINCR = MOD(IFHR,ITRDSW) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITRDSW*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITRDSW*60) ELSE IFINCR = 0 endif ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITRDSW ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 if(grib=="grib2" )then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(386)) @@ -3939,7 +3939,7 @@ SUBROUTINE CLDRAD ENDIF ! Instantaneous all-sky outgoing SW flux at the model top - IF (IGET(719).GT.0) THEN + IF (IGET(719)>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J) = SWUPT(I,J) @@ -3953,7 +3953,7 @@ SUBROUTINE CLDRAD ENDIF ! TIME AVERAGED OUTGOING CLEARSKY SW RADIATION AT THE MODEL TOP - IF (IGET(387).GT.0) THEN + IF (IGET(387)>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J) = ASWTOAC(I,J) @@ -3961,22 +3961,22 @@ SUBROUTINE CLDRAD ENDDO ID(1:25)=0 ITRDSW = NINT(TRDSW) - IF(ITRDSW .ne. 0) then + IF(ITRDSW /= 0) then IFINCR = MOD(IFHR,ITRDSW) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITRDSW*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITRDSW*60) ELSE IFINCR = 0 endif ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITRDSW ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 if(grib=="grib2" )then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(387)) @@ -3991,7 +3991,7 @@ SUBROUTINE CLDRAD ENDIF ! ! TIME AVERAGED INCOMING SW RADIATION AT THE MODEL TOP - IF (IGET(388).GT.0) THEN + IF (IGET(388)>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J) = ASWINTOA(I,J) @@ -3999,22 +3999,22 @@ SUBROUTINE CLDRAD ENDDO ID(1:25)=0 ITRDSW = NINT(TRDSW) - IF(ITRDSW .ne. 0) then + IF(ITRDSW /= 0) then IFINCR = MOD(IFHR,ITRDSW) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITRDSW*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITRDSW*60) ELSE IFINCR = 0 endif ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITRDSW ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 if(grib=="grib2" )then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(388)) @@ -4029,7 +4029,7 @@ SUBROUTINE CLDRAD ENDIF ! ! TIME AVERAGED INCOMING CLEARSKY LW RADIATION AT THE SURFACE - IF (IGET(382).GT.0) THEN + IF (IGET(382)>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J) = ALWINC(I,J) @@ -4037,22 +4037,22 @@ SUBROUTINE CLDRAD ENDDO ID(1:25)=0 ITRDLW = NINT(TRDLW) - IF(ITRDLW .ne. 0) then + IF(ITRDLW /= 0) then IFINCR = MOD(IFHR,ITRDLW) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITRDLW*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITRDLW*60) ELSE IFINCR = 0 endif ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITRDLW ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 if(grib=="grib2" )then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(382)) @@ -4067,7 +4067,7 @@ SUBROUTINE CLDRAD ENDIF ! ! TIME AVERAGED OUTGOING CLEARSKY LW RADIATION AT THE SURFACE - IF (IGET(384).GT.0) THEN + IF (IGET(384)>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J) = ALWOUTC(I,J) @@ -4075,22 +4075,22 @@ SUBROUTINE CLDRAD ENDDO ID(1:25)=0 ITRDLW = NINT(TRDLW) - IF(ITRDLW .ne. 0) then + IF(ITRDLW /= 0) then IFINCR = MOD(IFHR,ITRDLW) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITRDLW*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITRDLW*60) ELSE IFINCR = 0 endif ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITRDLW ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 if(grib=="grib2" )then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(384)) @@ -4105,7 +4105,7 @@ SUBROUTINE CLDRAD ENDIF ! ! TIME AVERAGED OUTGOING CLEARSKY LW RADIATION AT THE MODEL TOP - IF (IGET(385).GT.0) THEN + IF (IGET(385)>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J) = ALWTOAC(I,J) @@ -4113,22 +4113,22 @@ SUBROUTINE CLDRAD ENDDO ID(1:25)=0 ITRDLW = NINT(TRDLW) - IF(ITRDLW .ne. 0) then + IF(ITRDLW /= 0) then IFINCR = MOD(IFHR,ITRDLW) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITRDLW*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITRDLW*60) ELSE IFINCR = 0 endif ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITRDLW ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 if(grib=="grib2" )then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(385)) @@ -4143,7 +4143,7 @@ SUBROUTINE CLDRAD ENDIF ! ! TIME AVERAGED SURFACE VISIBLE BEAM DOWNWARD SOLAR FLUX - IF (IGET(401).GT.0) THEN + IF (IGET(401)>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J) = AVISBEAMSWIN(I,J) @@ -4151,22 +4151,22 @@ SUBROUTINE CLDRAD ENDDO ID(1:25)=0 ITRDSW = NINT(TRDSW) - IF(ITRDSW .ne. 0) then + IF(ITRDSW /= 0) then IFINCR = MOD(IFHR,ITRDSW) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITRDSW*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITRDSW*60) ELSE IFINCR = 0 endif ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITRDSW ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 ! CFS labels time ave fields as inst in long range forecast IF(ITRDSW < 0)ID(1:25)=0 if(grib=="grib2" )then @@ -4183,7 +4183,7 @@ SUBROUTINE CLDRAD ENDIF ! ! TIME AVERAGED SURFACE VISIBLE DIFFUSE DOWNWARD SOLAR FLUX - IF (IGET(402).GT.0) THEN + IF (IGET(402)>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J) = AVISDIFFSWIN(I,J) @@ -4191,22 +4191,22 @@ SUBROUTINE CLDRAD ENDDO ID(1:25)=0 ITRDSW = NINT(TRDSW) - IF(ITRDSW .ne. 0) then + IF(ITRDSW /= 0) then IFINCR = MOD(IFHR,ITRDSW) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITRDSW*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITRDSW*60) ELSE IFINCR = 0 endif ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITRDSW ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 IF(ITRDSW < 0)ID(1:25)=0 if(grib=="grib2" )then cfld=cfld+1 @@ -4222,7 +4222,7 @@ SUBROUTINE CLDRAD ENDIF ! ! TIME AVERAGED SURFACE VISIBLE BEAM DOWNWARD SOLAR FLUX - IF (IGET(403).GT.0) THEN + IF (IGET(403)>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J) = AIRBEAMSWIN(I,J) @@ -4230,22 +4230,22 @@ SUBROUTINE CLDRAD ENDDO ID(1:25)=0 ITRDSW = NINT(TRDSW) - IF(ITRDSW .ne. 0) then + IF(ITRDSW /= 0) then IFINCR = MOD(IFHR,ITRDSW) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITRDSW*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITRDSW*60) ELSE IFINCR = 0 endif ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITRDSW ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 IF(ITRDSW < 0)ID(1:25)=0 if(grib=="grib2" )then cfld=cfld+1 @@ -4261,7 +4261,7 @@ SUBROUTINE CLDRAD ENDIF ! ! TIME AVERAGED SURFACE VISIBLE DIFFUSE DOWNWARD SOLAR FLUX - IF (IGET(404).GT.0) THEN + IF (IGET(404)>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J) = AIRDIFFSWIN(I,J) @@ -4269,22 +4269,22 @@ SUBROUTINE CLDRAD ENDDO ID(1:25)=0 ITRDSW = NINT(TRDSW) - IF(ITRDSW .ne. 0) then + IF(ITRDSW /= 0) then IFINCR = MOD(IFHR,ITRDSW) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITRDSW*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITRDSW*60) ELSE IFINCR = 0 endif ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITRDSW ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 IF(ITRDSW < 0)ID(1:25)=0 if(grib=="grib2" )then cfld=cfld+1 @@ -4300,7 +4300,7 @@ SUBROUTINE CLDRAD ENDIF !2D AEROSOL OPTICAL DEPTH AT 550 NM - IF (IGET(715).GT.0) THEN + IF (IGET(715)>0) THEN DO J=JSTA,JEND DO I=1,IM grid1(i,j)=taod5502d(i,j) @@ -4314,7 +4314,7 @@ SUBROUTINE CLDRAD ENDIF !AEROSOL ASYMMETRY FACTOR - IF (IGET(716).GT.0) THEN + IF (IGET(716)>0) THEN DO J=JSTA,JEND DO I=1,IM grid1(i,j)=aerasy2d(i,j) @@ -4328,7 +4328,7 @@ SUBROUTINE CLDRAD ENDIF !AEROSOL SINGLE-SCATTERING ALBEDO - IF (IGET(717).GT.0) THEN + IF (IGET(717)>0) THEN DO J=JSTA,JEND DO I=1,IM grid1(i,j)=aerssa2d(i,j) @@ -4357,19 +4357,19 @@ SUBROUTINE CLDRAD !! DETERMINE WHETHER TO COMPUTE AEROSOL OPTICAL PROPERTIES LAEROPT = .FALSE. DO I = 609, 614 ! TOTAL AND SPECIATED AOD AT 550NM - IF ( IGET(I).GT.0 ) LAEROPT = .TRUE. + IF ( IGET(I)>0 ) LAEROPT = .TRUE. ENDDO DO I = 623, 628 ! AOD AT MULTI-CHANNELS - IF ( IGET(I).GT.0 ) LAEROPT = .TRUE. + IF ( IGET(I)>0 ) LAEROPT = .TRUE. ENDDO DO I = 648, 656 ! (SSA, ASY AT 340),(SCA AT 550), ANGSTROM - IF ( IGET(I).GT.0 ) LAEROPT = .TRUE. + IF ( IGET(I)>0 ) LAEROPT = .TRUE. ENDDO !! DETERMINE WHETHER TO COMPUTE INSTANT SURFACE MASS CONC LAERSMASS = .FALSE. DO I = 690, 698 ! TOTAL AND SPECIATED AEROSOL - IF ( IGET(I).GT.0 ) LAERSMASS = .TRUE. + IF ( IGET(I)>0 ) LAERSMASS = .TRUE. ENDDO IF ( LAEROPT ) THEN @@ -4408,24 +4408,24 @@ SUBROUTINE CLDRAD CLOSE(UNIT=NOAER) aerosol_file='optics_luts_'//AerosolName(i)//'.dat' open(unit=NOAER, file=aerosol_file, status='OLD', iostat=ios) - IF (IOS .GT. 0) THEN + IF (IOS > 0) THEN print *,' ERROR! Non-zero iostat for rd_LUTS ', aerosol_file stop ENDIF print *,'i=',i,'read aerosol_file=',trim(aerosol_file),'ios=',ios ! - IF (AerosolName(i) .EQ. 'DUST') nbin = nbin_du - IF (AerosolName(i) .EQ. 'SALT') nbin = nbin_ss - IF (AerosolName(i) .EQ. 'SUSO') nbin = nbin_su - IF (AerosolName(i) .EQ. 'SOOT') nbin = nbin_bc - IF (AerosolName(i) .EQ. 'WASO') nbin = nbin_oc + IF (AerosolName(i) == 'DUST') nbin = nbin_du + IF (AerosolName(i) == 'SALT') nbin = nbin_ss + IF (AerosolName(i) == 'SUSO') nbin = nbin_su + IF (AerosolName(i) == 'SOOT') nbin = nbin_bc + IF (AerosolName(i) == 'WASO') nbin = nbin_oc DO J = 1, NBIN read(NOAER,'(2x,a4,1x,i1,1x,a3)')AerName_rd,ib, AerOpt - IF (AerName_rd .ne. AerosolName(i)) STOP - IF (j .ne. ib ) STOP - IF (AerOpt .ne. 'ext' ) STOP + IF (AerName_rd /= AerosolName(i)) STOP + IF (j /= ib ) STOP + IF (AerOpt /= 'ext' ) STOP - IF (AerosolName(i) .EQ. 'DUST') THEN + IF (AerosolName(i) == 'DUST') THEN do ib = 1, NBDSW read(NOAER,'(8f10.5)') (extrhd_du(ii,j,ib), ii=1,KRHLEV) enddo @@ -4442,7 +4442,7 @@ SUBROUTINE CLDRAD read(NOAER,'(8f10.5)') (ssarhd_du(ii,j,ib), ii=1,KRHLEV) enddo - ELSEIF (AerosolName(i) .EQ. 'SALT') THEN + ELSEIF (AerosolName(i) == 'SALT') THEN do ib = 1, NBDSW read(NOAER,'(8f10.5)') (extrhd_ss(ii,j,ib), ii=1,KRHLEV) enddo @@ -4459,7 +4459,7 @@ SUBROUTINE CLDRAD read(NOAER,'(8f10.5)') (ssarhd_ss(ii,j,ib), ii=1,KRHLEV) enddo - ELSEIF (AerosolName(i) .EQ. 'SUSO') THEN + ELSEIF (AerosolName(i) == 'SUSO') THEN do ib = 1, NBDSW read(NOAER,'(8f10.5)') (extrhd_su(ii,j,ib), ii=1,KRHLEV) enddo @@ -4476,7 +4476,7 @@ SUBROUTINE CLDRAD read(NOAER,'(8f10.5)') (ssarhd_su(ii,j,ib), ii=1,KRHLEV) enddo - ELSEIF (AerosolName(i) .EQ. 'SOOT') THEN + ELSEIF (AerosolName(i) == 'SOOT') THEN do ib = 1, NBDSW read(NOAER,'(8f10.5)') (extrhd_bc(ii,j,ib), ii=1,KRHLEV) enddo @@ -4493,7 +4493,7 @@ SUBROUTINE CLDRAD read(NOAER,'(8f10.5)') (ssarhd_bc(ii,j,ib), ii=1,KRHLEV) enddo - ELSEIF (AerosolName(i) .EQ. 'WASO') THEN + ELSEIF (AerosolName(i) == 'WASO') THEN do ib = 1, NBDSW read(NOAER,'(8f10.5)') (extrhd_oc(ii,j,ib), ii=1,KRHLEV) enddo @@ -4573,43 +4573,43 @@ SUBROUTINE CLDRAD DO IB = 1, NBDSW ! AOD AT 340 NM - IF (IB .EQ. 1 ) INDX = 623 + IF (IB == 1 ) INDX = 623 ! AOD AT 440 NM - IF (IB .EQ. 2 ) INDX = 624 + IF (IB == 2 ) INDX = 624 ! AOD AT 550 NM - IF (IB .EQ. 3 ) INDX = 609 + IF (IB == 3 ) INDX = 609 ! AOD AT 660 NM - IF (IB .EQ. 4 ) INDX = 625 + IF (IB == 4 ) INDX = 625 ! AOD AT 860 NM - IF (IB .EQ. 5 ) INDX = 626 + IF (IB == 5 ) INDX = 626 ! AOD AT 1630 NM - IF (IB .EQ. 6 ) INDX = 627 + IF (IB == 6 ) INDX = 627 ! AOD AT 11100 NM - IF (IB .EQ. 7 ) INDX = 628 + IF (IB == 7 ) INDX = 628 ! DETERMINE LEXT AND LSCA (DEFAULT TO F) LEXT = .FALSE. LSCA = .FALSE. LASY = .FALSE. ! -- CHECK WHETHER TOTAL EXT AOD IS REQUESTED - IF (IGET(INDX).GT.0 ) LEXT =.TRUE. + IF (IGET(INDX)>0 ) LEXT =.TRUE. ! -- CHECK WHETHER SPECIATED AOD AT 550 NM IS REQUESTED - IF ( IB .EQ. 3 ) THEN - IF (IGET(650).GT.0 ) LSCA =.TRUE. !TOTAL SCA AOD + IF ( IB == 3 ) THEN + IF (IGET(650)>0 ) LSCA =.TRUE. !TOTAL SCA AOD DO I = 1, nAero - IF (IGET(INDX_EXT(I)).GT.0 ) LEXT = .TRUE. - IF (IGET(INDX_SCA(I)).GT.0 ) LSCA = .TRUE. + IF (IGET(INDX_EXT(I))>0 ) LEXT = .TRUE. + IF (IGET(INDX_SCA(I))>0 ) LSCA = .TRUE. ENDDO ENDIF ! -- CHECK WHETHER ASY AND SSA AT 340NM IS REQUESTED - IF ( IB .EQ. 1 ) THEN - IF (IGET(648).GT.0 ) LSCA =.TRUE. - IF (IGET(649).GT.0 ) LASY =.TRUE. + IF ( IB == 1 ) THEN + IF (IGET(648)>0 ) LSCA =.TRUE. + IF (IGET(649)>0 ) LASY =.TRUE. ENDIF ! -- CHECK WHETHER ANGSTROM EXPONENT IS REQUESTED - IF (IGET(656).GT.0 ) THEN - IF ( IB .EQ. 2 ) LEXT = .TRUE. - IF ( IB .EQ. 5 ) LEXT = .TRUE. + IF (IGET(656)>0 ) THEN + IF ( IB == 2 ) LEXT = .TRUE. + IF ( IB == 5 ) LEXT = .TRUE. ENDIF print *,'LEXT=',LEXT,'LSCA=',LSCA,'LASY=',LASY ! SKIP IF POST PRODUCT IS NOT REQUESTED @@ -4806,8 +4806,8 @@ SUBROUTINE CLDRAD ENDDO ! I-loop ENDDO ! J-loop ! FILL UP AOD_440 AND AOD_860, IF ANGSTROM EXP IS REQUESTED - IF ( IGET(656) .GT. 0 ) THEN - IF (IB .EQ. 2 ) THEN !! AOD AT 440 NM + IF ( IGET(656) > 0 ) THEN + IF (IB == 2 ) THEN !! AOD AT 440 NM !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -4816,7 +4816,7 @@ SUBROUTINE CLDRAD ENDDO ! J-loop ENDIF - IF (IB .EQ. 5 ) THEN !! AOD AT 860 NM + IF (IB == 5 ) THEN !! AOD AT 860 NM !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -4827,7 +4827,7 @@ SUBROUTINE CLDRAD ENDIF ! WRITE OUT TOTAL AOD - IF ( IGET(INDX) .GT. 0) THEN + IF ( IGET(INDX) > 0) THEN !$omp parallel do private(i,j) do j=jsta,jend do i=1,im @@ -4843,10 +4843,10 @@ SUBROUTINE CLDRAD ENDIF ! ! WRITE OUT ASY AND SSA AT 340NM - IF ( IB .EQ. 1 ) THEN !!! FOR 340NM ONLY + IF ( IB == 1 ) THEN !!! FOR 340NM ONLY ! AER ASYM FACTOR AT 340 NM - IF ( IGET(649) .GT. 0 ) THEN + IF ( IGET(649) > 0 ) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -4867,7 +4867,7 @@ SUBROUTINE CLDRAD ENDIF ! IGET(649) ! AER SINGLE SCATTER ALB AT 340 NM - IF ( IGET(648) .GT. 0 ) THEN + IF ( IGET(648) > 0 ) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -4893,10 +4893,10 @@ SUBROUTINE CLDRAD ! WRITE OUT AOD FOR DU, SU, SS, OC, BC for all wavelengths ! WRITE OUT SPECIATED AEROSOL OPTICAL PROPERTIES - IF ( IB .EQ. 3 ) THEN !!! FOR 550NM ONLY + IF ( IB == 3 ) THEN !!! FOR 550NM ONLY ! WRITE OUT TOTAL SCATTERING AOD - IF ( IGET(650) .GT. 0 ) THEN + IF ( IGET(650) > 0 ) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -4915,15 +4915,15 @@ SUBROUTINE CLDRAD ! WRITE OUT EXT AOD JJ = INDX_EXT(II) - IF ( IGET(JJ) .GT. 0) THEN ! EXT AOD + IF ( IGET(JJ) > 0) THEN ! EXT AOD !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM - IF ( II .EQ. 1 ) GRID1(I,J) = AOD_DU(I,J) - IF ( II .EQ. 2 ) GRID1(I,J) = AOD_SS(I,J) - IF ( II .EQ. 3 ) GRID1(I,J) = AOD_SU(I,J) - IF ( II .EQ. 4 ) GRID1(I,J) = AOD_OC(I,J) - IF ( II .EQ. 5 ) GRID1(I,J) = AOD_BC(I,J) + IF ( II == 1 ) GRID1(I,J) = AOD_DU(I,J) + IF ( II == 2 ) GRID1(I,J) = AOD_SS(I,J) + IF ( II == 3 ) GRID1(I,J) = AOD_SU(I,J) + IF ( II == 4 ) GRID1(I,J) = AOD_OC(I,J) + IF ( II == 5 ) GRID1(I,J) = AOD_BC(I,J) ENDDO ENDDO CALL BOUND(GRID1,D00,H99999) @@ -4936,15 +4936,15 @@ SUBROUTINE CLDRAD ! WRITE OUT SCA AOD JJ = INDX_SCA(II) - IF ( IGET(JJ) .GT. 0) THEN ! SCA AOD + IF ( IGET(JJ) > 0) THEN ! SCA AOD !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM - IF ( II .EQ. 1 ) GRID1(I,J) = SCA_DU(I,J) - IF ( II .EQ. 2 ) GRID1(I,J) = SCA_SS(I,J) - IF ( II .EQ. 3 ) GRID1(I,J) = SCA_SU(I,J) - IF ( II .EQ. 4 ) GRID1(I,J) = SCA_OC(I,J) - IF ( II .EQ. 5 ) GRID1(I,J) = SCA_BC(I,J) + IF ( II == 1 ) GRID1(I,J) = SCA_DU(I,J) + IF ( II == 2 ) GRID1(I,J) = SCA_SS(I,J) + IF ( II == 3 ) GRID1(I,J) = SCA_SU(I,J) + IF ( II == 4 ) GRID1(I,J) = SCA_OC(I,J) + IF ( II == 5 ) GRID1(I,J) = SCA_BC(I,J) ENDDO ENDDO CALL BOUND(GRID1,D00,H99999) @@ -4962,14 +4962,14 @@ SUBROUTINE CLDRAD ENDIF ! LEXT IF-BLOCK ENDDO ! LOOP THROUGH NBDSW CHANNELS ! COMPUTE AND WRITE OUT ANGSTROM EXPONENT - IF ( IGET(656) .GT. 0 ) THEN + IF ( IGET(656) > 0 ) THEN ANGST=SPVAL ! ANG2 = LOG ( 0.860 / 0.440 ) ANG2 = LOG ( 860. / 440. ) !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM - IF (AOD_860(I,J) .GT. 0.) THEN + IF (AOD_860(I,J) > 0.) THEN ANG1 = LOG( AOD_440(I,J)/AOD_860(I,J) ) ANGST(I,J) = ANG1 / ANG2 ENDIF @@ -4989,7 +4989,7 @@ SUBROUTINE CLDRAD ENDIF ! END OF LAEROPT IF-BLOCK !! Multiply by 1.E-6 to revert these fields back - IF (IGET(659).GT.0) THEN + IF (IGET(659)>0) THEN GRID1=SPVAL !$omp parallel do private(i,j) DO J = JSTA,JEND @@ -5007,7 +5007,7 @@ SUBROUTINE CLDRAD endif ENDIF - IF (IGET(660).GT.0) THEN + IF (IGET(660)>0) THEN GRID1=SPVAL !$omp parallel do private(i,j) DO J = JSTA,JEND @@ -5026,7 +5026,7 @@ SUBROUTINE CLDRAD ENDIF !! ADD DUST DRY DEPOSITION FLUXES (kg/m2/sec) ! -! IF (IGET(661).GT.0) THEN +! IF (IGET(661)>0) THEN ! DO J = JSTA,JEND ! DO I = 1,IM ! GRID1(I,J) = DUDP(I,J,1)*1.E-6 @@ -5047,7 +5047,7 @@ SUBROUTINE CLDRAD ! ENDIF !! ADD AEROSOL SURFACE PM25 DUST MASS CONCENTRATION (ug/m3) - IF (IGET(686).GT.0 ) THEN + IF (IGET(686)>0 ) THEN !$omp parallel do private(i,j) DO J = JSTA,JEND DO I = 1,IM @@ -5063,7 +5063,7 @@ SUBROUTINE CLDRAD ENDIF !! ADD DUST WET DEPOSITION FLUXES (kg/m2/sec) -! IF (IGET(662).GT.0) THEN +! IF (IGET(662)>0) THEN ! DO J = JSTA,JEND ! DO I = 1,IM ! GRID1(I,J) = DUWT(I,J,1)*1.E-6 @@ -5084,7 +5084,7 @@ SUBROUTINE CLDRAD ! ENDIF !! ADD AEROSOL SURFACE PM25 SEA SALT MASS CONCENTRATION (ug/m3) - IF (IGET(684).GT.0 ) THEN + IF (IGET(684)>0 ) THEN !$omp parallel do private(i,j) DO J = JSTA,JEND DO I = 1,IM @@ -5099,7 +5099,7 @@ SUBROUTINE CLDRAD endif ENDIF !! ADD AEROSOL SURFACE PM10 MASS CONCENTRATION (ug/m3) - IF (IGET(619).GT.0 ) THEN + IF (IGET(619)>0 ) THEN !$omp parallel do private(i,j) DO J = JSTA,JEND DO I = 1,IM @@ -5115,7 +5115,7 @@ SUBROUTINE CLDRAD ENDIF !! ADD AEROSOL SURFACE PM2.5 MASS CONCENTRATION (ug/m3) - IF (IGET(620).GT.0 ) THEN + IF (IGET(620)>0 ) THEN !$omp parallel do private(i,j) DO J = JSTA,JEND DO I = 1,IM @@ -5130,7 +5130,7 @@ SUBROUTINE CLDRAD endif ENDIF !! ADD TOTAL AEROSOL PM10 COLUMN DENSITY (kg/m2) ! - IF (IGET(621).GT.0 ) THEN + IF (IGET(621)>0 ) THEN !$omp parallel do private(i,j) DO J = JSTA,JEND DO I = 1,IM @@ -5146,7 +5146,7 @@ SUBROUTINE CLDRAD ENDIF !! ADD TOTAL AEROSOL PM2.5 COLUMN DENSITY (kg/m2) - IF (IGET(622).GT.0 ) THEN + IF (IGET(622)>0 ) THEN !$omp parallel do private(i,j) DO J = JSTA,JEND DO I = 1,IM @@ -5162,7 +5162,7 @@ SUBROUTINE CLDRAD ENDIF !! ADD DUST PM2.5 COLUMN DENSITY (kg/m2) - IF (IGET(646).GT.0 ) THEN + IF (IGET(646)>0 ) THEN !$omp parallel do private(i,j) DO J = JSTA,JEND DO I = 1,IM @@ -5177,7 +5177,7 @@ SUBROUTINE CLDRAD ENDIF !! ADD SEA SALT PM2.5 COLUMN DENSITY (kg/m2) - IF (IGET(647).GT.0 ) THEN + IF (IGET(647)>0 ) THEN !$omp parallel do private(i,j) DO J = JSTA,JEND DO I = 1,IM @@ -5191,7 +5191,7 @@ SUBROUTINE CLDRAD endif ENDIF !! ADD BC COLUMN DENSITY (kg/m2) - IF (IGET(616).GT.0 ) THEN + IF (IGET(616)>0 ) THEN !$omp parallel do private(i,j) DO J = JSTA,JEND DO I = 1,IM @@ -5206,7 +5206,7 @@ SUBROUTINE CLDRAD ENDIF !! ADD OC COLUMN DENSITY (kg/m2) ! - IF (IGET(617).GT.0 ) THEN + IF (IGET(617)>0 ) THEN !$omp parallel do private(i,j) DO J = JSTA,JEND DO I = 1,IM @@ -5221,7 +5221,7 @@ SUBROUTINE CLDRAD ENDIF !! ADD SULF COLUMN DENSITY (kg/m2) ! - IF (IGET(618).GT.0 ) THEN + IF (IGET(618)>0 ) THEN !$omp parallel do private(i,j) DO J = JSTA,JEND DO I = 1,IM @@ -5237,43 +5237,43 @@ SUBROUTINE CLDRAD !! ADD EMISSION FLUXES,dry depostion, wet/convective depostion (kg/m2/sec) !! The AER file uses 1.E6 to scale all 2d diagnosis fields !! Multiply by 1.E-6 to revert these fields back - IF (IGET(659).GT.0) call wrt_aero_diag(659,nbin_du,duem) + IF (IGET(659)>0) call wrt_aero_diag(659,nbin_du,duem) print *,'aft wrt disg duem' - IF (IGET(660).GT.0) call wrt_aero_diag(660,nbin_du,dusd) - IF (IGET(661).GT.0) call wrt_aero_diag(661,nbin_du,dudp) - IF (IGET(662).GT.0) call wrt_aero_diag(662,nbin_du,duwt) - IF (IGET(679).GT.0) call wrt_aero_diag(679,nbin_du,dusv) + IF (IGET(660)>0) call wrt_aero_diag(660,nbin_du,dusd) + IF (IGET(661)>0) call wrt_aero_diag(661,nbin_du,dudp) + IF (IGET(662)>0) call wrt_aero_diag(662,nbin_du,duwt) + IF (IGET(679)>0) call wrt_aero_diag(679,nbin_du,dusv) print *,'aft wrt disg duwt' !! wrt SS diag field - IF (IGET(663).GT.0) call wrt_aero_diag(663,nbin_ss,ssem) - IF (IGET(664).GT.0) call wrt_aero_diag(664,nbin_ss,sssd) - IF (IGET(665).GT.0) call wrt_aero_diag(665,nbin_ss,ssdp) - IF (IGET(666).GT.0) call wrt_aero_diag(666,nbin_ss,sswt) - IF (IGET(680).GT.0) call wrt_aero_diag(680,nbin_ss,sssv) + IF (IGET(663)>0) call wrt_aero_diag(663,nbin_ss,ssem) + IF (IGET(664)>0) call wrt_aero_diag(664,nbin_ss,sssd) + IF (IGET(665)>0) call wrt_aero_diag(665,nbin_ss,ssdp) + IF (IGET(666)>0) call wrt_aero_diag(666,nbin_ss,sswt) + IF (IGET(680)>0) call wrt_aero_diag(680,nbin_ss,sssv) print *,'aft wrt disg sswt' !! wrt BC diag field - IF (IGET(667).GT.0) call wrt_aero_diag(667,nbin_bc,bcem) - IF (IGET(668).GT.0) call wrt_aero_diag(668,nbin_bc,bcsd) - IF (IGET(669).GT.0) call wrt_aero_diag(669,nbin_bc,bcdp) - IF (IGET(670).GT.0) call wrt_aero_diag(670,nbin_bc,bcwt) - IF (IGET(681).GT.0) call wrt_aero_diag(681,nbin_bc,bcsv) + IF (IGET(667)>0) call wrt_aero_diag(667,nbin_bc,bcem) + IF (IGET(668)>0) call wrt_aero_diag(668,nbin_bc,bcsd) + IF (IGET(669)>0) call wrt_aero_diag(669,nbin_bc,bcdp) + IF (IGET(670)>0) call wrt_aero_diag(670,nbin_bc,bcwt) + IF (IGET(681)>0) call wrt_aero_diag(681,nbin_bc,bcsv) print *,'aft wrt disg bcwt' !! wrt OC diag field - IF (IGET(671).GT.0) call wrt_aero_diag(671,nbin_oc,ocem) - IF (IGET(672).GT.0) call wrt_aero_diag(672,nbin_oc,ocsd) - IF (IGET(673).GT.0) call wrt_aero_diag(673,nbin_oc,ocdp) - IF (IGET(674).GT.0) call wrt_aero_diag(674,nbin_oc,ocwt) - IF (IGET(682).GT.0) call wrt_aero_diag(682,nbin_oc,ocsv) + IF (IGET(671)>0) call wrt_aero_diag(671,nbin_oc,ocem) + IF (IGET(672)>0) call wrt_aero_diag(672,nbin_oc,ocsd) + IF (IGET(673)>0) call wrt_aero_diag(673,nbin_oc,ocdp) + IF (IGET(674)>0) call wrt_aero_diag(674,nbin_oc,ocwt) + IF (IGET(682)>0) call wrt_aero_diag(682,nbin_oc,ocsv) print *,'aft wrt disg ocwt' !! wrt SU diag field -! IF (IGET(675).GT.0) call wrt_aero_diag(675,nbin_su,suem) -! IF (IGET(676).GT.0) call wrt_aero_diag(676,nbin_su,susd) -! IF (IGET(677).GT.0) call wrt_aero_diag(677,nbin_su,sudp) -! IF (IGET(678).GT.0) call wrt_aero_diag(678,nbin_su,suwt) +! IF (IGET(675)>0) call wrt_aero_diag(675,nbin_su,suem) +! IF (IGET(676)>0) call wrt_aero_diag(676,nbin_su,susd) +! IF (IGET(677)>0) call wrt_aero_diag(677,nbin_su,sudp) +! IF (IGET(678)>0) call wrt_aero_diag(678,nbin_su,suwt) ! print *,'aft wrt disg suwt' endif ! if gocart_on diff --git a/sorc/ncep_post.fd/CLMAX.f b/sorc/ncep_post.fd/CLMAX.f index 4bf450f94..1a87ba4b2 100644 --- a/sorc/ncep_post.fd/CLMAX.f +++ b/sorc/ncep_post.fd/CLMAX.f @@ -86,9 +86,9 @@ SUBROUTINE CLMAX(EL0,SQZ,SQ,RQ2L,RQ2H) ! THIS PART OF THE CODE IS LEFT FOR TESTING OTHER PARAMETERIZATION ! SCHEMES ! -! IF (L.GE.LMH(I,J)) GOTO 215 +! IF (L>=LMH(I,J)) GOTO 215 ! RQ2L(I,J)=SQRT(Q2(I,J,L)) -! IF(Q2(I,J,L).LT.0.0)THEN +! IF(Q2(I,J,L)<0.0)THEN ! write(3,*)'NEGATIVE Q2 AT (I,J,L)=(',I,',',J,',',L,'): ', ! Q2(I,J,L) ! STOP diff --git a/sorc/ncep_post.fd/COLLECT.f b/sorc/ncep_post.fd/COLLECT.f index f92f59a6b..bcc8fab57 100644 --- a/sorc/ncep_post.fd/COLLECT.f +++ b/sorc/ncep_post.fd/COLLECT.f @@ -45,7 +45,7 @@ SUBROUTINE COLLECT (A, B) ! integer i, j integer ierr ! - if ( num_procs .le. 1 ) then + if ( num_procs <= 1 ) then b = a else call mpi_gatherv(a(1,jsta),icnt(me),MPI_REAL, & diff --git a/sorc/ncep_post.fd/COLLECT_LOC.f b/sorc/ncep_post.fd/COLLECT_LOC.f index 0c958a42a..589cee1ba 100644 --- a/sorc/ncep_post.fd/COLLECT_LOC.f +++ b/sorc/ncep_post.fd/COLLECT_LOC.f @@ -43,7 +43,7 @@ SUBROUTINE COLLECT_LOC ( A, B ) real, dimension(im,jm), intent(out) :: b integer ierr ! - if ( num_procs .le. 1 ) then + if ( num_procs <= 1 ) then b = a else call mpi_gatherv(a(1,jsta),icnt(me),MPI_REAL, & diff --git a/sorc/ncep_post.fd/ETCALC.f b/sorc/ncep_post.fd/ETCALC.f index 7c98b2d98..fd62bff0d 100644 --- a/sorc/ncep_post.fd/ETCALC.f +++ b/sorc/ncep_post.fd/ETCALC.f @@ -86,16 +86,16 @@ SUBROUTINE ETCALC(ETA,ETP,ESD,VEGFAC,ISOIL,SMC,CMC, & ! IF SNOW ON THE GROUND (ESD>0), ALL EVAPORATION IS SNOW SUBLIMATION, ! ELSE IT IT A SUM OF CANOPY EVAP, DIRECT SOIL EVAP AND TRANSPIRATION ! ---------------------------------------------------------------------- - IF (ETP .GT. 0.) THEN - IF (ESD .GT. 0.) THEN + IF (ETP > 0.) THEN + IF (ESD > 0.) THEN ESNOW = ETA ELSE ! ---------------------------------------------------------------------- ! CANOPY EVAPORATION ! ---------------------------------------------------------------------- - IF (CMC .GT. 0) THEN - IF (CMC .GT. CMCMAX) CMC = CMCMAX + IF (CMC > 0) THEN + IF (CMC > CMCMAX) CMC = CMCMAX EC = VEGFAC*((CMC/CMCMAX)**CFACTR)*ETP ENDIF @@ -104,7 +104,7 @@ SUBROUTINE ETCALC(ETA,ETP,ESD,VEGFAC,ISOIL,SMC,CMC, & ! AVAILABILITY, LINEAR WHEN FXEXP=1. ! ---------------------------------------------------------------------- SRATIO = (SMC-SMCDRY)/(SMCMAX-SMCDRY) - IF (SRATIO .GT. 0.) THEN + IF (SRATIO > 0.) THEN FX = SRATIO**FXEXP FX = MAX(0.,MIN(FX,1.)) ELSE @@ -117,7 +117,7 @@ SUBROUTINE ETCALC(ETA,ETP,ESD,VEGFAC,ISOIL,SMC,CMC, & ! ---------------------------------------------------------------------- ETRANS = ETA - EDIR - EC ENDIF - IF (ETRANS .LT. 0.) ETRANS = 0. + IF (ETRANS < 0.) ETRANS = 0. ENDIF diff --git a/sorc/ncep_post.fd/EXCH.f b/sorc/ncep_post.fd/EXCH.f index 332a51619..7cb3b5908 100644 --- a/sorc/ncep_post.fd/EXCH.f +++ b/sorc/ncep_post.fd/EXCH.f @@ -48,14 +48,14 @@ SUBROUTINE EXCH(A) ! write(0,*) 'mype=',me,'num_procs=',num_procs,'im=',im,'jsta_2l=', & ! jsta_2l,'jend_2u=',jend_2u,'jend=',jend,'iup=',iup,'jsta=', & ! jsta,'idn=',idn - if ( num_procs .le. 1 ) return + if ( num_procs <= 1 ) return ! jstam1 = max(jsta_2l,jsta-1) ! Moorthi call mpi_sendrecv(a(1,jend),im,MPI_REAL,iup,1, & & a(1,jstam1),im,MPI_REAL,idn,1, & & MPI_COMM_COMP,status,ierr) ! print *,'mype=',me,'in EXCH, after first mpi_sendrecv' - if ( ierr .ne. 0 ) then + if ( ierr /= 0 ) then print *, ' problem with first sendrecv in exch, ierr = ',ierr stop end if @@ -64,7 +64,7 @@ SUBROUTINE EXCH(A) & a(1,jendp1),im,MPI_REAL,iup,1, & & MPI_COMM_COMP,status,ierr) ! print *,'mype=',me,'in EXCH, after second mpi_sendrecv' - if ( ierr .ne. 0 ) then + if ( ierr /= 0 ) then print *, ' problem with second sendrecv in exch, ierr = ',ierr stop end if @@ -90,13 +90,13 @@ subroutine exch_f(a) integer status(MPI_STATUS_SIZE) integer ierr, jstam1, jendp1 ! - if ( num_procs .eq. 1 ) return + if ( num_procs == 1 ) return ! jstam1 = max(jsta_2l,jsta-1) ! Moorthi call mpi_sendrecv(a(1,jend),im,MPI_REAL,iup,1, & & a(1,jstam1),im,MPI_REAL,idn,1, & & MPI_COMM_COMP,status,ierr) - if ( ierr .ne. 0 ) then + if ( ierr /= 0 ) then print *, ' problem with first sendrecv in exch, ierr = ',ierr stop end if @@ -104,7 +104,7 @@ subroutine exch_f(a) call mpi_sendrecv(a(1,jsta),im,MPI_REAL,idn,1, & & a(1,jendp1),im,MPI_REAL,iup,1, & & MPI_COMM_COMP,status,ierr) - if ( ierr .ne. 0 ) then + if ( ierr /= 0 ) then print *, ' problem with second sendrecv in exch, ierr = ',ierr stop end if diff --git a/sorc/ncep_post.fd/EXCH2.f b/sorc/ncep_post.fd/EXCH2.f index de7945478..d5bce4036 100644 --- a/sorc/ncep_post.fd/EXCH2.f +++ b/sorc/ncep_post.fd/EXCH2.f @@ -49,13 +49,13 @@ SUBROUTINE EXCH2(A) integer status(MPI_STATUS_SIZE) integer ierr, jstam2, jendp1 ! - if ( num_procs .le. 1 ) return + if ( num_procs <= 1 ) return ! jstam2 = max(jsta_2l,jsta-2) call mpi_sendrecv(a(1,jend-1),2*im,MPI_REAL,iup,1, & & a(1,jstam2),2*im,MPI_REAL,idn,1, & & MPI_COMM_COMP,status,ierr) - if ( ierr .ne. 0 ) then + if ( ierr /= 0 ) then print *, ' problem with first sendrecv in exch2, ierr = ',ierr stop end if @@ -63,7 +63,7 @@ SUBROUTINE EXCH2(A) call mpi_sendrecv(a(1,jsta),2*im,MPI_REAL,idn,1, & & a(1,jendp1),2*im,MPI_REAL,iup,1, & & MPI_COMM_COMP,status,ierr) - if ( ierr .ne. 0 ) then + if ( ierr /= 0 ) then print *, ' problem with second sendrecv in exch2, ierr = ',ierr stop end if diff --git a/sorc/ncep_post.fd/FDLVL.f b/sorc/ncep_post.fd/FDLVL.f index b880cf007..02087bb7a 100644 --- a/sorc/ncep_post.fd/FDLVL.f +++ b/sorc/ncep_post.fd/FDLVL.f @@ -163,7 +163,7 @@ SUBROUTINE FDLVL(ITYPE,TFD,QFD,UFD,VFD,PFD,ICINGFD,AERFD) ! ! MSL FD LEVELS ! - IF (ITYPE(IFD).EQ.1) THEN + IF (ITYPE(IFD)==1) THEN ! write(6,*) 'computing above MSL' ! ! LOOP OVER HORIZONTAL GRID. @@ -200,7 +200,7 @@ SUBROUTINE FDLVL(ITYPE,TFD,QFD,UFD,VFD,PFD,ICINGFD,AERFD) HTTUV = HTT END IF - IF (.NOT. DONEH .AND. HTT.GT.HTFD(IFD)) THEN + IF (.NOT. DONEH .AND. HTT>HTFD(IFD)) THEN LHL(IFD) = L DZABH(IFD) = HTT-HTFD(IFD) DONEH = .TRUE. @@ -212,22 +212,22 @@ SUBROUTINE FDLVL(ITYPE,TFD,QFD,UFD,VFD,PFD,ICINGFD,AERFD) ENDIF ! THIS SHOULD SET BELOW GROUND VALUES TO SPVAL ! IFD = IFD + 1 -! IF (IFD.GT.NFD) GOTO 30 +! IF (IFD>NFD) GOTO 30 END IF - IF (.NOT. DONEV .AND. HTTUV.GT.HTFD(IFD)) THEN + IF (.NOT. DONEV .AND. HTTUV>HTFD(IFD)) THEN LVL(IFD) = L DZABV(IFD) = HTTUV-HTFD(IFD) DONEV=.TRUE. ! THIS SHOULD SET BELOW GROUND VALUES TO SPVAL - IF(HTSFC.GT.HTFD(IFD)) THEN + IF(HTSFC>HTFD(IFD)) THEN !mp LVL(IFD)=LM+1 ! CHUANG: changed to lm+1 !mp ENDIF ! THIS SHOULD SET BELOW GROUND VALUES TO SPVAL ! IFD = IFD + 1 -! IF (IFD.GT.NFD) GOTO 30 +! IF (IFD>NFD) GOTO 30 ENDIF IF(DONEH .AND. DONEV) exit @@ -298,7 +298,7 @@ SUBROUTINE FDLVL(ITYPE,TFD,QFD,UFD,VFD,PFD,ICINGFD,AERFD) DELV = VH(I,J,L) - VH(I,J,L+1) UFD(I,J,IFD) = UH(I,J,L) - DELU*RDZ*DZABV(IFD) VFD(I,J,IFD) = VH(I,J,L) - DELV*RDZ*DZABV(IFD) - ELSEIF (L.EQ.LM) THEN + ELSEIF (L==LM) THEN UFD(I,J,IFD)=UH(I,J,L) VFD(I,J,IFD)=VH(I,J,L) ENDIF @@ -355,20 +355,20 @@ SUBROUTINE FDLVL(ITYPE,TFD,QFD,UFD,VFD,PFD,ICINGFD,AERFD) HTABV = HTABH END IF - IF (.NOT. DONEH .AND. HTABH.GT.HTFD(IFD)) THEN + IF (.NOT. DONEH .AND. HTABH>HTFD(IFD)) THEN LHL(IFD) = L DZABH(IFD) = HTABH-HTFD(IFD) DONEH=.TRUE. ! IFD = IFD + 1 -! IF (IFD.GT.NFD) GOTO 230 +! IF (IFD>NFD) GOTO 230 ENDIF - IF (.NOT. DONEV .AND. HTABV.GT.HTFD(IFD)) THEN + IF (.NOT. DONEV .AND. HTABV>HTFD(IFD)) THEN LVL(IFD) = L DZABV(IFD) = HTABV-HTFD(IFD) DONEV = .TRUE. ! IFD = IFD + 1 -! IF (IFD.GT.NFD) GOTO 230 +! IF (IFD>NFD) GOTO 230 ENDIF IF(DONEH .AND. DONEV) exit enddo ! end of l loop @@ -379,7 +379,7 @@ SUBROUTINE FDLVL(ITYPE,TFD,QFD,UFD,VFD,PFD,ICINGFD,AERFD) ! ! DO 240 IFD = 1,NFD L = LHL(IFD) - IF (L.LT.LM) THEN + IF (L= 12 are from reference 2. ! The accuracy achieved depends on the arithmetic system, the ! compiler, the intrinsic functions, and proper selection of the ! machine-dependent constants. @@ -26,7 +26,7 @@ REAL FUNCTION fGAMMA(X) ! XINF - the largest machine representable floating-point number; ! approximately beta**maxexp ! EPS - the smallest positive floating-point number such that -! 1.0+EPS .GT. 1.0 +! 1.0+EPS > 1.0 ! XMININ - the smallest positive floating-point number such that ! 1/XMININ is machine representable ! @@ -154,15 +154,15 @@ REAL FUNCTION fGAMMA(X) FACT = ONE N = 0 Y = X - IF (Y .LE. ZERO) THEN + IF (Y <= ZERO) THEN !---------------------------------------------------------------------- ! Argument is negative !---------------------------------------------------------------------- Y = -X Y1 = AINT(Y) RES = Y - Y1 - IF (RES .NE. ZERO) THEN - IF (Y1 .NE. AINT(Y1*HALF)*TWO) PARITY = .TRUE. + IF (RES /= ZERO) THEN + IF (Y1 /= AINT(Y1*HALF)*TWO) PARITY = .TRUE. FACT = -PI / SIN(PI*RES) Y = Y + ONE ELSE @@ -174,35 +174,35 @@ REAL FUNCTION fGAMMA(X) !---------------------------------------------------------------------- ! Argument is positive !---------------------------------------------------------------------- - IF (Y .LT. EPS) THEN + IF (Y < EPS) THEN !---------------------------------------------------------------------- -! Argument .LT. EPS +! Argument < EPS !---------------------------------------------------------------------- - IF (Y .GE. XMININ) THEN + IF (Y >= XMININ) THEN RES = ONE / Y ELSE RES = XINF fGAMMA = RES RETURN END IF - ELSE IF (Y .LT. TWELVE) THEN + ELSE IF (Y < TWELVE) THEN Y1 = Y - IF (Y .LT. ONE) THEN + IF (Y < ONE) THEN !---------------------------------------------------------------------- -! 0.0 .LT. argument .LT. 1.0 +! 0.0 < argument < 1.0 !---------------------------------------------------------------------- Z = Y Y = Y + ONE ELSE !---------------------------------------------------------------------- -! 1.0 .LT. argument .LT. 12.0, reduce argument if necessary +! 1.0 < argument < 12.0, reduce argument if necessary !---------------------------------------------------------------------- N = INT(Y) - 1 Y = Y - CONV(N) Z = Y - ONE END IF !---------------------------------------------------------------------- -! Evaluate approximation for 1.0 .LT. argument .LT. 2.0 +! Evaluate approximation for 1.0 < argument < 2.0 !---------------------------------------------------------------------- XNUM = ZERO XDEN = ONE @@ -211,14 +211,14 @@ REAL FUNCTION fGAMMA(X) XDEN = XDEN * Z + Q(I) 260 CONTINUE RES = XNUM / XDEN + ONE - IF (Y1 .LT. Y) THEN + IF (Y1 < Y) THEN !---------------------------------------------------------------------- -! Adjust result for case 0.0 .LT. argument .LT. 1.0 +! Adjust result for case 0.0 < argument < 1.0 !---------------------------------------------------------------------- RES = RES / Y1 - ELSE IF (Y1 .GT. Y) THEN + ELSE IF (Y1 > Y) THEN !---------------------------------------------------------------------- -! Adjust result for case 2.0 .LT. argument .LT. 12.0 +! Adjust result for case 2.0 < argument < 12.0 !---------------------------------------------------------------------- DO 290 I = 1, N RES = RES * Y @@ -227,9 +227,9 @@ REAL FUNCTION fGAMMA(X) END IF ELSE !---------------------------------------------------------------------- -! Evaluate for argument .GE. 12.0, +! Evaluate for argument >= 12.0, !---------------------------------------------------------------------- - IF (Y .LE. XBIG) THEN + IF (Y <= XBIG) THEN YSQ = Y * Y SUM = C(7) DO 350 I = 1, 6 @@ -248,7 +248,7 @@ REAL FUNCTION fGAMMA(X) ! Final adjustments and return !---------------------------------------------------------------------- IF (PARITY) RES = -RES - IF (FACT .NE. ONE) RES = FACT / RES + IF (FACT /= ONE) RES = FACT / RES fGAMMA = RES RETURN ! ---------- Last line of fGAMMA ---------- diff --git a/sorc/ncep_post.fd/FIXED.f b/sorc/ncep_post.fd/FIXED.f index 3b21bc39f..cb545d564 100644 --- a/sorc/ncep_post.fd/FIXED.f +++ b/sorc/ncep_post.fd/FIXED.f @@ -67,7 +67,7 @@ SUBROUTINE FIXED ! START FIXED HERE. ! ! LATITUDE (OUTPUT GRID). - IF (IGET(048).GT.0) THEN + IF (IGET(048)>0) THEN !$omp parallel do private(i,j) DO J = JSTA,JEND DO I = 1,IM @@ -82,15 +82,15 @@ SUBROUTINE FIXED ENDIF ! ! LONGITUDE (OUTPUT GRID). CONVERT TO EAST - IF (IGET(049).GT.0) THEN + IF (IGET(049)>0) THEN DO J = JSTA,JEND DO I = 1,IM - IF (GDLON(I,J) .LT. 0.)THEN + IF (GDLON(I,J) < 0.)THEN GRID1(I,J) = 360. + GDLON(I,J) ELSE GRID1(I,J) = GDLON(I,J) END IF - IF (GRID1(I,J).GT.360.)print*,'LARGE GDLON ', & + IF (GRID1(I,J)>360.)print*,'LARGE GDLON ', & i,j,GDLON(I,J) END DO END DO @@ -102,14 +102,14 @@ SUBROUTINE FIXED ENDIF ! ! LAND/SEA MASK. - IF (IGET(050).GT.0) THEN + IF (IGET(050)>0) THEN !$omp parallel do private(i,j) DO J = JSTA,JEND DO I = 1,IM GRID1(I,J) = SPVAL IF(SM(I,J) /= SPVAL) GRID1(I,J) = 1. - SM(I,J) IF(SICE(I,J) /= SPVAL .AND. SICE(I,J) > 0.1) GRID1(I,J) = 0. -! if(j.eq.jm/2)print*,'i,mask= ',i,grid1(i,j) +! if(j==jm/2)print*,'i,mask= ',i,grid1(i,j) ENDDO ENDDO if(grib=='grib2') then @@ -120,7 +120,7 @@ SUBROUTINE FIXED ENDIF ! ! SEA ICE MASK. - IF (IGET(051).GT.0) THEN + IF (IGET(051)>0) THEN !$omp parallel do private(i,j) DO J = JSTA,JEND DO I = 1,IM @@ -135,7 +135,7 @@ SUBROUTINE FIXED ENDIF ! ! MASS POINT ETA SURFACE MASK. - IF (IGET(052).GT.0) THEN + IF (IGET(052)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -150,7 +150,7 @@ SUBROUTINE FIXED ENDIF ! ! VELOCITY POINT ETA SURFACE MASK. - IF (IGET(053).GT.0) THEN + IF (IGET(053)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -168,7 +168,7 @@ SUBROUTINE FIXED ! NO LONGER A FIXED FIELD, THIS VARIES WITH SNOW COVER !MEB since this is not a fixed field, move this to SURFCE ! - IF (IGET(150).GT.0) THEN + IF (IGET(150)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -176,7 +176,7 @@ SUBROUTINE FIXED ! SNOFAC = AMIN1(SNOK*50.0,1.0) ! EGRID1(I,J)=ALB(I,J)+(1.-VEGFRC(I,J))*SNOFAC ! 1 *(SNOALB-ALB(I,J)) - IF(ABS(ALBEDO(I,J)-SPVAL).GT.SMALL) & + IF(ABS(ALBEDO(I,J)-SPVAL)>SMALL) & GRID1(I,J)=ALBEDO(I,J) ENDDO ENDDO @@ -190,29 +190,29 @@ SUBROUTINE FIXED ENDIF ! ! TIME AVERAGED SURFACE ALBEDO. - IF (IGET(266).GT.0) THEN + IF (IGET(266)>0) THEN ID(1:25) = 0 ITSRFC = NINT(TSRFC) - IF(ITSRFC .ne. 0) then + IF(ITSRFC /= 0) then IFINCR = MOD(IFHR,ITSRFC) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITSRFC*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITSRFC*60) ELSE IFINCR = 0 endif ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITSRFC ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM - IF(ABS(AVGALBEDO(I,J)-SPVAL).GT.SMALL) & + IF(ABS(AVGALBEDO(I,J)-SPVAL)>SMALL) & GRID1(I,J) = AVGALBEDO(I,J)*100. ENDDO ENDDO @@ -230,11 +230,11 @@ SUBROUTINE FIXED endif ENDIF ! - IF (IGET(226).GT.0) THEN + IF (IGET(226)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM - IF(ABS(ALBASE(I,J)-SPVAL).GT.SMALL) & + IF(ABS(ALBASE(I,J)-SPVAL)>SMALL) & & GRID1(I,J) = ALBASE(I,J)*100. ENDDO ENDDO @@ -245,16 +245,16 @@ SUBROUTINE FIXED endif ENDIF ! Max snow albedo - IF (IGET(227).GT.0) THEN + IF (IGET(227)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM ! sea point, albedo=0.06 same as snow free albedo - IF( (abs(SM(I,J)-1.) .lt. 1.0E-5) ) THEN + IF( (abs(SM(I,J)-1.) < 1.0E-5) ) THEN MXSNAL(I,J)=0.06 ! sea-ice point, albedo=0.60, same as snow free albedo - ELSEIF( (abs(SM(I,J)-0.) .lt. 1.0E-5) .AND. & - & (abs(SICE(I,J)-1.) .lt. 1.0E-5) ) THEN + ELSEIF( (abs(SM(I,J)-0.) < 1.0E-5) .AND. & + & (abs(SICE(I,J)-1.) < 1.0E-5) ) THEN MXSNAL(I,J)=0.60 ENDIF ENDDO @@ -263,7 +263,7 @@ SUBROUTINE FIXED !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM - IF(ABS(MXSNAL(I,J)-SPVAL).GT.SMALL) & + IF(ABS(MXSNAL(I,J)-SPVAL)>SMALL) & & GRID1(I,J) = MXSNAL(I,J)*100. ENDDO ENDDO @@ -275,7 +275,7 @@ SUBROUTINE FIXED ENDIF ! ! SEA SURFACE TEMPERAURE. - IF (IGET(151).GT.0) THEN + IF (IGET(151)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -299,7 +299,7 @@ SUBROUTINE FIXED ! ! SEA ICE SKIN TEMPERAURE. - IF (IGET(968).GT.0) THEN + IF (IGET(968)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -314,7 +314,7 @@ SUBROUTINE FIXED ENDIF ! EMISSIVIT. - IF (IGET(248).GT.0) THEN + IF (IGET(248)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM diff --git a/sorc/ncep_post.fd/FRZLVL.f b/sorc/ncep_post.fd/FRZLVL.f index 91578031b..d18bcbb3d 100644 --- a/sorc/ncep_post.fd/FRZLVL.f +++ b/sorc/ncep_post.fd/FRZLVL.f @@ -122,7 +122,7 @@ SUBROUTINE FRZLVL(ZFRZ,RHFRZ,PFRZL) ! GFS analysis does not have flux file to retrieve TSFC from TSFC=T(I,J,LM)+D0065*(ZMID(I,J,LM)-HTSFC-2.0) END IF - IF (TSFC.LE.TFRZ) THEN + IF (TSFC<=TFRZ) THEN ! ZFRZ(I,J) = HTSFC+(TSFC-TFRZ)/D0065 ZFRZ(I,J) = HTSFC+2.0+(TSFC-TFRZ)/D0065 ! IF(SM(I,J)/=SPVAL .AND. QZ0(I,J)/=SPVAL .AND. & @@ -157,8 +157,8 @@ SUBROUTINE FRZLVL(ZFRZ,RHFRZ,PFRZL) ! OTHERWISE, LOCATE THE FREEZING LEVEL ALOFT. ! DO 10 L = LLMH,1,-1 - IF (T(I,J,L).LE.TFRZ) THEN - IF (L.LT.LLMH) THEN + IF (T(I,J,L)<=TFRZ) THEN + IF (L=PUCAP .AND. & + (T(I,J,L)<=ISOTHERM.AND.T(I,J,L+1)>ISOTHERM))LICE=L ENDDO ! ! CHECK IF ISOTHERM LEVEL IS AT THE GROUND. ! - IF (LICE.EQ.LLMH.AND.TSFC.LE.ISOTHERM) THEN + IF (LICE==LLMH.AND.TSFC<=ISOTHERM) THEN ZFRZ(I,J) = HTSFC+2.0+(TSFC-ISOTHERM)/D0065 QSFC = SM(I,J)*QZ0(I,J)+(1.-SM(I,J))*QS(I,J) IF(QSHLTR(I,J)/=SPVAL)THEN @@ -150,7 +150,7 @@ SUBROUTINE FRZLVL2(ISOTHERM,ZFRZ,RHFRZ,PFRZL) ! ! OTHERWISE, LOCATE THE ISOTHERM LEVEL ALOFT. ! - ELSE IF (LICE.LT.LLMH) THEN + ELSE IF (LICE0.AND.I1<=LEN) THEN GMAX=G(I1) GMIN=G(I1) DO I=I1+1,LEN - IF(MG(I).NE.0) THEN + IF(MG(I)/=0) THEN GMAX=MAX(GMAX,G(I)) GMIN=MIN(GMIN,G(I)) ENDIF @@ -141,17 +141,17 @@ SUBROUTINE FNDBIT ( rmin, rmax, rdb, nmbts, iscale, iret ) icnt = 0 iscale = 0 range = rmax - rmin - IF ( range .le. 0.00 ) THEN + IF ( range <= 0.00 ) THEN nmbts = 8 RETURN END IF !* - IF ( rdb .eq. 0.0 ) THEN + IF ( rdb == 0.0 ) THEN nmbts = 8 RETURN - ELSE IF ( rdb .gt. 0.0 ) THEN + ELSE IF ( rdb > 0.0 ) THEN ipo = INT (ALOG10 ( range )) - IF ( range .lt. 1.00 ) ipo = ipo - 1 + IF ( range < 1.00 ) ipo = ipo - 1 po = float(ipo) - rdb + 1. iscale = - INT ( po ) rr = range * 10. ** ( -po ) @@ -162,11 +162,11 @@ SUBROUTINE FNDBIT ( rmin, rmax, rdb, nmbts, iscale, iret ) nmbts = INT ( ALOG ( rng2 ) / rln2 ) + 1 END IF !* - IF(NMBTS.LE.0) THEN + IF(NMBTS<=0) THEN NMBTS=0 - IF(ABS(RMIN).GE.1.) THEN + IF(ABS(RMIN)>=1.) THEN ISCALE=-INT(ALOG10(ABS(RMIN))) - ELSE IF (ABS(RMIN).LT.1.0.AND.ABS(RMIN).GT.0.0) THEN + ELSE IF (ABS(RMIN)<1.0.AND.ABS(RMIN)>0.0) THEN ISCALE=-INT(ALOG10(ABS(RMIN)))+1 ELSE ISCALE=0 diff --git a/sorc/ncep_post.fd/GFIP3.f b/sorc/ncep_post.fd/GFIP3.f index caa9f50bd..01921eaa3 100644 --- a/sorc/ncep_post.fd/GFIP3.f +++ b/sorc/ncep_post.fd/GFIP3.f @@ -3,6 +3,8 @@ !======================================================================== module DerivedFields + implicit none + private public derive_fields, mixing_ratio public PRECIPS @@ -581,6 +583,8 @@ module CloudLayers use DerivedFields, only : mixing_ratio + implicit none + private public calc_CloudLayers public clouds_t @@ -921,6 +925,8 @@ module IcingPotential use DerivedFields, only : PRECIPS use CloudLayers, only : clouds_t + implicit none + private public icing_pot @@ -1095,7 +1101,9 @@ end module IcingPotential ! = = = = = = = = = = = = module SeverityMaps = = = = = = = = = = = = = !======================================================================== module SeverityMaps + implicit none public + public SCENARIOS type :: scenarios_t integer :: NO_PRECIPITAION = 0 @@ -1116,6 +1124,7 @@ module SeverityMaps !-----------------------------------------------------------------------+ real function twp_map(v, scenario) + implicit none real, intent(in) :: v integer, intent(in) :: scenario twp_map = 0.0 @@ -1145,6 +1154,7 @@ end function twp_map ! Only precip below warmnose has a different temperature map real function t_map(v, scenario) + implicit none real, intent(in) :: v integer, intent(in) :: scenario t_map = 0. @@ -1189,6 +1199,7 @@ end function t_map ! Condensates near the surface take place of radar reflectivity in CIP real function prcpCondensate_map(v, scenario) + implicit none real, intent(in) :: v integer, intent(in) :: scenario prcpCondensate_map = 0.0 @@ -1229,6 +1240,7 @@ end function prcpCondensate_map real function deltaZ_map(v, scenario) + implicit none real, intent(in) :: v integer, intent(in) :: scenario deltaZ_map = 0.0 @@ -1278,6 +1290,7 @@ end function deltaZ_map ! 223.15 0.8, 233.15 0.7446, 243.15 0.5784, 253.15 0.3014 ! 261.15 0.0, 280.15 0.0, 280.151 1.0 real function ctt_map(v) + implicit none real, intent(in) :: v if(v <= 223.15) then ctt_map = 0.8 @@ -1296,6 +1309,7 @@ end function ctt_map ! -0.5 1.0, 0.0 0.0 real function vv_map(v) + implicit none real, intent(in) :: v if(v <= -0.5) then vv_map = 1. @@ -1310,6 +1324,8 @@ end function vv_map ! cloud top distance ! 609.6 1.0, 3048.0 0.0 real function cldTopDist_map(v) + implicit none + real, intent(in) :: v if( v <= 609.6) then cldTopDist_map = 1.0 elseif( v <= 3048.) then @@ -1323,6 +1339,8 @@ end function cldTopDist_map ! cloud base distance ! 304.8 1.0, 1524.0 0.0 real function cldBaseDist_map(v) + implicit none + real, intent(in) :: v if( v <= 304.8) then cldBaseDist_map = 1.0 elseif( v <= 1524.) then @@ -1334,6 +1352,8 @@ end function cldBaseDist_map ! 0.0 0.0, 1.0 1.0 real function deltaQ_map(v) + implicit none + real, intent(in) :: v if( v <= 0.) then deltaQ_map = 0 elseif( v <= 1.0) then @@ -1373,6 +1393,7 @@ end function moisture_map_cwat ! only called by moisture_map ! 70.0 0.0, 100.0 1.0 real function rh_map(v) + implicit none real, intent(in) :: v if(v <= 70.) then rh_map = 0. @@ -1386,6 +1407,7 @@ end function rh_map ! only called by moisture_map ! 0.00399 0.0, 0.004 0.0, 0.2 1.0 real function condensate_map(v) + implicit none real, intent(in) :: v if(v <= 0.004) then condensate_map = 0. @@ -1404,6 +1426,7 @@ end function condensate_map ! 243.150 0.0, 265.15 1.0, 269.15 1.0, 270.15 0.87 ! 271.15 0.71, 272.15 0.50, 273.15 0.0 real function convect_t_map(v) + implicit none real, intent(in) :: v if(v <= 243.15) then convect_t_map = 0. @@ -1427,6 +1450,7 @@ end function convect_t_map ! 1.0 0.0, 3.0 1.0 real function convect_qpf_map(v) + implicit none real, intent(in) :: v if(v <= 1.0) then convect_qpf_map = 0 @@ -1439,6 +1463,7 @@ end function convect_qpf_map ! 1000.0 0.0, 2500.0 1.0 real function convect_cape_map(v) + implicit none real, intent(in) :: v if (v <= 1000.0) then @@ -1453,6 +1478,7 @@ end function convect_cape_map ! -10.0 1.0, 0.0 0.0 real function convect_liftedIdx_map(v) + implicit none real, intent(in) :: v if(v <= -10.) then convect_liftedIdx_map = 1.0 @@ -1466,6 +1492,7 @@ end function convect_liftedIdx_map ! 20.0 0.0, 40.0 1.0 real function convect_kIdx_map(v) + implicit none real, intent(in) :: v if(v <= 20.0) then convect_kIdx_map = 0 @@ -1478,6 +1505,7 @@ end function convect_kIdx_map ! 20.0 0.0, 55.0 1.0 real function convect_totals_map(v) + implicit none real, intent(in) :: v if(v <= 20.0) then convect_totals_map = 0 @@ -1498,6 +1526,8 @@ module IcingSeverity use CloudLayers, only : clouds_t use SeverityMaps + implicit none + private public icing_sev @@ -1534,6 +1564,8 @@ subroutine icing_sev(imp_physics,hgt, rh, t, pres, vv, liqCond, iceCond, twp, & real :: severity integer :: k, n + real :: moistInt + iseverity(:) = 0.0 lowestCloud = .false. diff --git a/sorc/ncep_post.fd/GFSPOST.F b/sorc/ncep_post.fd/GFSPOST.F index 5d6293746..42202ed89 100644 --- a/sorc/ncep_post.fd/GFSPOST.F +++ b/sorc/ncep_post.fd/GFSPOST.F @@ -227,10 +227,10 @@ subroutine p2pv(km,pvu,h,t,p,u,v,kpv,pv,pvpt,pvpb,& ! do lu=l2-1,l1,-1 ! do lu=l2,l1-1 ! Chuang: post counts top down do lu=l2+2,l1 ! Chuang: post counts top down -! if(pv(k).lt.pvu(lu+1).and.pv(k).ge.pvu(lu)) then +! if(pv(k)=pvu(lu)) then if(pv(k) >= pvu(lu+1).and.pv(k) < pvu(lu)) then call rsearch1(km,p,1,p(lu)+pd,ld) -! if(all(pv(k).ge.pvu(ld:lu-1))) then +! if(all(pv(k)>=pvu(ld:lu-1))) then if(all(pv(k) >= pvu(lu+1:ld))) then l = lu exit @@ -241,10 +241,10 @@ subroutine p2pv(km,pvu,h,t,p,u,v,kpv,pv,pvpt,pvpb,& ! do lu=l2-1,l1,-1 ! do lu=l2,l1-1 ! Chuang: post counts top down do lu=l2+2,l1 ! Chuang: post counts top down -! if(pv(k).gt.pvu(lu+1).and.pv(k).le.pvu(lu)) then +! if(pv(k)>pvu(lu+1).and.pv(k)<=pvu(lu)) then if(pv(k) <= pvu(lu+1).and.pv(k) > pvu(lu)) then call rsearch1(km,p,1,p(lu)+pd,ld) -! if(all(pv(k).le.pvu(ld:lu-1))) then +! if(all(pv(k)<=pvu(ld:lu-1))) then if(all(pv(k) <= pvu(lu+1:ld))) then l = lu exit @@ -432,13 +432,13 @@ subroutine tpause(km,p,u,v,t,h,ptp,utp,vtp,ttp,htp,shrtp) do k=klim(1),klim(2),-1 ! gamu=(t(k-1)-t(k+1))/(h(k+1)-h(k-1)) gamu=(t(k+1)-t(k-1))/(h(k-1)-h(k+1)) - if(gamu.le.gamtp) then + if(gamu<=gamtp) then ! call rsearch1(km-k-1,h(k+1),1,h(k)+hd,kd) call rsearch1(k-2,h(2),1,h(k)+hd,kd) ! td=t(k+kd)+(h(k)+hd-h(k+kd))/(h(k+kd+1)-h(k+kd))*(t(k+kd+1)-t(k+kd)) td=t(kd+2)+(h(k)+hd-h(2+kd))/(h(kd+1)-h(2+kd))*(t(kd+1)-t(2+kd)) gami=(t(k)-td)/hd - if(gami.le.gamtp) then + if(gami<=gamtp) then ktp=k wtp=(gamtp-gamu)/(max(gamd,gamtp+0.1e-3)-gamu) exit @@ -529,14 +529,14 @@ subroutine mxwind(km,p,u,v,t,h,pmw,umw,vmw,tmw,hmw) kmw=klim(1) ! do k=klim(1)+1,klim(2) do k=klim(1)-1,klim(2),-1 - if(spd(k).gt.spdmw) then + if(spd(k)>spdmw) then spdmw=spd(k) kmw=k endif enddo ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! find speed and height at the maximum wind level - if(kmw.eq.klim(1).or.kmw.eq.klim(2)) then + if(kmw==klim(1).or.kmw==klim(2)) then hmw=h(kmw) spdmw=spd(kmw) wmw=0. @@ -552,8 +552,8 @@ subroutine mxwind(km,p,u,v,t,h,pmw,umw,vmw,tmw,hmw) dhmw=(shrd*dhu-shru*dhd)/(2*(shrd+shru)) hmw=h(kmw)+dhmw spdmw=spd(kmw)+dhmw**2*(shrd+shru)/(dhd+dhu) -! if(dhmw.gt.0) kmw=kmw+1 - if(dhmw.gt.0) kmw=kmw-1 +! if(dhmw>0) kmw=kmw+1 + if(dhmw>0) kmw=kmw-1 ! wmw=(h(kmw)-hmw)/(h(kmw)-h(kmw-1)) wmw=(h(kmw)-hmw)/(h(kmw)-h(kmw+1)) endif @@ -613,10 +613,10 @@ subroutine mptgen(mpirank,mpisize,nd,jt1,jt2,j1,j2,jx,jm,jn) msize=mpisize mrank=mpirank do n=nd,1,-1 - if(jt2(n).ge.jt1(n)) then + if(jt2(n)>=jt1(n)) then jm(n)=(jt2(n)-jt1(n))/msize+1 msn=max(msize/(jt2(n)-jt1(n)+1),1) - if(n.eq.1) msn=1 + if(n==1) msn=1 jn(n)=msize/msn mrn=mrank/msn j1(n)=min(jt1(n)+jm(n)*mrn,jt2(n)+1) @@ -684,13 +684,13 @@ subroutine mptranr4(mpicomm,mpisize,im,ida,idb,& ! This subprogram must be used rather than mpi_alltoall ! in any of the following cases: ! (a) The undecomposed range is less than the respective dimension -! (either im.lt.ida or im.lt.idb) +! (either im1 or jm>1) ! (c) The decomposed range is ever zero -! (either kma.eq.0 or jmb.eq.0 for any process) +! (either kma==0 or jmb==0 for any process) ! (d) The output grid range is not the full extent -! (either kmb.lt.mpisize or kmb.lt.kda or jma.lt.mpisize or jma.lt.jda) +! (either kmb=TTP)THEN FPVSX=PSATK*(TR**XA)*EXP(XB*(1.-TR)) ELSE FPVSX=PSATK*(TR**XAI)*EXP(XBI*(1.-TR)) diff --git a/sorc/ncep_post.fd/INITPOST.F b/sorc/ncep_post.fd/INITPOST.F index 7aa0e4ce5..7263f4b87 100644 --- a/sorc/ncep_post.fd/INITPOST.F +++ b/sorc/ncep_post.fd/INITPOST.F @@ -199,7 +199,7 @@ SUBROUTINE INITPOST ! The end j row is going to be jend_2u for all variables except for V. JS=JSTA_2L JE=JEND_2U - IF (JEND_2U.EQ.JM) THEN + IF (JEND_2U==JM) THEN JEV=JEND_2U+1 ELSE JEV=JEND_2U @@ -297,7 +297,7 @@ SUBROUTINE INITPOST end do end do end do -! if(jj.ge. jsta .and. jj.le.jend)print*,'sample U= ',U(ii,jj,ll) +! if(jj>= jsta .and. jj<=jend)print*,'sample U= ',U(ii,jj,ll) VarName='V' call getVariable(fileName,DateStr,DataHandle,VarName,DUM3D, & IM+1,1,JM+1,LM+1,IM, JS,JEV,LM) @@ -314,7 +314,7 @@ SUBROUTINE INITPOST end do end do end do -! if(jj.ge. jsta .and. jj.le.jend)print*,'sample V= ',V(ii,jj,ll) +! if(jj>= jsta .and. jj<=jend)print*,'sample V= ',V(ii,jj,ll) VarName='W' call getVariable(fileName,DateStr,DataHandle,VarName,DUM3D, & @@ -344,13 +344,13 @@ SUBROUTINE INITPOST do i = 1, im !HC q ( i, j, l ) = dum3d ( i, j, l ) !HC CONVERT MIXING RATIO TO SPECIFIC HUMIDITY -!mhu check !!!! if (dum3d(i,j,l) .lt. 10E-12) dum3d(i,j,l) = 10E-12 +!mhu check !!!! if (dum3d(i,j,l) < 10E-12) dum3d(i,j,l) = 10E-12 q ( i, j, l ) = dum3d ( i, j, l )/(1.0+dum3d ( i, j, l )) end do end do end do print*,'finish reading mixing ratio' -! if(jj.ge. jsta .and. jj.le.jend)print*,'sample Q= ',Q(ii,jj,ll) +! if(jj>= jsta .and. jj<=jend)print*,'sample Q= ',Q(ii,jj,ll) ! DCD 4/3/13 ! previously initialized PMID from sum of base-state (PB) and @@ -372,12 +372,12 @@ SUBROUTINE INITPOST ! now that I have P, convert theta to t t ( i, j, l ) = T(I,J,L)*(PMID(I,J,L)*1.E-5)**CAPA ! now that I have T,q,P compute omega from wh - if(abs(t( i, j, l )).gt.1.0e-3) & + if(abs(t( i, j, l ))>1.0e-3) & omga(I,J,L) = -WH(I,J,L)*pmid(i,j,l)*G/ & (RD*t(i,j,l)*(1.+D608*q(i,j,l))) ! seperate rain from snow and cloud water from cloud ice for WSM3 scheme -! if(imp_physics .eq. 3)then -! if(t(i,j,l) .lt. TFRZ)then +! if(imp_physics == 3)then +! if(t(i,j,l) < TFRZ)then ! qqs(i,j,l)=qqr(i,j,l) ! qqi(i,j,l)=qqw(i,j,l) ! end if @@ -390,7 +390,7 @@ SUBROUTINE INITPOST ll=lm-l+1 do j = jsta_2l, jend_2u do i = 1, im - if((PMID(I,J,ll-1) - PMID(I,J,ll)).ge.0.) then + if((PMID(I,J,ll-1) - PMID(I,J,ll))>=0.) then write(*,*) 'non-monotonic PMID, i,j,ll ', i,j,ll write(*,*) 'PMID: ll-1,ll,ll+1', PMID(I,J,LL-1) & ,PMID(I,J,LL), PMID(I,J,LL+1) @@ -417,7 +417,7 @@ SUBROUTINE INITPOST ll=lm do j = jsta_2l, jend_2u do i = 1, im - if((PMID(I,J,ll-1) - PMID(I,J,ll)).ge.0.) then + if((PMID(I,J,ll-1) - PMID(I,J,ll))>=0.) then write(*,*) 'non-monotonic PMID, i,j,ll ', i,j,ll write(*,*) 'PMID: ll-2,ll-1,ll', PMID(I,J,LL-2) & ,PMID(I,J,LL-1), PMID(I,J,LL) @@ -476,7 +476,7 @@ SUBROUTINE INITPOST extcof55=0. aextc55=0. - if(imp_physics.ne.5 .and. imp_physics.ne.0)then + if(imp_physics/=5 .and. imp_physics/=0)then VarName='QCLOUD' call getVariable(fileName,DateStr,DataHandle,VarName,DUM3D, & IM+1,1,JM+1,LM+1,IM, JS,JE,LM) @@ -484,8 +484,8 @@ SUBROUTINE INITPOST do j = jsta_2l, jend_2u do i = 1, im ! partition cloud water and ice for WSM3 - if(imp_physics.eq.3)then - if(t(i,j,l) .ge. TFRZ)then + if(imp_physics==3)then + if(t(i,j,l) >= TFRZ)then qqw ( i, j, l ) = dum3d ( i, j, l ) else qqi ( i, j, l ) = dum3d ( i, j, l ) @@ -496,15 +496,15 @@ SUBROUTINE INITPOST end do end do end do -! if(jj.ge. jsta .and. jj.le.jend) +! if(jj>= jsta .and. jj<=jend) ! + print*,'sample QCLOUD= ',QQW(ii,jj,ll) ! print*,'finish reading cloud mixing ratio' end if - if(imp_physics.ne.1 .and. imp_physics.ne.3 & - .and. imp_physics.ne.5 .and. imp_physics.ne.0)then + if(imp_physics/=1 .and. imp_physics/=3 & + .and. imp_physics/=5 .and. imp_physics/=0)then VarName='QICE' call getVariable(fileName,DateStr,DataHandle,VarName,DUM3D, & IM+1,1,JM+1,LM+1,IM, JS,JE,LM) @@ -515,12 +515,12 @@ SUBROUTINE INITPOST end do end do end do -! if(jj.ge. jsta .and. jj.le.jend) +! if(jj>= jsta .and. jj<=jend) ! + print*,'sample QICE= ',qqi(ii,jj,ll) end if - if(imp_physics.ne.5 .and. imp_physics.ne.0)then + if(imp_physics/=5 .and. imp_physics/=0)then VarName='QRAIN' call getVariable(fileName,DateStr,DataHandle,VarName,DUM3D, & IM+1,1,JM+1,LM+1,IM, JS,JE,LM) @@ -528,8 +528,8 @@ SUBROUTINE INITPOST do j = jsta_2l, jend_2u do i = 1, im ! partition rain and snow for WSM3 - if(imp_physics .eq. 3)then - if(t(i,j,l) .ge. TFRZ)then + if(imp_physics == 3)then + if(t(i,j,l) >= TFRZ)then qqr ( i, j, l ) = dum3d ( i, j, l ) else qqs ( i, j, l ) = dum3d ( i, j, l ) @@ -542,7 +542,7 @@ SUBROUTINE INITPOST end do ! print*,'max rain water= ',l,maxval(dummy) end do -! if(jj.ge. jsta .and. jj.le.jend) +! if(jj>= jsta .and. jj<=jend) ! + print*,'sample QRAIN= ',qqr(ii,jj,ll) !tgs ! Compute max QRAIN in the column to be used later in precip type computation @@ -563,8 +563,8 @@ SUBROUTINE INITPOST end if - if(imp_physics.ne.1 .and. imp_physics.ne.3 .and. & - imp_physics.ne.5 .and. imp_physics.ne.0)then + if(imp_physics/=1 .and. imp_physics/=3 .and. & + imp_physics/=5 .and. imp_physics/=0)then VarName='QSNOW' call getVariable(fileName,DateStr,DataHandle,VarName,DUM3D, & IM+1,1,JM+1,LM+1,IM, JS,JE,LM) @@ -580,8 +580,8 @@ SUBROUTINE INITPOST end if - if(imp_physics.eq.2 .or. imp_physics.eq.6 .or. & - imp_physics.eq.8 .or. imp_physics.eq.9 .or. imp_physics.eq.28)then + if(imp_physics==2 .or. imp_physics==6 .or. & + imp_physics==8 .or. imp_physics==9 .or. imp_physics==28)then VarName='QGRAUP' call getVariable(fileName,DateStr,DataHandle,VarName,DUM3D, & IM+1,1,JM+1,LM+1,IM, JS,JE,LM) @@ -592,11 +592,11 @@ SUBROUTINE INITPOST end do end do end do -! if(jj.ge. jsta .and. jj.le.jend) +! if(jj>= jsta .and. jj<=jend) ! + print*,'sample QGRAUP= ',qqg(ii,jj,ll) end if - if(imp_physics.eq.8 .or. imp_physics.eq.9 .or.imp_physics.eq.28)then + if(imp_physics==8 .or. imp_physics==9 .or.imp_physics==28)then VarName='QNICE' call getVariable(fileName,DateStr,DataHandle,VarName,DUM3D, & IM+1,1,JM+1,LM+1,IM, JS,JE,LM) @@ -604,7 +604,7 @@ SUBROUTINE INITPOST do j = jsta_2l, jend_2u do i = 1, im qqni ( i, j, l ) = dum3d ( i, j, l ) - if(i.eq.im/2.and.j.eq.(jsta+jend)/2)print*,'sample QQNI= ', & + if(i==im/2.and.j==(jsta+jend)/2)print*,'sample QQNI= ', & i,j,l,QQNI ( i, j, l ) end do end do @@ -616,7 +616,7 @@ SUBROUTINE INITPOST do j = jsta_2l, jend_2u do i = 1, im qqnr ( i, j, l ) = dum3d ( i, j, l ) - if(i.eq.im/2.and.j.eq.(jsta+jend)/2)print*,'sample QQNR= ', & + if(i==im/2.and.j==(jsta+jend)/2)print*,'sample QQNR= ', & i,j,l,QQNR ( i, j, l ) end do end do @@ -624,7 +624,7 @@ SUBROUTINE INITPOST end if ! For aerosol aware microphyscis - if(imp_physics.eq.28) then + if(imp_physics==28) then VarName='QNCLOUD' call getVariable(fileName,DateStr,DataHandle,VarName,DUM3D, & IM+1,1,JM+1,LM+1,IM, JS,JE,LM) @@ -632,7 +632,7 @@ SUBROUTINE INITPOST do j = jsta_2l, jend_2u do i = 1, im qqnw ( i, j, l ) = dum3d ( i, j, l ) - if(i.eq.im/2.and.j.eq.(jsta+jend)/2)print*,'sample QQNW= ', & + if(i==im/2.and.j==(jsta+jend)/2)print*,'sample QQNW= ', & i,j,l,QQNW ( i, j, l ) end do end do @@ -644,7 +644,7 @@ SUBROUTINE INITPOST do j = jsta_2l, jend_2u do i = 1, im qqnwfa ( i, j, l ) = dum3d ( i, j, l ) - if(i.eq.im/2.and.j.eq.(jsta+jend)/2)print*,'sample QQNWFA= ', & + if(i==im/2.and.j==(jsta+jend)/2)print*,'sample QQNWFA= ', & i,j,l,QQNWFA ( i, j, l ) end do end do @@ -656,7 +656,7 @@ SUBROUTINE INITPOST do j = jsta_2l, jend_2u do i = 1, im qqnifa ( i, j, l ) = dum3d ( i, j, l ) - if(i.eq.im/2.and.j.eq.(jsta+jend)/2)print*,'sample QQNIFA= ', & + if(i==im/2.and.j==(jsta+jend)/2)print*,'sample QQNIFA= ', & i,j,l,QQNIFA ( i, j, l ) end do end do @@ -676,24 +676,24 @@ SUBROUTINE INITPOST ! end do ! print*,'finish reading EXTCOF55' - if(imp_physics.ne.5)then + if(imp_physics/=5)then !HC SUM UP ALL CONDENSATE FOR CWM do l = 1, lm do j = jsta_2l, jend_2u do i = 1, im - IF(QQR(I,J,L).LT.SPVAL)THEN + IF(QQR(I,J,L)=0.) then write(*,*) 'non-monotonic PINT, i,j,lm ', i,j,lm write(*,*) 'PINT: lm,lm+1, PMID: lm', PINT(I,J,LM),DUMMY(I,J), PMID(I,J,LM) DUMMY(I,J)=PMID(I,J,LM)*1.001 @@ -890,7 +890,7 @@ SUBROUTINE INITPOST rho=PMID(I,J,L)/(RD*T(I,J,L)) - if (L .le. LM-1) then + if (L <= LM-1) then QMEAN=0.5*(Q(I,J,L)+Q(I,J,L+1)) else QMEAN=Q(I,J,L) @@ -928,7 +928,7 @@ SUBROUTINE INITPOST enddo ! iteration loop ! southern boundary - if (JS .eq. 1) then + if (JS == 1) then J=1 do I=2,IM-1 pvapor(I,J)=pvapor_orig(I,J)+(pvapor(I,J+1)-pvapor_orig(I,J+1)) @@ -937,7 +937,7 @@ SUBROUTINE INITPOST ! northern boundary - if (JE .eq. JM) then + if (JE == JM) then J=JM do I=2,IM-1 pvapor(I,J)=pvapor_orig(I,J)+(pvapor(I,J-1)-pvapor_orig(I,J-1)) @@ -961,7 +961,7 @@ SUBROUTINE INITPOST PINT(I,J,LM+1)=PINT(I,J,LM+1)+PVAPOR(I,J) ! KRF - check surface pressure for monotonic correctness - if((PINT(I,J,lm) - PINT(I,J,LM+1)).ge.0. ) then + if((PINT(I,J,lm) - PINT(I,J,LM+1))>=0. ) then write(*,*) 'non-monotonic PINT, i,j,lm ', i,j,lm write(*,*) 'PINT: lm,lm+1, PMID: lm', PINT(I,J,LM), PINT(I,J,LM+1), PMID(I,J,LM) PINT(I,J,LM+1) = PINT(I,J,LM)*1.001 @@ -983,7 +983,7 @@ SUBROUTINE INITPOST do i = 1, im ZINT(I,J,LM+1)=FIS(I,J)/G DUMMY(I,J)=FIS(I,J) - if(i.eq.im/2.and.j.eq.(jsta+jend)/2) & + if(i==im/2.and.j==(jsta+jend)/2) & print*,'i,j,L,ZINT from unipost= ',i,j,LM+1,ZINT(I,J,LM+1) & , ALPINT(I,J,LM+1),ALPINT(I,J,LM) end do @@ -997,7 +997,7 @@ SUBROUTINE INITPOST DUM3D(I,J,L)=ZINT(I,J,L)-DUMMY2(I,J)/g ! now replace model heights with unipost heights ZINT(I,J,L)=DUMMY2(I,J)/G - if(i.eq.im/2.and.j.eq.(jsta+jend)/2) & + if(i==im/2.and.j==(jsta+jend)/2) & print*,'i,j,L,ZINT from unipost= ',i,j,l,ZINT(I,J,L) DUMMY(I,J)=DUMMY2(I,J) ENDDO @@ -1006,7 +1006,7 @@ SUBROUTINE INITPOST DO L=LM,1,-1 do j = js, je do i = 1, im - if(i.eq.im/2.and.j.eq.(jsta+jend)/2) then + if(i==im/2.and.j==(jsta+jend)/2) then print*,'DIFF heights model-unipost= ', & i,j,l,DUM3D(I,J,L) endif @@ -1028,7 +1028,7 @@ SUBROUTINE INITPOST max(1.e-6,(ALPINT(I,J,L+1)-ALPINT(I,J,L))) ZMID(I,J,L)=ZINT(I,J,L)+(ZINT(I,J,L+1)-ZINT(I,J,L))*FACT dummy(i,j)=ZMID(I,J,L) - if((ALPINT(I,J,L+1)-ALPINT(I,J,L)) .lt. 1.e-6) print*, & + if((ALPINT(I,J,L+1)-ALPINT(I,J,L)) < 1.e-6) print*, & 'P(K+1) and P(K) are too close, i,j,L,', & 'ALPINT(I,J,L+1),ALPINT(I,J,L),ZMID = ', & i,j,l,ALPINT(I,J,L+1),ALPINT(I,J,L),ZMID(I,J,L) @@ -1054,7 +1054,7 @@ SUBROUTINE INITPOST DO I=1,IM DO J=JS,JE ZMID(I,J,L)=(ZINT(I,J,L+1)+ZINT(I,J,L))*0.5 ! ave of z -! if(i.eq.297.and.j.eq.273) & +! if(i==297.and.j==273) & ! print*,'i,j,L,ZMID = ', & ! i,j,l,ZMID(I,J,L) ENDDO @@ -1066,7 +1066,7 @@ SUBROUTINE INITPOST ! E. James - 8 Dec 2017: this is for HRRR-smoke; it needs to be after ZINT ! is defined. ! - if(imp_physics.eq.28) then + if(imp_physics==28) then VarName='AOD3D_SMOKE' call getVariable(fileName,DateStr,DataHandle,VarName,DUM3D, & IM+1,1,JM+1,LM+1,IM, JS,JE,LM) @@ -1076,11 +1076,11 @@ SUBROUTINE INITPOST taod5503d ( i, j, l ) = dum3d ( i, j, l ) dz = ZINT( i, j, l ) - ZINT( i, j, l+1 ) aextc55 ( i, j, l ) = taod5503d ( i, j, l ) / dz - if(i.eq.im/2.and.j.eq.(jsta+jend)/2)print*,'sample TAOD5503D= ', & + if(i==im/2.and.j==(jsta+jend)/2)print*,'sample TAOD5503D= ', & i,j,l,TAOD5503D ( i, j, l ) - if(i.eq.im/2.and.j.eq.(jsta+jend)/2)print*,'sample dz= ', & + if(i==im/2.and.j==(jsta+jend)/2)print*,'sample dz= ', & dz - if(i.eq.im/2.and.j.eq.(jsta+jend)/2)print*,'sample AEXTC55= ', & + if(i==im/2.and.j==(jsta+jend)/2)print*,'sample AEXTC55= ', & i,j,l,AEXTC55 ( i, j, l ) end do end do @@ -1205,8 +1205,8 @@ SUBROUTINE INITPOST dxval=nint(tmp) write(6,*) 'dxval= ', dxval #ifdef COMMCODE - IF(MODELNAME .EQ. 'NCAR' .OR. MODELNAME == 'RAPR')THEN - if(imp_physics.ne.5 .and. imp_physics.ne.0)then + IF(MODELNAME == 'NCAR' .OR. MODELNAME == 'RAPR')THEN + if(imp_physics/=5 .and. imp_physics/=0)then #else IF(MODELNAME == 'RAPR')THEN ! J. Kenyon - 4 Apr 2019: revised cloud-cover diagnostics for RAP/HRRR @@ -1222,11 +1222,11 @@ SUBROUTINE INITPOST CFRACH(I,J)=0. do k = 1,lm - if (PMID(I,J,K) .ge. PTOP_LOW) then + if (PMID(I,J,K) >= PTOP_LOW) then CFRACL(I,J)=max(CFRACL(I,J),cfr(i,j,k)) - elseif (PMID(I,J,K) .lt. PTOP_LOW .and. PMID(I,J,K) .ge. PTOP_MID) then + elseif (PMID(I,J,K) < PTOP_LOW .and. PMID(I,J,K) >= PTOP_MID) then CFRACM(I,J)=max(CFRACM(I,J),cfr(i,j,k)) - elseif (PMID(I,J,K) .lt. PTOP_MID .and. PMID(I,J,K) .ge. PTOP_HIGH) then + elseif (PMID(I,J,K) < PTOP_MID .and. PMID(I,J,K) >= PTOP_HIGH) then CFRACH(I,J)=max(CFRACH(I,J),cfr(i,j,k)) endif enddo @@ -2055,7 +2055,7 @@ SUBROUTINE INITPOST ! end do ! print*,'QS at ',ii,jj,' = ',QS(ii,jj) - IF(MODELNAME .EQ. 'RAPR')THEN + IF(MODELNAME == 'RAPR')THEN VarName='ZNT' call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) @@ -2086,7 +2086,7 @@ SUBROUTINE INITPOST end do ! print*,'USTAR at ',ii,jj,' = ',USTAR(ii,jj) -! IF(MODELNAME .EQ. 'RAPR')THEN +! IF(MODELNAME == 'RAPR')THEN ! VarName='FLHC' ! ELSE ! VarName='AKHS' @@ -2127,7 +2127,7 @@ SUBROUTINE INITPOST ! print*,'THS at ',ii,jj,' = ',THS(ii,jj) VarName='EMISS' - IF(MODELNAME .EQ. 'RAPR')THEN + IF(MODELNAME == 'RAPR')THEN ! Update "RADOT" variable (calculated above) using model emissivity call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) @@ -2618,7 +2618,7 @@ SUBROUTINE INITPOST end do ! latent heat flux - IF(iSF_SURFACE_PHYSICS.NE.3) then + IF(iSF_SURFACE_PHYSICS/=3) then VarName='LH' call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & IM,1,JM,1,IM,JS,JE,1) @@ -2809,20 +2809,20 @@ SUBROUTINE INITPOST PBLH ( i, j ) = dummy ( i, j ) end do end do - IF(MODELNAME .EQ. 'RAPR')THEN + IF(MODELNAME == 'RAPR')THEN ! PBL depth from GSD delta_theta4gust=0.5 do j = jsta_2l, jend_2u do i = 1, im !! Is there any mixed layer at all? - if (thv(i,j,lm-1) .lt. (thv(i,j,lm) + delta_theta4gust)) then + if (thv(i,j,lm-1) < (thv(i,j,lm) + delta_theta4gust)) then ZSF=ZINT(I,J,NINT(LMH(I,J))+1) !! Calculate k1 level as first above PBL top do 34 k=3,LM k1 = k !! - give theta-v at the sfc a 0.5K boost in !! the PBL height definition - if (thv(i,j,lm-k+1).gt.(thv(i,j,lm) + delta_theta4gust)) & + if (thv(i,j,lm-k+1)>(thv(i,j,lm) + delta_theta4gust)) & ! go to 341 exit 34 continue @@ -2859,8 +2859,8 @@ SUBROUTINE INITPOST do j = jsta_2l, jend_2u do i = 1, im GDLON ( i, j ) = dummy ( i, j ) -! if(abs(GDLAT(i,j)-20.0).lt.0.5 .and. abs(GDLON(I,J) -! 1 +157.0).lt.5.)print* +! if(abs(GDLAT(i,j)-20.0)<0.5 .and. abs(GDLON(I,J) +! 1 +157.0)<5.)print* ! 2 ,'Debug:I,J,GDLON,GDLAT,SM,HGT,psfc= ',i,j,GDLON(i,j) ! 3 ,GDLAT(i,j),SM(i,j),FIS(i,j)/G,PINT(I,j,lm+1) end do @@ -2869,7 +2869,7 @@ SUBROUTINE INITPOST print*,'read past GDLON' ! pos east call collect_loc(gdlat,dummy) - if(me.eq.0)then + if(me==0)then latstart=nint(dummy(1,1)*gdsdegr) latlast=nint(dummy(im,jm)*gdsdegr) ! print*,'LL corner from model output= ',dummy(1,1) @@ -2882,7 +2882,7 @@ SUBROUTINE INITPOST call mpi_bcast(latlast,1,MPI_INTEGER,0,mpi_comm_comp,irtn) write(6,*) 'laststart,latlast A calling bcast= ',latstart,latlast call collect_loc(gdlon,dummy) - if(me.eq.0)then + if(me==0)then if(dummy(1,1)<0.0) dummy(1,1)=360.0+dummy(1,1) if(dummy(im,jm)<0.0) dummy(im,jm)=360.0+dummy(im,jm) lonstart=nint(dummy(1,1)*gdsdegr) @@ -2918,7 +2918,7 @@ SUBROUTINE INITPOST ! ncar wrf does not output zenith angle so make czen=czmean so that ! RSWIN can be output normally in SURFCE - IF(MODELNAME .NE. 'RAPR')THEN + IF(MODELNAME /= 'RAPR')THEN do j = jsta_2l, jend_2u do i = 1, im CZEN ( i, j ) = 1.0 @@ -2996,12 +2996,12 @@ SUBROUTINE INITPOST 1,ioutcount,istatus) maptype=itmp write(6,*) 'maptype is ', maptype - if(maptype.ne.6)then + if(maptype/=6)then call ext_ncd_get_dom_ti_real(DataHandle,'TRUELAT1',tmp, & 1,ioutcount,istatus) truelat1=nint(gdsdegr*tmp) write(6,*) 'truelat1= ', truelat1 - if(maptype.ne.2)then !PS projection excluded + if(maptype/=2)then !PS projection excluded call ext_ncd_get_dom_ti_real(DataHandle,'TRUELAT2',tmp, & 1,ioutcount,istatus) truelat2=nint(gdsdegr*tmp) @@ -3054,7 +3054,7 @@ SUBROUTINE INITPOST ! ! - IF(ME.EQ.0)THEN + IF(ME==0)THEN WRITE(6,*)' SPL (POSTED PRESSURE LEVELS) BELOW: ' WRITE(6,51) (SPL(L),L=1,LSM) 50 FORMAT(14(F4.1,1X)) @@ -3093,7 +3093,7 @@ SUBROUTINE INITPOST TCLOD=1.0 TPREC=float(NPREC)/TSPH - IF(NPREC.EQ.0)TPREC=float(ifhr) !in case buket does not get emptied + IF(NPREC==0)TPREC=float(ifhr) !in case buket does not get emptied print*,'NPREC,TPREC = ',NPREC,TPREC !tgs TPREC=float(ifhr) ! WRF EM does not empty precip buket at all @@ -3116,7 +3116,7 @@ SUBROUTINE INITPOST ! NSRFC = INT(TSRFC *TSPH+D50) !how am i going to get this information? ! -! IF(ME.EQ.0)THEN +! IF(ME==0)THEN ! WRITE(6,*)' ' ! WRITE(6,*)'DERIVED TIME STEPPING CONSTANTS' ! WRITE(6,*)' NPREC,NHEAT,NSRFC : ',NPREC,NHEAT,NSRFC @@ -3143,12 +3143,12 @@ SUBROUTINE INITPOST call ext_ncd_ioclose ( DataHandle, Status ) ! !HC WRITE IGDS OUT FOR WEIGHTMAKER TO READ IN AS KGDSIN - if(me.eq.0)then + if(me==0)then print*,'writing out igds' igdout=110 ! open(igdout,file='griddef.out',form='unformatted' ! + ,status='unknown') - if(maptype .eq. 1)THEN ! Lambert conformal + if(maptype == 1)THEN ! Lambert conformal WRITE(igdout)3 WRITE(6,*)'igd(1)=',3 WRITE(igdout)im @@ -3165,7 +3165,7 @@ SUBROUTINE INITPOST WRITE(igdout)TRUELAT2 WRITE(igdout)TRUELAT1 WRITE(igdout)255 - ELSE IF(MAPTYPE .EQ. 2)THEN !Polar stereographic + ELSE IF(MAPTYPE == 2)THEN !Polar stereographic WRITE(igdout)5 WRITE(igdout)im WRITE(igdout)jm @@ -3184,7 +3184,7 @@ SUBROUTINE INITPOST ! lat/lon and the PSMAPF ! Get map factor at 60 degrees (N or S) for PS projection, which will ! be needed to correctly define the DX and DY values in the GRIB GDS - if (TRUELAT1 .LT. 0.) THEN + if (TRUELAT1 < 0.) THEN LAT = -60. else LAT = 60. @@ -3192,7 +3192,7 @@ SUBROUTINE INITPOST CALL MSFPS (LAT,TRUELAT1*0.001,PSMAPF) - ELSE IF(MAPTYPE .EQ. 3)THEN !Mercator + ELSE IF(MAPTYPE == 3)THEN !Mercator WRITE(igdout)1 WRITE(igdout)im WRITE(igdout)jm @@ -3207,7 +3207,7 @@ SUBROUTINE INITPOST WRITE(igdout)DXVAL WRITE(igdout)DYVAL WRITE(igdout)255 - ELSE IF(MAPTYPE.EQ.6 )THEN ! ARW rotated lat/lon grid + ELSE IF(MAPTYPE==6 )THEN ! ARW rotated lat/lon grid WRITE(igdout)205 WRITE(igdout)im WRITE(igdout)jm diff --git a/sorc/ncep_post.fd/INITPOST_GFS.f b/sorc/ncep_post.fd/INITPOST_GFS.f index 8dfec2d34..966e79fcb 100644 --- a/sorc/ncep_post.fd/INITPOST_GFS.f +++ b/sorc/ncep_post.fd/INITPOST_GFS.f @@ -202,7 +202,7 @@ SUBROUTINE INITPOST_GFS(NREC,iunit,iostatusFlux,iunitd3d,iostatusD3D,gfile) ! The end j row is going to be jend_2u for all variables except for V. JS=JSTA_2L JE=JEND_2U - IF (JEND_2U.EQ.JM) THEN + IF (JEND_2U==JM) THEN JEV=JEND_2U+1 ELSE JEV=JEND_2U @@ -315,14 +315,14 @@ SUBROUTINE INITPOST_GFS(NREC,iunit,iostatusFlux,iunitd3d,iostatusD3D,gfile) ! do j = jsta_2l, jend_2u ! do i = 1, im ! GDLON(I,J)=buf(I,J)*RTD -! if(i.eq.409.and.j.eq.835)print*,'GDLAT GDLON in INITPOST=' +! if(i==409.and.j==835)print*,'GDLAT GDLON in INITPOST=' ! + ,i,j,GDLAT(I,J),GDLON(I,J) ! enddo ! enddo ! end if ! end if -! if(jsta.le.594.and.jend.ge.594)print*,'gdlon(120,594)= ', +! if(jsta<=594.and.jend>=594)print*,'gdlon(120,594)= ', ! + gdlon(120,594) @@ -393,7 +393,7 @@ SUBROUTINE INITPOST_GFS(NREC,iunit,iostatusFlux,iunitd3d,iostatusD3D,gfile) ! call ext_int_get_dom_ti_integer(DataHandle,'RESTARTBIN',itmp ! + ,1,ioutcount,istatus) -! IF(itmp .LT. 1)THEN +! IF(itmp < 1)THEN ! RESTRT=.FALSE. ! ELSE ! RESTRT=.TRUE. @@ -403,7 +403,7 @@ SUBROUTINE INITPOST_GFS(NREC,iunit,iostatusFlux,iunitd3d,iostatusD3D,gfile) ! print*,'Is this a restrt run? ',RESTRT - IF(tstart .GT. 1.0E-2)THEN + IF(tstart > 1.0E-2)THEN ifhr = ifhr+NINT(tstart) rinc = 0 idate = 0 @@ -492,7 +492,7 @@ SUBROUTINE INITPOST_GFS(NREC,iunit,iostatusFlux,iunitd3d,iostatusD3D,gfile) ! do j = 1, jm ! do i = 1, im ! dummy(I,J)=1.0 - dummy(I,J) ! convert Grib message to 2D -! if (j.eq.jm/2 .and. mod(i,10).eq.0) +! if (j==jm/2 .and. mod(i,10)==0) ! + print*,'sample ',VarName, ' = ',i,j,dummy(i,j) ! ! enddo @@ -518,7 +518,7 @@ SUBROUTINE INITPOST_GFS(NREC,iunit,iostatusFlux,iunitd3d,iostatusD3D,gfile) ! do j=jsta,jend ! do i=1,im -! if (j.eq.jm/2 .and. mod(i,50).eq.0) +! if (j==jm/2 .and. mod(i,50)==0) ! + print*,'sample ',VarName, ' = ',i,j,sm(i,j) ! end do ! end do @@ -527,7 +527,7 @@ SUBROUTINE INITPOST_GFS(NREC,iunit,iostatusFlux,iunitd3d,iostatusD3D,gfile) ! call mpi_scatter(dummy(1,1),itmp,mpi_real ! + ,sm(1,jsta),itmp,mpi_real,0,MPI_COMM_COMP,ierr) print*,'error code from scattering sm= ',ierr -! if (abs(ierr-0).gt.1)print*,'Error scattering array';stop +! if (abs(ierr-0)>1)print*,'Error scattering array';stop ! print*,'done scattering sea mask' ! sea ice mask using GFSIO ! VarName='icec' @@ -578,7 +578,7 @@ SUBROUTINE INITPOST_GFS(NREC,iunit,iostatusFlux,iunitd3d,iostatusD3D,gfile) do j = 1, jm do i = 1, im dummy(I,J)= dummy(i,j)*con_G -! if (j.eq.jm/2 .and. mod(i,50).eq.0) +! if (j==jm/2 .and. mod(i,50)==0) ! + print*,'sample ',trim(VarName), ' = ',i,j,dummy(i,j) enddo enddo @@ -604,7 +604,7 @@ SUBROUTINE INITPOST_GFS(NREC,iunit,iostatusFlux,iunitd3d,iostatusD3D,gfile) ! do j = 1, jm ! do i = 1, im ! dummy(I,J)=dummy(I,J)*G ! convert to gpm -! if (j.eq.jm/2 .and. mod(i,10).eq.0) +! if (j==jm/2 .and. mod(i,10)==0) ! + print*,'sample ',VarName, ' = ',i,j,dummy(i,j) ! ! enddo @@ -634,7 +634,7 @@ SUBROUTINE INITPOST_GFS(NREC,iunit,iostatusFlux,iunitd3d,iostatusD3D,gfile) ,t(1,jsta,ll),icnt(me),mpi_real,0,MPI_COMM_COMP,iret) ! do j=jsta,jend ! do i=1,im -! if (j.eq.jm/2 .and. mod(i,50).eq.0) +! if (j==jm/2 .and. mod(i,50)==0) ! + print*,'sample ',trim(VarName), ' after scatter= ' ! + ,i,j,ll,t(i,j,ll) ! end do @@ -660,7 +660,7 @@ SUBROUTINE INITPOST_GFS(NREC,iunit,iostatusFlux,iunitd3d,iostatusD3D,gfile) ,q(1,jsta,ll),icnt(me),mpi_real,0,MPI_COMM_COMP,iret) ! do j=jsta,jend ! do i=1,im -! if (j.eq.jm/2 .and. mod(i,50).eq.0) +! if (j==jm/2 .and. mod(i,50)==0) ! + print*,'sample ',trim(VarName), ' after scatter= ' ! + ,i,j,ll,q(i,j,ll) ! end do @@ -686,7 +686,7 @@ SUBROUTINE INITPOST_GFS(NREC,iunit,iostatusFlux,iunitd3d,iostatusD3D,gfile) ,uh(1,jsta,ll),icnt(me),mpi_real,0,MPI_COMM_COMP,iret) ! do j=jsta,jend ! do i=1,im -! if (j.eq.jm/2 .and. mod(i,50).eq.0) +! if (j==jm/2 .and. mod(i,50)==0) ! + print*,'sample ',trim(VarName), ' after scatter= ' ! + ,i,j,ll,uh(i,j,ll) ! end do @@ -713,7 +713,7 @@ SUBROUTINE INITPOST_GFS(NREC,iunit,iostatusFlux,iunitd3d,iostatusD3D,gfile) ! do j=jsta,jend ! do i=1,im -! if (j.eq.jm/2 .and. mod(i,50).eq.0) +! if (j==jm/2 .and. mod(i,50)==0) ! + print*,'sample ',trim(VarName), ' after scatter= ' ! + ,i,j,ll,vh(i,j,ll) ! end do @@ -739,7 +739,7 @@ SUBROUTINE INITPOST_GFS(NREC,iunit,iostatusFlux,iunitd3d,iostatusD3D,gfile) ,pmid(1,jsta,ll),icnt(me),mpi_real,0,MPI_COMM_COMP,iret) ! do j=jsta,jend ! do i=1,im -! if (j.eq.jm/2 .and. mod(i,50).eq.0) +! if (j==jm/2 .and. mod(i,50)==0) ! + print*,'sample ',trim(VarName), ' after scatter= ' ! + ,i,j,ll,pmid(i,j,ll) ! end do @@ -765,7 +765,7 @@ SUBROUTINE INITPOST_GFS(NREC,iunit,iostatusFlux,iunitd3d,iostatusD3D,gfile) ,pint(1,jsta,lp1),icnt(me),mpi_real,0,MPI_COMM_COMP,iret) ! do j=jsta,jend ! do i=1,im -! if (j.eq.jm/2 .and. mod(i,50).eq.0) +! if (j==jm/2 .and. mod(i,50)==0) ! + print*,'sample PSFC after scatter= ' ! + ,i,j,pint(i,j,lp1) ! end do @@ -904,7 +904,7 @@ SUBROUTINE INITPOST_GFS(NREC,iunit,iostatusFlux,iunitd3d,iostatusD3D,gfile) ! FI(I,J,2)=HTM(I,J,L)*T(I,J,L)*(Q(I,J,L)*D608+1.0)*RD* ! 1 (ALPINT(I,J,L+1)-ALPINT(I,J,L))+FI(I,J,1) ! ZINT(I,J,L)=FI(I,J,2)/G -! if(i.eq.ii.and.j.eq.jj) +! if(i==ii.and.j==jj) ! 1 print*,'L,sample HTM,T,Q,ALPINT(L+1),ALPINT(l),ZINT= ' ! 2 ,l,HTM(I,J,L),T(I,J,L),Q(I,J,L),ALPINT(I,J,L+1), ! 3 ALPINT(I,J,L),ZINT(I,J,L) @@ -945,7 +945,7 @@ SUBROUTINE INITPOST_GFS(NREC,iunit,iostatusFlux,iunitd3d,iostatusD3D,gfile) ,o3(1,jsta,ll),icnt(me),mpi_real,0,MPI_COMM_COMP,iret) ! do j=jsta,jend ! do i=1,im -! if (j.eq.jm/2 .and. mod(i,50).eq.0) +! if (j==jm/2 .and. mod(i,50)==0) ! + print*,'sample ',trim(VarName), ' after scatter= ' ! + ,i,j,ll,o3(i,j,ll) ! end do @@ -981,7 +981,7 @@ SUBROUTINE INITPOST_GFS(NREC,iunit,iostatusFlux,iunitd3d,iostatusD3D,gfile) else qqw(i,j,ll)=cwm(i,j,ll) end if -! if (j.eq.jm/2 .and. mod(i,50).eq.0) +! if (j==jm/2 .and. mod(i,50)==0) ! + print*,'sample ',trim(VarName), ' after scatter= ' ! + ,i,j,ll,cwm(i,j,ll) end do @@ -1105,7 +1105,7 @@ SUBROUTINE INITPOST_GFS(NREC,iunit,iostatusFlux,iunitd3d,iostatusD3D,gfile) ! do j = 1, jm ! do i = 1, im ! dummy(I,J)= dummy(i,j)*(p1000/pint(i,j,lm+1))**CAPA ! convert to THS -! if (j.eq.jm/2 .and. mod(i,50).eq.0) +! if (j==jm/2 .and. mod(i,50)==0) ! + print*,'sample ',VarName, ' = ',i,j,dummy(i,j) ! enddo ! enddo @@ -1130,7 +1130,7 @@ SUBROUTINE INITPOST_GFS(NREC,iunit,iostatusFlux,iunitd3d,iostatusD3D,gfile) do i=1,im if (ths(i,j) /= spval) & ths(i,j)=ths(i,j)*(p1000/pint(i,j,lp1))**CAPA ! convert to THS - if (j.eq.jm/2 .and. mod(i,50).eq.0) & + if (j==jm/2 .and. mod(i,50)==0) & print*,'sample ',VarName, ' psfc = ',i,j,ths(i,j),pint(i,j,lp1) end do end do @@ -1167,7 +1167,7 @@ SUBROUTINE INITPOST_GFS(NREC,iunit,iostatusFlux,iunitd3d,iostatusD3D,gfile) ! do j = 1, jm ! do i = 1, im ! dummy(I,J)= dummy(i,j)*dtq2/1000. ! convert to m -! if (j.eq.jm/2 .and. mod(i,50).eq.0) +! if (j==jm/2 .and. mod(i,50)==0) ! + print*,'sample ',VarName, ' = ',i,j,dummy(i,j) ! enddo ! enddo @@ -1234,7 +1234,7 @@ SUBROUTINE INITPOST_GFS(NREC,iunit,iostatusFlux,iunitd3d,iostatusD3D,gfile) ! do j = 1, jm ! do i = 1, im ! dummy(I,J)= dummy(i,j)*dtq2/1000. ! convert to m -! if (j.eq.jm/2 .and. mod(i,50).eq.0) +! if (j==jm/2 .and. mod(i,50)==0) ! + print*,'sample ',VarName, ' = ',i,j,dummy(i,j) ! enddo ! enddo @@ -1331,7 +1331,7 @@ SUBROUTINE INITPOST_GFS(NREC,iunit,iostatusFlux,iunitd3d,iostatusD3D,gfile) ! do j = 1, jm ! do i = 1, im ! dummy(I,J)= dummy(i,j)*1000. ! convert to mm -! if (j.eq.jm/2 .and. mod(i,50).eq.0) +! if (j==jm/2 .and. mod(i,50)==0) ! + print*,'sample ',VarName, ' = ',i,j,dummy(i,j) ! enddo ! enddo @@ -1402,7 +1402,7 @@ SUBROUTINE INITPOST_GFS(NREC,iunit,iostatusFlux,iunitd3d,iostatusD3D,gfile) else PSHLTR(I,J)=spval end if -! if (j.eq.jm/2 .and. mod(i,50).eq.0) +! if (j==jm/2 .and. mod(i,50)==0) ! + print*,'sample 2m T and P after scatter= ' ! + ,i,j,tshltr(i,j),pshltr(i,j) end do @@ -1457,7 +1457,7 @@ SUBROUTINE INITPOST_GFS(NREC,iunit,iostatusFlux,iunitd3d,iostatusD3D,gfile) ! do j = 1, jm ! do i = 1, im ! dummy(I,J)= dummy(i,j)/100. ! convert to fraction -! if (j.eq.jm/2 .and. mod(i,50).eq.0) +! if (j==jm/2 .and. mod(i,50)==0) ! + print*,'sample ',VarName, ' = ',i,j,dummy(i,j) ! enddo ! enddo @@ -1527,7 +1527,7 @@ SUBROUTINE INITPOST_GFS(NREC,iunit,iostatusFlux,iunitd3d,iostatusD3D,gfile) ! do j = 1, jm ! do i = 1, im ! dummy(I,J)= dummy(i,j)/100. ! convert to fraction -! if (j.eq.jm/2 .and. mod(i,50).eq.0) +! if (j==jm/2 .and. mod(i,50)==0) ! + print*,'sample ',VarName, ' = ',i,j,dummy(i,j) ! enddo ! enddo @@ -1583,7 +1583,7 @@ SUBROUTINE INITPOST_GFS(NREC,iunit,iostatusFlux,iunitd3d,iostatusD3D,gfile) ! do j = jsta_2l, jend_2u ! do i = 1, im ! F_ice( i, j, l ) = buf3d ( i, ll, j ) -! if(i.eq.im/2.and.j.eq.(jsta+jend)/2)print*,'sample F_ice= ', +! if(i==im/2.and.j==(jsta+jend)/2)print*,'sample F_ice= ', ! + i,j,l,F_ice( i, j, l ) ! end do ! end do @@ -1611,7 +1611,7 @@ SUBROUTINE INITPOST_GFS(NREC,iunit,iostatusFlux,iunitd3d,iostatusD3D,gfile) ! do j = jsta_2l, jend_2u ! do i = 1, im ! F_rain( i, j, l ) = buf3d ( i, ll, j ) -! if(i.eq.im/2.and.j.eq.(jsta+jend)/2)print*,'sample F_rain= ', +! if(i==im/2.and.j==(jsta+jend)/2)print*,'sample F_rain= ', ! + i,j,l,F_rain( i, j, l ) ! end do ! end do @@ -1639,7 +1639,7 @@ SUBROUTINE INITPOST_GFS(NREC,iunit,iostatusFlux,iunitd3d,iostatusD3D,gfile) ! do j = jsta_2l, jend_2u ! do i = 1, im ! F_RimeF( i, j, l ) = buf3d ( i, ll, j ) -! if(i.eq.im/2.and.j.eq.(jsta+jend)/2)print*, +! if(i==im/2.and.j==(jsta+jend)/2)print*, ! + 'sample F_RimeF= ',i,j,l,F_RimeF( i, j, l ) ! end do ! end do @@ -1748,7 +1748,7 @@ SUBROUTINE INITPOST_GFS(NREC,iunit,iostatusFlux,iunitd3d,iostatusD3D,gfile) ! do j = 1, jm ! do i = 1, im ! dummy(I,J)= dummy(i,j)/100. ! convert to fraction -! if (j.eq.jm/2 .and. mod(i,50).eq.0) +! if (j==jm/2 .and. mod(i,50)==0) ! + print*,'sample ',VarName, ' = ',i,j,dummy(i,j) ! enddo ! enddo @@ -1784,7 +1784,7 @@ SUBROUTINE INITPOST_GFS(NREC,iunit,iostatusFlux,iunitd3d,iostatusD3D,gfile) ! do j = 1, jm ! do i = 1, im ! dummy(I,J)= dummy(i,j)/100. ! convert to fraction -! if (j.eq.jm/2 .and. mod(i,50).eq.0) +! if (j==jm/2 .and. mod(i,50)==0) ! + print*,'sample ',VarName, ' = ',i,j,dummy(i,j) ! enddo ! enddo @@ -1821,7 +1821,7 @@ SUBROUTINE INITPOST_GFS(NREC,iunit,iostatusFlux,iunitd3d,iostatusD3D,gfile) ! do j = 1, jm ! do i = 1, im ! dummy(I,J)= dummy(i,j)/100. ! convert to fraction -! if (j.eq.jm/2 .and. mod(i,50).eq.0) +! if (j==jm/2 .and. mod(i,50)==0) ! + print*,'sample ',VarName, ' = ',i,j,dummy(i,j) ! enddo ! enddo @@ -1886,7 +1886,7 @@ SUBROUTINE INITPOST_GFS(NREC,iunit,iostatusFlux,iunitd3d,iostatusD3D,gfile) ! do j=jsta,jend ! do i=1,im -! if (j.eq.jm/2 .and. mod(i,50).eq.0) +! if (j==jm/2 .and. mod(i,50)==0) ! + print*,'sample ',trim(VarName), ' after scatter= ' ! + ,i,j,islope(i,j) ! end do @@ -1907,7 +1907,7 @@ SUBROUTINE INITPOST_GFS(NREC,iunit,iostatusFlux,iunitd3d,iostatusD3D,gfile) ! do j = 1, jm ! do i = 1, im ! dummy(I,J)= dummy(i,j)/1000. ! convert from kg*m^2 to m -! if (j.eq.jm/2 .and. mod(i,50).eq.0) +! if (j==jm/2 .and. mod(i,50)==0) ! + print*,'sample ',VarName, ' = ',i,j,dummy(i,j) ! enddo ! enddo @@ -2049,7 +2049,7 @@ SUBROUTINE INITPOST_GFS(NREC,iunit,iostatusFlux,iunitd3d,iostatusD3D,gfile) ! do j=jsta,jend ! do i=1,im -! if (j.eq.jm/2 .and. mod(i,50).eq.0) +! if (j==jm/2 .and. mod(i,50)==0) ! + print*,'sample ',trim(VarName), ' after scatter= ' ! + ,i,j,l,sh2o(i,j,l) ! end do @@ -2099,7 +2099,7 @@ SUBROUTINE INITPOST_GFS(NREC,iunit,iostatusFlux,iunitd3d,iostatusD3D,gfile) ! do j=jsta,jend ! do i=1,im -! if (j.eq.jm/2 .and. mod(i,50).eq.0) +! if (j==jm/2 .and. mod(i,50)==0) ! + print*,'sample ',trim(VarName), ' after scatter= ' ! + ,i,j,l,smc(i,j,l) ! end do @@ -2151,7 +2151,7 @@ SUBROUTINE INITPOST_GFS(NREC,iunit,iostatusFlux,iunitd3d,iostatusD3D,gfile) ! do j=jsta,jend ! do i=1,im -! if (j.eq.jm/2 .and. mod(i,50).eq.0) +! if (j==jm/2 .and. mod(i,50)==0) ! + print*,'sample ',trim(VarName), ' after scatter= ' ! + ,i,j,l,stc(i,j,l) ! end do @@ -2328,7 +2328,7 @@ SUBROUTINE INITPOST_GFS(NREC,iunit,iostatusFlux,iunitd3d,iostatusD3D,gfile) ,jpds,jgds,kpds,aswin) ! do j=jsta,jend ! do i=1,im -! if (j.eq.jm/2 .and. mod(i,50).eq.0) +! if (j==jm/2 .and. mod(i,50)==0) ! + print*,'sample ',trim(VarName), ' after scatter= ' ! + ,i,j,aswin(i,j) ! end do @@ -2365,7 +2365,7 @@ SUBROUTINE INITPOST_GFS(NREC,iunit,iostatusFlux,iunitd3d,iostatusD3D,gfile) ,jpds,jgds,kpds,auvbin) ! do j=jsta,jend ! do i=1,im -! if (j.eq.jm/2 .and. mod(i,50).eq.0) +! if (j==jm/2 .and. mod(i,50)==0) ! + print*,'sample ',trim(VarName), ' after scatter= ' ! + ,i,j,auvbin(i,j) ! end do @@ -2385,7 +2385,7 @@ SUBROUTINE INITPOST_GFS(NREC,iunit,iostatusFlux,iunitd3d,iostatusD3D,gfile) ! do j=jsta,jend ! do i=1,im -! if (j.eq.jm/2 .and. mod(i,50).eq.0) +! if (j==jm/2 .and. mod(i,50)==0) ! + print*,'sample ',trim(VarName), ' after scatter= ' ! + ,i,j,auvbinc(i,j) ! end do @@ -2421,7 +2421,7 @@ SUBROUTINE INITPOST_GFS(NREC,iunit,iostatusFlux,iunitd3d,iostatusD3D,gfile) where(aswout /= spval) aswout=-aswout ! CLDRAD puts a minus sign before gribbing ! do j=jsta,jend ! do i=1,im -! if (j.eq.jm/2 .and. mod(i,50).eq.0) +! if (j==jm/2 .and. mod(i,50)==0) ! + print*,'sample ',trim(VarName), ' after scatter= ' ! + ,i,j,aswout(i,j) ! end do @@ -2606,7 +2606,7 @@ SUBROUTINE INITPOST_GFS(NREC,iunit,iostatusFlux,iunitd3d,iostatusD3D,gfile) ! do j = 1, jm ! do i = 1, im ! dummy(I,J)= dummy(i,j)*-1.0 -! if (j.eq.jm/2 .and. mod(i,50).eq.0) +! if (j==jm/2 .and. mod(i,50)==0) ! + print*,'sample ',VarName, ' = ',i,j,dummy(i,j) ! enddo ! enddo @@ -2692,7 +2692,7 @@ SUBROUTINE INITPOST_GFS(NREC,iunit,iostatusFlux,iunitd3d,iostatusD3D,gfile) ! do j=jsta,jend ! do i=1,im -! if (j.eq.jm/2 .and. mod(i,50).eq.0) +! if (j==jm/2 .and. mod(i,50)==0) ! + print*,'sample ',trim(VarName), ' after scatter= ' ! + ,i,j,sfcux(i,j) ! end do @@ -2814,7 +2814,7 @@ SUBROUTINE INITPOST_GFS(NREC,iunit,iostatusFlux,iunitd3d,iostatusD3D,gfile) ! do j=jsta,jend ! do i=1,im -! if (j.eq.jm/2 .and. mod(i,50).eq.0) +! if (j==jm/2 .and. mod(i,50)==0) ! + print*,'sample ',trim(VarName), ' after scatter= ' ! + ,i,j,u10(i,j) ! end do @@ -2933,7 +2933,7 @@ SUBROUTINE INITPOST_GFS(NREC,iunit,iostatusFlux,iunitd3d,iostatusD3D,gfile) thz0(i,j)=ths(i,j) end do end do - if(jj.ge.jsta.and.jj.le.jend)print*,'THZ0 at ',ii,jj,'=',THZ0(ii,jj) + if(jj>=jsta.and.jj<=jend)print*,'THZ0 at ',ii,jj,'=',THZ0(ii,jj) ! GFS does not output humidity at roughness length qz0=spval @@ -3042,7 +3042,7 @@ SUBROUTINE INITPOST_GFS(NREC,iunit,iostatusFlux,iunitd3d,iostatusD3D,gfile) if(pbot(i,j) <= 0.0)pbot(i,j)=spval ! if(.not.lb(i,j))print*,'false bitmask for pbot at ' ! + ,i,j,pbot(i,j) - if(pbot(i,j) .lt. spval)then + if(pbot(i,j) < spval)then do l=lm,1,-1 if(pbot(i,j) >= pmid(i,j,l))then hbot(i,j)=l @@ -3765,7 +3765,7 @@ SUBROUTINE INITPOST_GFS(NREC,iunit,iostatusFlux,iunitd3d,iostatusD3D,gfile) print *,'after d3d files reading,mype=',me ! pos east call collect_loc(gdlat,dummy) - if(me.eq.0)then + if(me==0)then latstart=nint(dummy(1,1)*gdsdegr) latlast=nint(dummy(im,jm)*gdsdegr) print*,'laststart,latlast B bcast= ',latstart,latlast @@ -3774,7 +3774,7 @@ SUBROUTINE INITPOST_GFS(NREC,iunit,iostatusFlux,iunitd3d,iostatusD3D,gfile) call mpi_bcast(latlast,1,MPI_INTEGER,0,mpi_comm_comp,irtn) write(6,*) 'laststart,latlast,me A calling bcast=',latstart,latlast,me call collect_loc(gdlon,dummy) - if(me.eq.0)then + if(me==0)then lonstart=nint(dummy(1,1)*gdsdegr) lonlast=nint(dummy(im,jm)*gdsdegr) end if @@ -3835,7 +3835,7 @@ SUBROUTINE INITPOST_GFS(NREC,iunit,iostatusFlux,iunitd3d,iostatusD3D,gfile) ! ! - IF(ME.EQ.0)THEN + IF(ME==0)THEN WRITE(6,*)' SPL (POSTED PRESSURE LEVELS) BELOW: ' WRITE(6,51) (SPL(L),L=1,LSM) 50 FORMAT(14(F4.1,1X)) @@ -3859,7 +3859,7 @@ SUBROUTINE INITPOST_GFS(NREC,iunit,iostatusFlux,iunitd3d,iostatusD3D,gfile) ! NSRFC = INT(TSRFC *TSPH+D50) !how am i going to get this information? ! -! IF(ME.EQ.0)THEN +! IF(ME==0)THEN ! WRITE(6,*)' ' ! WRITE(6,*)'DERIVED TIME STEPPING CONSTANTS' ! WRITE(6,*)' NPREC,NHEAT,NSRFC : ',NPREC,NHEAT,NSRFC @@ -3872,12 +3872,12 @@ SUBROUTINE INITPOST_GFS(NREC,iunit,iostatusFlux,iunitd3d,iostatusD3D,gfile) END DO ! !HC WRITE IGDS OUT FOR WEIGHTMAKER TO READ IN AS KGDSIN - if(me.eq.0)then + if(me==0)then print*,'writing out igds' igdout=110 ! open(igdout,file='griddef.out',form='unformatted' ! + ,status='unknown') - if(maptype .eq. 1)THEN ! Lambert conformal + if(maptype == 1)THEN ! Lambert conformal WRITE(igdout)3 WRITE(6,*)'igd(1)=',3 WRITE(igdout)im @@ -3893,7 +3893,7 @@ SUBROUTINE INITPOST_GFS(NREC,iunit,iostatusFlux,iunitd3d,iostatusD3D,gfile) WRITE(igdout)TRUELAT2 WRITE(igdout)TRUELAT1 WRITE(igdout)255 - ELSE IF(MAPTYPE .EQ. 2)THEN !Polar stereographic + ELSE IF(MAPTYPE == 2)THEN !Polar stereographic WRITE(igdout)5 WRITE(igdout)im WRITE(igdout)jm @@ -3912,7 +3912,7 @@ SUBROUTINE INITPOST_GFS(NREC,iunit,iostatusFlux,iunitd3d,iostatusD3D,gfile) ! lat/lon and the PSMAPF ! Get map factor at 60 degrees (N or S) for PS projection, which will ! be needed to correctly define the DX and DY values in the GRIB GDS - if (TRUELAT1 .LT. 0.) THEN + if (TRUELAT1 < 0.) THEN LAT = -60. else LAT = 60. @@ -3920,7 +3920,7 @@ SUBROUTINE INITPOST_GFS(NREC,iunit,iostatusFlux,iunitd3d,iostatusD3D,gfile) CALL MSFPS (LAT,TRUELAT1*0.001,PSMAPF) - ELSE IF(MAPTYPE .EQ. 3)THEN !Mercator + ELSE IF(MAPTYPE == 3)THEN !Mercator WRITE(igdout)1 WRITE(igdout)im WRITE(igdout)jm @@ -3935,7 +3935,7 @@ SUBROUTINE INITPOST_GFS(NREC,iunit,iostatusFlux,iunitd3d,iostatusD3D,gfile) WRITE(igdout)DXVAL WRITE(igdout)DYVAL WRITE(igdout)255 - ELSE IF(MAPTYPE.EQ.0 .OR. MAPTYPE.EQ.203)THEN !A STAGGERED E-GRID + ELSE IF(MAPTYPE==0 .OR. MAPTYPE==203)THEN !A STAGGERED E-GRID WRITE(igdout)203 WRITE(igdout)im WRITE(igdout)jm diff --git a/sorc/ncep_post.fd/INITPOST_GFS_NEMS.f b/sorc/ncep_post.fd/INITPOST_GFS_NEMS.f index 369362b99..86d5bbffe 100644 --- a/sorc/ncep_post.fd/INITPOST_GFS_NEMS.f +++ b/sorc/ncep_post.fd/INITPOST_GFS_NEMS.f @@ -390,7 +390,7 @@ SUBROUTINE INITPOST_GFS_NEMS(NREC,iostatusFlux,iostatusD3D, & ! end if ! end if -! if(jsta.le.594.and.jend.ge.594)print*,'gdlon(120,594)= ', +! if(jsta<=594.and.jend>=594)print*,'gdlon(120,594)= ', ! + gdlon(120,594) @@ -499,7 +499,7 @@ SUBROUTINE INITPOST_GFS_NEMS(NREC,iostatusFlux,iostatusD3D, & ! call ext_int_get_dom_ti_integer(DataHandle,'RESTARTBIN',itmp ! + ,1,ioutcount,istatus) -! IF(itmp .LT. 1)THEN +! IF(itmp < 1)THEN ! RESTRT=.FALSE. ! ELSE ! RESTRT=.TRUE. diff --git a/sorc/ncep_post.fd/INITPOST_GFS_NETCDF.f b/sorc/ncep_post.fd/INITPOST_GFS_NETCDF.f index fb6ef4611..3dcc4b2b9 100644 --- a/sorc/ncep_post.fd/INITPOST_GFS_NETCDF.f +++ b/sorc/ncep_post.fd/INITPOST_GFS_NETCDF.f @@ -487,7 +487,7 @@ SUBROUTINE INITPOST_GFS_NETCDF(ncid3d) end if ! Jili Dong add support for regular lat lon (2019/03/22) start - if (MAPTYPE .eq. 0) then + if (MAPTYPE == 0) then if(lonstart<0.)then lonstart=lonstart+360.*gdsdegr end if diff --git a/sorc/ncep_post.fd/INITPOST_GFS_NETCDF_PARA.f b/sorc/ncep_post.fd/INITPOST_GFS_NETCDF_PARA.f index f20c17f49..91d7b8d5d 100644 --- a/sorc/ncep_post.fd/INITPOST_GFS_NETCDF_PARA.f +++ b/sorc/ncep_post.fd/INITPOST_GFS_NETCDF_PARA.f @@ -487,7 +487,7 @@ SUBROUTINE INITPOST_GFS_NETCDF_PARA(ncid3d) end if ! Jili Dong add support for regular lat lon (2019/03/22) start - if (MAPTYPE .eq. 0) then + if (MAPTYPE == 0) then if(lonstart<0.)then lonstart=lonstart+360.*gdsdegr end if diff --git a/sorc/ncep_post.fd/INITPOST_GFS_SIGIO.f b/sorc/ncep_post.fd/INITPOST_GFS_SIGIO.f index 96decc615..bee74b5b9 100644 --- a/sorc/ncep_post.fd/INITPOST_GFS_SIGIO.f +++ b/sorc/ncep_post.fd/INITPOST_GFS_SIGIO.f @@ -380,7 +380,7 @@ SUBROUTINE INITPOST_GFS_SIGIO(lusig,iunit,iostatusFlux,iostatusD3D,idrt,sighead) RESTRT=.TRUE. ! set RESTRT as default - IF(tstart .GT. 1.0E-2)THEN + IF(tstart > 1.0E-2)THEN ifhr = ifhr+NINT(tstart) rinc = 0 idate = 0 @@ -810,7 +810,7 @@ SUBROUTINE INITPOST_GFS_SIGIO(lusig,iunit,iostatusFlux,iostatusD3D,idrt,sighead) FACT = (ALPINT(I,J,L)-wrk1(i,j)) / (pmll-wrk1(i,j)) ZINT(I,J,L) = ZMID(I,J,L) + (ZMID(I,J,LL)-ZMID(I,J,L)) * FACT -! if(i.eq.ii.and.j.eq.jj) & +! if(i==ii.and.j==jj) & ! print*,'L,sample T,Q,ALPMID(L+1),ALPMID(L),ZMID= ' & ! ,l,T(I,J,L),Q(I,J,L),LOG(PMID(I,J,L+1)), & ! LOG(PMID(I,J,L)),ZMID(I,J,L) @@ -1085,7 +1085,7 @@ SUBROUTINE INITPOST_GFS_SIGIO(lusig,iunit,iostatusFlux,iostatusD3D,idrt,sighead) else PSHLTR(I,J) = spval end if -! if (j.eq.jm/2 .and. mod(i,50).eq.0) +! if (j==jm/2 .and. mod(i,50)==0) ! + print*,'sample 2m T and P after scatter= ' ! + ,i,j,tshltr(i,j),pshltr(i,j) end do @@ -2093,7 +2093,7 @@ SUBROUTINE INITPOST_GFS_SIGIO(lusig,iunit,iostatusFlux,iostatusD3D,idrt,sighead) if(pbot(i,j) <= 0.0) pbot(i,j) = spval ! if(.not.lb(i,j))print*,'false bitmask for pbot at ' ! + ,i,j,pbot(i,j) - if(pbot(i,j) .lt. spval)then + if(pbot(i,j) < spval)then do l=lm,1,-1 if(pbot(i,j) >= pmid(i,j,l))then hbot(i,j) = l @@ -2880,7 +2880,7 @@ SUBROUTINE INITPOST_GFS_SIGIO(lusig,iunit,iostatusFlux,iostatusD3D,idrt,sighead) call mpi_bcast(latlast,1,MPI_INTEGER,0,mpi_comm_comp,irtn) write(6,*) 'laststart,latlast,me A calling bcast=',latstart,latlast,me call collect_loc(gdlon,dummy) - if(me.eq.0)then + if(me==0)then lonstart=nint(dummy(1,1)*gdsdegr) lonlast=nint(dummy(im,jm)*gdsdegr) end if @@ -2943,7 +2943,7 @@ SUBROUTINE INITPOST_GFS_SIGIO(lusig,iunit,iostatusFlux,iostatusD3D,idrt,sighead) ! write(0,*)'end ini_gfs_sigio' ! ! - IF(ME.EQ.0)THEN + IF(ME==0)THEN WRITE(6,*)' SPL (POSTED PRESSURE LEVELS) BELOW: ' WRITE(6,51) (SPL(L),L=1,LSM) 50 FORMAT(14(F4.1,1X)) @@ -2967,7 +2967,7 @@ SUBROUTINE INITPOST_GFS_SIGIO(lusig,iunit,iostatusFlux,iostatusD3D,idrt,sighead) ! NSRFC = INT(TSRFC *TSPH+D50) !how am i going to get this information? ! -! IF(ME.EQ.0)THEN +! IF(ME==0)THEN ! WRITE(6,*)' ' ! WRITE(6,*)'DERIVED TIME STEPPING CONSTANTS' ! WRITE(6,*)' NPREC,NHEAT,NSRFC : ',NPREC,NHEAT,NSRFC @@ -2980,12 +2980,12 @@ SUBROUTINE INITPOST_GFS_SIGIO(lusig,iunit,iostatusFlux,iostatusD3D,idrt,sighead) END DO ! !HC WRITE IGDS OUT FOR WEIGHTMAKER TO READ IN AS KGDSIN - if(me.eq.0)then + if(me==0)then print*,'writing out igds' igdout=110 ! open(igdout,file='griddef.out',form='unformatted' ! + ,status='unknown') - if(maptype .eq. 1)THEN ! Lambert conformal + if(maptype == 1)THEN ! Lambert conformal WRITE(igdout)3 WRITE(6,*)'igd(1)=',3 WRITE(igdout)im @@ -3001,7 +3001,7 @@ SUBROUTINE INITPOST_GFS_SIGIO(lusig,iunit,iostatusFlux,iostatusD3D,idrt,sighead) WRITE(igdout)TRUELAT2 WRITE(igdout)TRUELAT1 WRITE(igdout)255 - ELSE IF(MAPTYPE .EQ. 2)THEN !Polar stereographic + ELSE IF(MAPTYPE == 2)THEN !Polar stereographic WRITE(igdout)5 WRITE(igdout)im WRITE(igdout)jm @@ -3016,7 +3016,7 @@ SUBROUTINE INITPOST_GFS_SIGIO(lusig,iunit,iostatusFlux,iostatusD3D,idrt,sighead) WRITE(igdout)TRUELAT2 !Assume projection at +-90 WRITE(igdout)TRUELAT1 WRITE(igdout)255 - ELSE IF(MAPTYPE .EQ. 3)THEN !Mercator + ELSE IF(MAPTYPE == 3)THEN !Mercator WRITE(igdout)1 WRITE(igdout)im WRITE(igdout)jm @@ -3031,7 +3031,7 @@ SUBROUTINE INITPOST_GFS_SIGIO(lusig,iunit,iostatusFlux,iostatusD3D,idrt,sighead) WRITE(igdout)DXVAL WRITE(igdout)DYVAL WRITE(igdout)255 - ELSE IF(MAPTYPE.EQ.0 .OR. MAPTYPE.EQ.203)THEN !A STAGGERED E-GRID + ELSE IF(MAPTYPE==0 .OR. MAPTYPE==203)THEN !A STAGGERED E-GRID WRITE(igdout)203 WRITE(igdout)im WRITE(igdout)jm diff --git a/sorc/ncep_post.fd/INITPOST_NEMS.f b/sorc/ncep_post.fd/INITPOST_NEMS.f index ea4ff62f7..892ec1129 100644 --- a/sorc/ncep_post.fd/INITPOST_NEMS.f +++ b/sorc/ncep_post.fd/INITPOST_NEMS.f @@ -155,7 +155,7 @@ SUBROUTINE INITPOST_NEMS(NREC,nfile) ! The end j row is going to be jend_2u for all variables except for V. JS=JSTA_2L JE=JEND_2U - IF (JEND_2U.EQ.JM) THEN + IF (JEND_2U==JM) THEN JEV=JEND_2U+1 ELSE JEV=JEND_2U @@ -315,7 +315,7 @@ SUBROUTINE INITPOST_NEMS(NREC,nfile) ! call ext_int_get_dom_ti_integer(DataHandle,'RESTARTBIN',itmp ! + ,1,ioutcount,istatus) -! IF(itmp .LT. 1)THEN +! IF(itmp < 1)THEN ! RESTRT=.FALSE. ! ELSE ! RESTRT=.TRUE. @@ -325,7 +325,7 @@ SUBROUTINE INITPOST_NEMS(NREC,nfile) ! print*,'Is this a restrt run? ',RESTRT - IF(tstart .GT. 1.0E-2)THEN + IF(tstart > 1.0E-2)THEN ifhr=ifhr+NINT(tstart) rinc=0 idate=0 @@ -575,7 +575,7 @@ SUBROUTINE INITPOST_NEMS(NREC,nfile) call collect_loc(gdlat,dummy) ! decides whether or not to convert to degree - if(me.eq.0)then + if(me==0)then if(maxval(abs(dummy))1.0E-3 .and. (WH(I,J,1) < SPVAL)) & OMGA(I,J,L) = -WH(I,J,L)*PMID(I,J,L)*G & / (RD*T(I,J,L)*(1.+D608*Q(I,J,L))) end do @@ -2705,7 +2705,7 @@ SUBROUTINE INITPOST_NEMS(NREC,nfile) ! ! - IF(ME.EQ.0)THEN + IF(ME==0)THEN WRITE(6,*)' SPL (POSTED PRESSURE LEVELS) BELOW: ' WRITE(6,51) (SPL(L),L=1,LSM) 50 FORMAT(14(F4.1,1X)) @@ -2727,17 +2727,17 @@ SUBROUTINE INITPOST_NEMS(NREC,nfile) TSRFC=float(NSRFC)/TSPH if(me==0)write(6,*)'tsfrc ',tsrfc,nsrfc,tsph - IF(NSRFC.EQ.0)TSRFC=float(ifhr) !in case buket does not get emptied + IF(NSRFC==0)TSRFC=float(ifhr) !in case buket does not get emptied TRDLW=float(NRDLW)/TSPH - IF(NRDLW.EQ.0)TRDLW=float(ifhr) !in case buket does not get emptied + IF(NRDLW==0)TRDLW=float(ifhr) !in case buket does not get emptied TRDSW=float(NRDSW)/TSPH - IF(NRDSW.EQ.0)TRDSW=float(ifhr) !in case buket does not get emptied + IF(NRDSW==0)TRDSW=float(ifhr) !in case buket does not get emptied THEAT=float(NHEAT)/TSPH - IF(NHEAT.EQ.0)THEAT=float(ifhr) !in case buket does not get emptied + IF(NHEAT==0)THEAT=float(ifhr) !in case buket does not get emptied TCLOD=float(NCLOD)/TSPH - IF(NCLOD.EQ.0)TCLOD=float(ifhr) !in case buket does not get emptied + IF(NCLOD==0)TCLOD=float(ifhr) !in case buket does not get emptied TPREC=float(NPREC)/TSPH - IF(NPREC.EQ.0)TPREC=float(ifhr) !in case buket does not get emptied + IF(NPREC==0)TPREC=float(ifhr) !in case buket does not get emptied ! TPREC=float(ifhr) if(me==0)print*,'TSRFC TRDLW TRDSW THEAT TCLOD TPREC= ' & ,TSRFC, TRDLW, TRDSW, THEAT, TCLOD, TPREC @@ -2752,7 +2752,7 @@ SUBROUTINE INITPOST_NEMS(NREC,nfile) ! NSRFC = INT(TSRFC *TSPH+D50) !how am i going to get this information? ! -! IF(ME.EQ.0)THEN +! IF(ME==0)THEN ! WRITE(6,*)' ' ! WRITE(6,*)'DERIVED TIME STEPPING CONSTANTS' ! WRITE(6,*)' NPREC,NHEAT,NSRFC : ',NPREC,NHEAT,NSRFC @@ -2765,12 +2765,12 @@ SUBROUTINE INITPOST_NEMS(NREC,nfile) END DO ! !HC WRITE IGDS OUT FOR WEIGHTMAKER TO READ IN AS KGDSIN - if(me.eq.0)then + if(me==0)then print*,'writing out igds' igdout=110 ! open(igdout,file='griddef.out',form='unformatted' ! + ,status='unknown') - IF(MAPTYPE.EQ.203)THEN !A STAGGERED E-GRID + IF(MAPTYPE==203)THEN !A STAGGERED E-GRID WRITE(igdout)203 WRITE(igdout)im WRITE(igdout)jm @@ -2787,7 +2787,7 @@ SUBROUTINE INITPOST_NEMS(NREC,nfile) WRITE(igdout)0 WRITE(igdout)LATLAST WRITE(igdout)LONLAST - ELSE IF(MAPTYPE.EQ.205)THEN !A STAGGERED B-GRID + ELSE IF(MAPTYPE==205)THEN !A STAGGERED B-GRID WRITE(igdout)205 WRITE(igdout)im WRITE(igdout)jm @@ -2807,10 +2807,10 @@ SUBROUTINE INITPOST_NEMS(NREC,nfile) END IF open(111,file='copygb_gridnav.txt',form='formatted' & ,status='unknown') - IF(MAPTYPE.EQ.203)THEN !A STAGGERED E-GRID + IF(MAPTYPE==203)THEN !A STAGGERED E-GRID write(111,1000) 2*IM-1,JM,LATSTART,LONSTART,CENLON, & NINT(dxval*107.),NINT(dyval*110.),CENLAT,CENLAT - ELSE IF(MAPTYPE.EQ.205)THEN !A STAGGERED B-GRID + ELSE IF(MAPTYPE==205)THEN !A STAGGERED B-GRID if(grib=="grib2") then write(111,1000) IM,JM,LATSTART/1000,LONSTART/1000,CENLON/1000, & NINT(dxval*107.)/1000,NINT(dyval*110.)/1000, & @@ -2822,7 +2822,7 @@ SUBROUTINE INITPOST_NEMS(NREC,nfile) 3(x,I6),x,I7) close(111) ! - IF (MAPTYPE.EQ.205)THEN !A STAGGERED B-GRID + IF (MAPTYPE==205)THEN !A STAGGERED B-GRID open(112,file='latlons_corners.txt',form='formatted' & ,status='unknown') if(grib=="grib2") then diff --git a/sorc/ncep_post.fd/INITPOST_NEMS_MPIIO.f b/sorc/ncep_post.fd/INITPOST_NEMS_MPIIO.f index 7ea01ff7a..44d403bf3 100644 --- a/sorc/ncep_post.fd/INITPOST_NEMS_MPIIO.f +++ b/sorc/ncep_post.fd/INITPOST_NEMS_MPIIO.f @@ -162,7 +162,7 @@ SUBROUTINE INITPOST_NEMS_MPIIO() ! The end j row is going to be jend_2u for all variables except for V. JS=JSTA_2L JE=JEND_2U - IF (JEND_2U.EQ.JM) THEN + IF (JEND_2U==JM) THEN JEV=JEND_2U+1 ELSE JEV=JEND_2U @@ -284,7 +284,7 @@ SUBROUTINE INITPOST_NEMS_MPIIO() ! call ext_int_get_dom_ti_integer(DataHandle,'RESTARTBIN',itmp ! + ,1,ioutcount,istatus) -! IF(itmp .LT. 1)THEN +! IF(itmp < 1)THEN ! RESTRT=.FALSE. ! ELSE ! RESTRT=.TRUE. @@ -294,7 +294,7 @@ SUBROUTINE INITPOST_NEMS_MPIIO() ! print*,'Is this a restrt run? ',RESTRT - IF(tstart .GT. 1.0E-2)THEN + IF(tstart > 1.0E-2)THEN ifhr=ifhr+NINT(tstart) rinc=0 idate=0 @@ -581,7 +581,7 @@ SUBROUTINE INITPOST_NEMS_MPIIO() call collect_loc(gdlat,dummy) ! decides whether or not to convert to degree - if(me.eq.0)then + if(me==0)then if(maxval(abs(dummy))1.0E-3) & OMGA(I,J,L) = -WH(I,J,L)*PMID(I,J,L)*G/ & (RD*T(I,J,L)*(1.+D608*Q(I,J,L))) @@ -2316,7 +2316,7 @@ SUBROUTINE INITPOST_NEMS_MPIIO() ! ! - IF(ME.EQ.0)THEN + IF(ME==0)THEN WRITE(6,*)' SPL (POSTED PRESSURE LEVELS) BELOW: ' WRITE(6,51) (SPL(L),L=1,LSM) 50 FORMAT(14(F4.1,1X)) @@ -2337,17 +2337,17 @@ SUBROUTINE INITPOST_NEMS_MPIIO() ENDIF TSRFC=float(NSRFC)/TSPH - IF(NSRFC.EQ.0)TSRFC=float(ifhr) !in case buket does not get emptied + IF(NSRFC==0)TSRFC=float(ifhr) !in case buket does not get emptied TRDLW=float(NRDLW)/TSPH - IF(NRDLW.EQ.0)TRDLW=float(ifhr) !in case buket does not get emptied + IF(NRDLW==0)TRDLW=float(ifhr) !in case buket does not get emptied TRDSW=float(NRDSW)/TSPH - IF(NRDSW.EQ.0)TRDSW=float(ifhr) !in case buket does not get emptied + IF(NRDSW==0)TRDSW=float(ifhr) !in case buket does not get emptied THEAT=float(NHEAT)/TSPH - IF(NHEAT.EQ.0)THEAT=float(ifhr) !in case buket does not get emptied + IF(NHEAT==0)THEAT=float(ifhr) !in case buket does not get emptied TCLOD=float(NCLOD)/TSPH - IF(NCLOD.EQ.0)TCLOD=float(ifhr) !in case buket does not get emptied + IF(NCLOD==0)TCLOD=float(ifhr) !in case buket does not get emptied TPREC=float(NPREC)/TSPH - IF(NPREC.EQ.0)TPREC=float(ifhr) !in case buket does not get emptied + IF(NPREC==0)TPREC=float(ifhr) !in case buket does not get emptied ! TPREC=float(ifhr) print*,'TSRFC TRDLW TRDSW THEAT TCLOD TPREC= ' & ,TSRFC, TRDLW, TRDSW, THEAT, TCLOD, TPREC @@ -2362,7 +2362,7 @@ SUBROUTINE INITPOST_NEMS_MPIIO() ! NSRFC = INT(TSRFC *TSPH+D50) !how am i going to get this information? ! -! IF(ME.EQ.0)THEN +! IF(ME==0)THEN ! WRITE(6,*)' ' ! WRITE(6,*)'DERIVED TIME STEPPING CONSTANTS' ! WRITE(6,*)' NPREC,NHEAT,NSRFC : ',NPREC,NHEAT,NSRFC @@ -2376,12 +2376,12 @@ SUBROUTINE INITPOST_NEMS_MPIIO() write(0,*)' after ALSL' ! !HC WRITE IGDS OUT FOR WEIGHTMAKER TO READ IN AS KGDSIN - if(me.eq.0)then + if(me==0)then print*,'writing out igds' igdout=110 ! open(igdout,file='griddef.out',form='unformatted' ! + ,status='unknown') - IF(MAPTYPE.EQ.203)THEN !A STAGGERED E-GRID + IF(MAPTYPE==203)THEN !A STAGGERED E-GRID WRITE(igdout)203 WRITE(igdout)im WRITE(igdout)jm @@ -2398,7 +2398,7 @@ SUBROUTINE INITPOST_NEMS_MPIIO() WRITE(igdout)0 WRITE(igdout)LATLAST WRITE(igdout)LONLAST - ELSE IF(MAPTYPE.EQ.205)THEN !A STAGGERED B-GRID + ELSE IF(MAPTYPE==205)THEN !A STAGGERED B-GRID WRITE(igdout)205 WRITE(igdout)im WRITE(igdout)jm @@ -2418,10 +2418,10 @@ SUBROUTINE INITPOST_NEMS_MPIIO() END IF open(111,file='copygb_gridnav.txt',form='formatted' & ,status='unknown') - IF(MAPTYPE.EQ.203)THEN !A STAGGERED E-GRID + IF(MAPTYPE==203)THEN !A STAGGERED E-GRID write(111,1000) 2*IM-1,JM,LATSTART,LONSTART,CENLON, & NINT(dxval*107.),NINT(dyval*110.),CENLAT,CENLAT - ELSE IF(MAPTYPE.EQ.205)THEN !A STAGGERED B-GRID + ELSE IF(MAPTYPE==205)THEN !A STAGGERED B-GRID if(grib=="grib2") then write(111,1000) IM,JM,LATSTART/1000,LONSTART/1000,CENLON/1000, & NINT(dxval*107.)/1000,NINT(dyval*110.)/1000, & @@ -2433,7 +2433,7 @@ SUBROUTINE INITPOST_NEMS_MPIIO() 3(x,I6),x,I7) close(111) ! - IF (MAPTYPE.EQ.205)THEN !A STAGGERED B-GRID + IF (MAPTYPE==205)THEN !A STAGGERED B-GRID open(112,file='latlons_corners.txt',form='formatted' & ,status='unknown') if(grib=="grib2") then diff --git a/sorc/ncep_post.fd/INITPOST_NETCDF.f b/sorc/ncep_post.fd/INITPOST_NETCDF.f index b06091dc1..f360e9172 100644 --- a/sorc/ncep_post.fd/INITPOST_NETCDF.f +++ b/sorc/ncep_post.fd/INITPOST_NETCDF.f @@ -562,7 +562,7 @@ SUBROUTINE INITPOST_NETCDF(ncid3d) lonlast = nint(glon1d(im)*gdsdegr) ! Jili Dong add support for regular lat lon (2019/03/22) start - if (MAPTYPE .eq. 0) then + if (MAPTYPE == 0) then if(lonstart<0.)then lonstart=lonstart+360.*gdsdegr end if @@ -597,7 +597,7 @@ SUBROUTINE INITPOST_NETCDF(ncid3d) end if ! Jili Dong add support for regular lat lon (2019/03/22) start - if (MAPTYPE .eq. 0) then + if (MAPTYPE == 0) then if(lonstart<0.)then lonstart=lonstart+360.*gdsdegr end if diff --git a/sorc/ncep_post.fd/INITPOST_NMM.f b/sorc/ncep_post.fd/INITPOST_NMM.f index d9a9b7f9f..4c1204ff0 100644 --- a/sorc/ncep_post.fd/INITPOST_NMM.f +++ b/sorc/ncep_post.fd/INITPOST_NMM.f @@ -192,7 +192,7 @@ SUBROUTINE INITPOST_NMM ! The end j row is going to be jend_2u for all variables except for V. JS=JSTA_2L JE=JEND_2U - IF (JEND_2U.EQ.JM) THEN + IF (JEND_2U==JM) THEN JEV=JEND_2U+1 ELSE JEV=JEND_2U @@ -250,7 +250,7 @@ SUBROUTINE INITPOST_NMM call ext_ncd_get_dom_ti_integer(DataHandle,'RESTARTBIN',itmp,1, & ioutcount,istatus) - IF(itmp .LT. 1)THEN + IF(itmp < 1)THEN RESTRT=.FALSE. ELSE RESTRT=.TRUE. @@ -264,7 +264,7 @@ SUBROUTINE INITPOST_NMM ! print*,'new forecast hours for restrt run= ',ifhr ! END IF - IF(tstart .GT. 1.0E-2)THEN + IF(tstart > 1.0E-2)THEN ifhr=ifhr+NINT(tstart) rinc=0 idate=0 @@ -303,14 +303,14 @@ SUBROUTINE INITPOST_NMM do j = jsta_2l, jend_2u do i = 1, im t ( i, j, l ) = dum3d ( i, j, l ) -! if(l.eq.1)print*,'Debug: I,J,T= ',i,j,t ( i, j, l ) +! if(l==1)print*,'Debug: I,J,T= ',i,j,t ( i, j, l ) ! t ( i, j, l ) = dum3d ( i, j, l ) + 300. ! th ( i, j, l ) = dum3d ( i, j, l ) + 300. end do end do end do do l=1,lm - if(jj.ge. jsta .and. jj.le.jend)print*,'sample L,T= ',L,T(ii,jj,l) + if(jj>= jsta .and. jj<=jend)print*,'sample L,T= ',L,T(ii,jj,l) end do ! VarName='T_ADJ' @@ -324,7 +324,7 @@ SUBROUTINE INITPOST_NMM ! end do ! end do ! do l=1,lm -! if(jj.ge. jsta .and. jj.le.jend)print*,'sample L,T_ADJ= ',L +! if(jj>= jsta .and. jj<=jend)print*,'sample L,T_ADJ= ',L ! &,T_ADJ(ii,jj,l) ! end do @@ -337,7 +337,7 @@ SUBROUTINE INITPOST_NMM do i = 1, im u ( i, j, l ) = dum3d ( i, j, l ) UH( i, j, l ) = dum3d ( i, j, l ) -! if(l.eq.1)print*,'Debug: I,J,U= ',i,j,u( i, j, l ) +! if(l==1)print*,'Debug: I,J,U= ',i,j,u( i, j, l ) end do end do ! fill up UH which is U at P-points including 2 row halo @@ -347,7 +347,7 @@ SUBROUTINE INITPOST_NMM ! end do ! end do end do - if(jj.ge. jsta .and. jj.le.jend)print*,'sample U= ',U(ii,jj,ll) + if(jj>= jsta .and. jj<=jend)print*,'sample U= ',U(ii,jj,ll) VarName='V' call getVariable(fileName,DateStr,DataHandle,VarName,DUM3D, & IM+1,1,JM+1,LM+1,IM,JS,JE,LM) @@ -365,13 +365,13 @@ SUBROUTINE INITPOST_NMM ! end do ! end do end do - if(jj.ge. jsta .and. jj.le.jend)print*,'sample V= ',V(ii,jj,ll) + if(jj>= jsta .and. jj<=jend)print*,'sample V= ',V(ii,jj,ll) call ext_ncd_get_dom_ti_integer(DataHandle,'MP_PHYSICS' & ,itmp,1,ioutcount,istatus) imp_physics=itmp ! Chuang: will initialize microphysics constants differently for 85 now -! if(imp_physics .eq. 85) imp_physics=5 !HWRF +! if(imp_physics == 85) imp_physics=5 !HWRF print*,'MP_PHYSICS= ',imp_physics ! Initializes constants for Ferrier microphysics @@ -383,7 +383,7 @@ SUBROUTINE INITPOST_NMM call ext_ncd_get_dom_ti_integer(DataHandle,'CU_PHYSICS' & ,itmp,1,ioutcount,istatus) icu_physics=itmp - if (icu_physics .eq. 84 .or. icu_physics .eq. 85) icu_physics = 4 ! HWRF + if (icu_physics == 84 .or. icu_physics == 85) icu_physics = 4 ! HWRF print*,'CU_PHYSICS= ',icu_physics ! Set these values to SPVAL to insure they are initialized a @@ -409,7 +409,7 @@ SUBROUTINE INITPOST_NMM end do end do do l=1,lm - if(jj.ge. jsta .and. jj.le.jend)print*,'sample L,T= ',L,T(ii,jj,l) + if(jj>= jsta .and. jj<=jend)print*,'sample L,T= ',L,T(ii,jj,l) end do VarName='REFD_MAX' @@ -431,13 +431,13 @@ SUBROUTINE INITPOST_NMM do l = 1, lm do j = jsta_2l, jend_2u do i = 1, im - if (dum3d(i,j,l) .lt. 10E-12) dum3d(i,j,l) = 10E-12 + if (dum3d(i,j,l) < 10E-12) dum3d(i,j,l) = 10E-12 q ( i, j, l ) = dum3d ( i, j, l ) end do end do end do print*,'finish reading specific humidity' - if(jj.ge. jsta .and. jj.le.jend)print*,'sample Q= ',Q(ii,jj,ll) + if(jj>= jsta .and. jj<=jend)print*,'sample Q= ',Q(ii,jj,ll) else VarName='QVAPOR' @@ -447,15 +447,15 @@ SUBROUTINE INITPOST_NMM do j = jsta_2l, jend_2u do i = 1, im ! q ( i, j, l ) = dum3d ( i, j, l ) -! if(l.eq.1)print*,'Debug: I,J,Q= ',i,j,q( i, j, l ) +! if(l==1)print*,'Debug: I,J,Q= ',i,j,q( i, j, l ) !CHC CONVERT MIXING RATIO TO SPECIFIC HUMIDITY - if (dum3d(i,j,l) .lt. 10E-12) dum3d(i,j,l) = 10E-12 + if (dum3d(i,j,l) < 10E-12) dum3d(i,j,l) = 10E-12 q ( i, j, l ) = dum3d ( i, j, l )/(1.0+dum3d ( i, j, l )) end do end do end do print*,'finish reading specific humidity' - if(jj.ge. jsta .and. jj.le.jend)print*,'sample Q= ',Q(ii,jj,ll) + if(jj>= jsta .and. jj<=jend)print*,'sample Q= ',Q(ii,jj,ll) endif if(imp_physics==5 .or. imp_physics==85 .or. imp_physics==95)then @@ -516,8 +516,8 @@ SUBROUTINE INITPOST_NMM do j = jsta_2l, jend_2u do i = 1, im ! partition cloud water and ice for WSM3 - if(imp_physics.eq.3)then - if(t(i,j,l) .ge. TFRZ)then + if(imp_physics==3)then + if(t(i,j,l) >= TFRZ)then qqw ( i, j, l ) = dum3d ( i, j, l ) else qqi ( i, j, l ) = dum3d ( i, j, l ) @@ -530,11 +530,11 @@ SUBROUTINE INITPOST_NMM end do end do end if - if(jj.ge. jsta .and. jj.le.jend)print*,'sample qqw= ' & + if(jj>= jsta .and. jj<=jend)print*,'sample qqw= ' & ,Qqw(ii,jj,ll) - if(imp_physics.ne.1 .and. imp_physics.ne.3 & - .and. imp_physics.ne.0)then + if(imp_physics/=1 .and. imp_physics/=3 & + .and. imp_physics/=0)then VarName='QICE' call getVariable(fileName,DateStr,DataHandle,VarName,DUM3D, & IM+1,1,JM+1,LM+1,IM,JS,JE,LM) @@ -547,7 +547,7 @@ SUBROUTINE INITPOST_NMM end do end do end if - if(jj.ge. jsta .and. jj.le.jend)print*,'sample qqi= ' & + if(jj>= jsta .and. jj<=jend)print*,'sample qqi= ' & ,Qqi(ii,jj,ll) if(imp_physics==15) then @@ -562,10 +562,10 @@ SUBROUTINE INITPOST_NMM end do end do end if - if(jj.ge. jsta .and. jj.le.jend)print*,'sample qrimef= ' & + if(jj>= jsta .and. jj<=jend)print*,'sample qrimef= ' & ,Qrimef(ii,jj,ll) - if(imp_physics.ne.0)then + if(imp_physics/=0)then VarName='QRAIN' call getVariable(fileName,DateStr,DataHandle,VarName,DUM3D, & IM+1,1,JM+1,LM+1,IM,JS,JE,LM) @@ -573,8 +573,8 @@ SUBROUTINE INITPOST_NMM do j = jsta_2l, jend_2u do i = 1, im ! partition rain and snow for WSM3 - if(imp_physics .eq. 3)then - if(t(i,j,l) .ge. TFRZ)then + if(imp_physics == 3)then + if(t(i,j,l) >= TFRZ)then qqr ( i, j, l ) = dum3d ( i, j, l ) else qqs ( i, j, l ) = dum3d ( i, j, l ) @@ -587,11 +587,11 @@ SUBROUTINE INITPOST_NMM end do end do end if - if(jj.ge. jsta .and. jj.le.jend)print*,'sample qqr= ' & + if(jj>= jsta .and. jj<=jend)print*,'sample qqr= ' & ,Qqr(ii,jj,ll) - if(imp_physics.ne.1 .and. imp_physics.ne.3 & - .and. imp_physics.ne.0)then + if(imp_physics/=1 .and. imp_physics/=3 & + .and. imp_physics/=0)then VarName='QSNOW' call getVariable(fileName,DateStr,DataHandle,VarName,DUM3D, & IM+1,1,JM+1,LM+1,IM,JS,JE,LM) @@ -604,11 +604,11 @@ SUBROUTINE INITPOST_NMM end do end do end if - if(jj.ge. jsta .and. jj.le.jend)print*,'sample qqs= ' & + if(jj>= jsta .and. jj<=jend)print*,'sample qqs= ' & ,Qqs(ii,jj,ll) - if(imp_physics.eq.2 .or. imp_physics.eq.6 & - .or. imp_physics.eq.8 .or. imp_physics.eq.28)then + if(imp_physics==2 .or. imp_physics==6 & + .or. imp_physics==8 .or. imp_physics==28)then VarName='QGRAUP' call getVariable(fileName,DateStr,DataHandle,VarName,DUM3D, & IM+1,1,JM+1,LM+1,IM,JS,JE,LM) @@ -621,11 +621,11 @@ SUBROUTINE INITPOST_NMM end do end do end if - if(jj.ge. jsta .and. jj.le.jend)print*,'sample qqg= ' & + if(jj>= jsta .and. jj<=jend)print*,'sample qqg= ' & ,Qqg(ii,jj,ll) ! KRS: Add concentrations for HWRF output - if(imp_physics.eq.8 .or. imp_physics.eq.9)then + if(imp_physics==8 .or. imp_physics==9)then VarName='QNICE' call getVariable(fileName,DateStr,DataHandle,VarName,DUM3D, & IM+1,1,JM+1,LM+1,IM, JS,JE,LM) @@ -633,7 +633,7 @@ SUBROUTINE INITPOST_NMM do j = jsta_2l, jend_2u do i = 1, im qqni ( i, j, l ) = dum3d ( i, j, l ) - if(i.eq.im/2.and.j.eq.(jsta+jend)/2)print*,'sample QQNI= ', & + if(i==im/2.and.j==(jsta+jend)/2)print*,'sample QQNI= ', & i,j,l,QQNI ( i, j, l ) end do end do @@ -645,7 +645,7 @@ SUBROUTINE INITPOST_NMM do j = jsta_2l, jend_2u do i = 1, im qqnr ( i, j, l ) = dum3d ( i, j, l ) - if(i.eq.im/2.and.j.eq.(jsta+jend)/2)print*,'sample QQNR= ', & + if(i==im/2.and.j==(jsta+jend)/2)print*,'sample QQNR= ', & i,j,l,QQNR ( i, j, l ) end do end do @@ -706,7 +706,7 @@ SUBROUTINE INITPOST_NMM end do end do ! do l = 1, lm+1 -! if(jj.ge. jsta .and. jj.le.jend)print*,'sample PINT= ' +! if(jj>= jsta .and. jj<=jend)print*,'sample PINT= ' ! & ,PINT(ii,jj,l) ! end do ! @@ -715,7 +715,7 @@ SUBROUTINE INITPOST_NMM DO J=JSTA_2L,JEND_2U PMID(I,J,L)=(PINT(I,J,L)+PINT(I,J,L+1))*0.5 ! TH(I,J,L)=T(I,J,L)*(1.E5/PMID(I,J,L))**CAPA - IF(ABS(T(I,J,L)).GT.1.0E-3) & + IF(ABS(T(I,J,L))>1.0E-3) & OMGA(I,J,L) = -WH(I,J,L)*PMID(I,J,L)*G/ & (RD*T(I,J,L)*(1.+D608*Q(I,J,L))) ! @@ -729,16 +729,16 @@ SUBROUTINE INITPOST_NMM do l = 1, lm do j = jsta, jend do i = 1, im-MOD(J,2) - IF(J .EQ. 1 .AND. I .LT. IM)THEN !SOUTHERN BC + IF(J == 1 .AND. I < IM)THEN !SOUTHERN BC PMIDV(I,J,L)=0.5*(PMID(I,J,L)+PMID(I+1,J,L)) - ELSE IF(J.EQ.JM .AND. I.LT.IM)THEN !NORTHERN BC + ELSE IF(J==JM .AND. I= jsta .and. jj<=jend)then do l = 1, lm+1 print*,'sample PINT= ',ii,jj,l,PINT(ii,jj,l) - if(l.le.lm)print*,'sample PMID=',l,PMID(II,JJ,L) + if(l<=lm)print*,'sample PMID=',l,PMID(II,JJ,L) end do end if ! DO I=1,IM @@ -813,7 +813,7 @@ SUBROUTINE INITPOST_NMM FI(I,J,2)=HTM(I,J,L)*T(I,J,L)*(Q(I,J,L)*D608+1.0)*RD* & (ALPINT(I,J,L+1)-ALPINT(I,J,L))+FI(I,J,1) ZINT(I,J,L)=FI(I,J,2)/G - if(i.eq.ii.and.j.eq.jj) & + if(i==ii.and.j==jj) & print*,'L,sample HTM,T,Q,ALPINT(L+1),ALPINT(l),ZINT= ', & l,HTM(I,J,L),T(I,J,L),Q(I,J,L),ALPINT(I,J,L+1), & ALPINT(I,J,L),ZINT(I,J,L) @@ -950,7 +950,7 @@ SUBROUTINE INITPOST_NMM END DO ! Complete first row - IF (JSTA_M.EQ.2) THEN + IF (JSTA_M==2) THEN DO I=1, IM-1 u10(I,1)=0.5*(dummy(I,1)+dummy(I+1,1)) u10h(I,1)=dummy(I,1) @@ -960,7 +960,7 @@ SUBROUTINE INITPOST_NMM END IF ! Complete last row - IF (JEND_M.EQ.(JM-1)) THEN + IF (JEND_M==(JM-1)) THEN DO I=1, IM-1 u10(I,jm)=0.5*(dummy(I,jm)+dummy(I+1,jm)) u10h(I,jm)=dummy(I,jm) @@ -989,7 +989,7 @@ SUBROUTINE INITPOST_NMM END DO ! Complete first row - IF (JSTA_M.EQ.2) THEN + IF (JSTA_M==2) THEN DO I=1, IM-1 v10(I,1)=0.5*(dummy(I,1)+dummy(I+1,1)) v10h(I,1)=dummy(I,1) @@ -999,7 +999,7 @@ SUBROUTINE INITPOST_NMM END IF ! Complete last row - IF (JEND_M.EQ.(JM-1)) THEN + IF (JEND_M==(JM-1)) THEN DO I=1, IM-1 v10(I,jm)=0.5*(dummy(I,jm)+dummy(I+1,jm)) v10h(I,jm)=dummy(I,jm) @@ -1178,7 +1178,7 @@ SUBROUTINE INITPOST_NMM do j = jsta_2l, jend_2u do i = 1, im ncfrcv ( i, j ) = float(idummy ( i, j )) -! if(ncfrcv(i,j).gt.1.0e-5)print*,'nonzero ncfrcv',ncfrcv(i,j) +! if(ncfrcv(i,j)>1.0e-5)print*,'nonzero ncfrcv',ncfrcv(i,j) end do end do @@ -1189,7 +1189,7 @@ SUBROUTINE INITPOST_NMM do j = jsta_2l, jend_2u do i = 1, im ncfrst ( i, j ) = float(idummy ( i, j )) -! if(ncfrst(i,j).gt.1.0e-5)print*,'nonzero ncfrst',ncfrst(i,j) +! if(ncfrst(i,j)>1.0e-5)print*,'nonzero ncfrst',ncfrst(i,j) end do end do @@ -1386,7 +1386,7 @@ SUBROUTINE INITPOST_NMM do j = jsta_2l, jend_2u do i = 1, im QS ( i, j ) = dummy ( i, j ) -! if(qs(i,j).gt.1.0e-7)print*,'nonzero qsfc' +! if(qs(i,j)>1.0e-7)print*,'nonzero qsfc' end do end do @@ -1667,7 +1667,7 @@ SUBROUTINE INITPOST_NMM do j = jsta_2l, jend_2u do i = 1, im RSWIN ( i, j ) = dummy ( i, j ) -! if(abs(dummy(i,j)).gt. 0.0)print*,'rswin=',dummy(i,j) +! if(abs(dummy(i,j))> 0.0)print*,'rswin=',dummy(i,j) end do end do @@ -1677,7 +1677,7 @@ SUBROUTINE INITPOST_NMM do j = jsta_2l, jend_2u do i = 1, im RSWINC ( i, j ) = dummy ( i, j ) -! if(abs(dummy(i,j)).gt. 0.0)print*,'rswin=',dummy(i,j) +! if(abs(dummy(i,j))> 0.0)print*,'rswin=',dummy(i,j) end do end do @@ -1688,7 +1688,7 @@ SUBROUTINE INITPOST_NMM do j = jsta_2l, jend_2u do i = 1, im CZEN ( i, j ) = dummy ( i, j ) -! if(abs(czen(i,j)).gt. 0.0)print*,'czen=',czen(i,j) +! if(abs(czen(i,j))> 0.0)print*,'czen=',czen(i,j) end do end do @@ -1698,7 +1698,7 @@ SUBROUTINE INITPOST_NMM do j = jsta_2l, jend_2u do i = 1, im CZMEAN ( i, j ) = dummy ( i, j ) -! if(abs(dummy(i,j)).gt. 0.0)print*,'czmean=',dummy(i,j) +! if(abs(dummy(i,j))> 0.0)print*,'czmean=',dummy(i,j) end do end do @@ -1708,7 +1708,7 @@ SUBROUTINE INITPOST_NMM do j = jsta_2l, jend_2u do i = 1, im RSWOUT ( i, j ) = dummy ( i, j ) -! if(abs(dummy(i,j)).gt. 0.0)print*,'rswout=',dummy(i,j) +! if(abs(dummy(i,j))> 0.0)print*,'rswout=',dummy(i,j) end do end do @@ -1766,7 +1766,7 @@ SUBROUTINE INITPOST_NMM do j = jsta_2l, jend_2u do i = 1, im ASWOUT ( i, j ) = dummy ( i, j ) -! if(abs(dummy(i,j)).gt. 0.0)print*,'aswout=',dummy(i,j) +! if(abs(dummy(i,j))> 0.0)print*,'aswout=',dummy(i,j) end do end do @@ -2018,7 +2018,7 @@ SUBROUTINE INITPOST_NMM do j = jsta_2l, jend_2u do i = 1, im PCTSNO ( i, j ) = dummy ( i, j ) - if(dummy(i,j) .gt. 1.0e-5)print*,'nonzero pctsno' + if(dummy(i,j) > 1.0e-5)print*,'nonzero pctsno' end do end do @@ -2134,10 +2134,10 @@ SUBROUTINE INITPOST_NMM do j = jsta_2l, jend_2u do i = 1, im GDLON ( i, j ) = dummy ( i, j ) * RTD -! if(j.eq.1 .or. j.eq.jm)print*,'I,J,GDLON,GDLAT= ',i,j +! if(j==1 .or. j==jm)print*,'I,J,GDLON,GDLAT= ',i,j ! 1 ,GDLON( i, j ),GDLAT ( i, j ) -! if(abs(GDLAT(i,j)-20.0).lt.0.5 .and. abs(GDLON(I,J) -! 1 +157.0).lt.5.)print* +! if(abs(GDLAT(i,j)-20.0)<0.5 .and. abs(GDLON(I,J) +! 1 +157.0)<5.)print* ! 2 ,'Debug:I,J,GDLON,GDLAT,SM,HGT,psfc= ',i,j,GDLON(i,j) ! 3 ,GDLAT(i,j),SM(i,j),FIS(i,j)/G,PINT(I,j,lm+1) end do @@ -2146,7 +2146,7 @@ SUBROUTINE INITPOST_NMM print*,'read past GDLON' ! pos east call collect_loc(gdlat,dummy) - get_dcenlat: if(me.eq.0)then + get_dcenlat: if(me==0)then latstart=nint(dummy(1,1)*1000.) ! lower left latlast=nint(dummy(im,jm)*1000.) ! upper right @@ -2164,14 +2164,14 @@ SUBROUTINE INITPOST_NMM ! temporary patch for nmm wrf for moving nest ! cenlat = glat(im/2,jm/2) -Gopal - if(mod(im,2).ne.0)then !per Pyle, jm is always odd - if(mod(jm+1,4).ne.0)then + if(mod(im,2)/=0)then !per Pyle, jm is always odd + if(mod(jm+1,4)/=0)then dcenlat=dummy(icen,jcen) else dcenlat=0.5*(dummy(icen-1,jcen)+dummy(icen,jcen)) end if else - if(mod(jm+1,4).ne.0)then + if(mod(jm+1,4)/=0)then dcenlat=0.5*(dummy(icen,jcen)+dummy(icen+1,jcen)) else dcenlat=dummy(icen,jcen) @@ -2186,7 +2186,7 @@ SUBROUTINE INITPOST_NMM write(6,*) 'laststart,latlast A calling bcast= ',latstart,latlast call collect_loc(gdlon,dummy) - get_dcenlon: if(me.eq.0)then + get_dcenlon: if(me==0)then lonstart=nint(dummy(1,1)*1000.) lonlast=nint(dummy(im,jm)*1000.) @@ -2199,8 +2199,8 @@ SUBROUTINE INITPOST_NMM lonem = nint(dummy(icen,jm)*1000.) lonwm = nint(dummy(icen,1)*1000.) - if(mod(im,2).ne.0)then !per Pyle, jm is always odd - if(mod(jm+1,4).ne.0)then + if(mod(im,2)/=0)then !per Pyle, jm is always odd + if(mod(jm+1,4)/=0)then cen1=dummy(icen,jcen) cen2=cen1 else @@ -2208,7 +2208,7 @@ SUBROUTINE INITPOST_NMM cen2=max(dummy(icen-1,jcen),dummy(icen,jcen)) end if else - if(mod(jm+1,4).ne.0)then + if(mod(jm+1,4)/=0)then cen1=min(dummy(icen+1,jcen),dummy(icen,jcen)) cen2=max(dummy(icen+1,jcen),dummy(icen,jcen)) else @@ -2250,7 +2250,7 @@ SUBROUTINE INITPOST_NMM DX ( i, j ) = dummy ( i, j ) if(DX(i,j)<0.1)print*,'zero dx in INIT: I,J,DX= ',i,j & ,DX( i, j ) -! if(j.eq.1 .or. j.eq.jm)print*,'I,J,DX= ',i,j +! if(j==1 .or. j==jm)print*,'I,J,DX= ',i,j ! 1 ,DX( i, j ) end do end do @@ -2267,7 +2267,7 @@ SUBROUTINE INITPOST_NMM open(75,file='ETAPROFILE.txt',form='formatted',status='unknown') DO L=1,lm+1 - IF(L .EQ. 1)THEN + IF(L == 1)THEN write(75,1020)L, 0., 0. ELSE write(75,1020)L, ETA1(lm+2-l), ETA2(lm+2-l) @@ -2402,7 +2402,7 @@ SUBROUTINE INITPOST_NMM ! ! - IF(ME.EQ.0)THEN + IF(ME==0)THEN WRITE(6,*)' SPL (POSTED PRESSURE LEVELS) BELOW: ' WRITE(6,51) (SPL(L),L=1,LSM) 50 FORMAT(14(F4.1,1X)) @@ -2419,17 +2419,17 @@ SUBROUTINE INITPOST_NMM TSPH = 3600./DT TSRFC=float(NSRFC)/TSPH - IF(NSRFC.EQ.0)TSRFC=float(ifhr) !in case buket does not get emptied + IF(NSRFC==0)TSRFC=float(ifhr) !in case buket does not get emptied TRDLW=float(NRDLW)/TSPH - IF(NRDLW.EQ.0)TRDLW=float(ifhr) !in case buket does not get emptied + IF(NRDLW==0)TRDLW=float(ifhr) !in case buket does not get emptied TRDSW=float(NRDSW)/TSPH - IF(NRDSW.EQ.0)TRDSW=float(ifhr) !in case buket does not get emptied + IF(NRDSW==0)TRDSW=float(ifhr) !in case buket does not get emptied THEAT=float(NHEAT)/TSPH - IF(NHEAT.EQ.0)THEAT=float(ifhr) !in case buket does not get emptied + IF(NHEAT==0)THEAT=float(ifhr) !in case buket does not get emptied TCLOD=float(NCLOD)/TSPH - IF(NCLOD.EQ.0)TCLOD=float(ifhr) !in case buket does not get emptied + IF(NCLOD==0)TCLOD=float(ifhr) !in case buket does not get emptied TPREC=float(NPREC)/TSPH - IF(NPREC.EQ.0)TPREC=float(ifhr) !in case buket does not get emptied + IF(NPREC==0)TPREC=float(ifhr) !in case buket does not get emptied print*,'TSRFC TRDLW TRDSW= ',TSRFC, TRDLW, TRDSW !how am i going to get this information? @@ -2441,7 +2441,7 @@ SUBROUTINE INITPOST_NMM ! NSRFC = INT(TSRFC *TSPH+D50) !how am i going to get this information? ! -! IF(ME.EQ.0)THEN +! IF(ME==0)THEN ! WRITE(6,*)' ' ! WRITE(6,*)'DERIVED TIME STEPPING CONSTANTS' ! WRITE(6,*)' NPREC,NHEAT,NSRFC : ',NPREC,NHEAT,NSRFC @@ -2466,7 +2466,7 @@ SUBROUTINE INITPOST_NMM endif - if(me.eq.0)then + if(me==0)then ! write out copygb_gridnav.txt ! provided by R.Rozumalski - NWS @@ -2493,7 +2493,7 @@ SUBROUTINE INITPOST_NMM print *, ' DX :',IFDX*0.001 print *, ' DY :',IFDY*0.001 - IF(MAPTYPE.EQ.0 .OR. MAPTYPE.EQ.203)THEN !A STAGGERED E-GRID + IF(MAPTYPE==0 .OR. MAPTYPE==203)THEN !A STAGGERED E-GRID IMM = 2*IM-1 IDXAVE = ( IFDY + IFDX ) * 0.5 @@ -2503,9 +2503,9 @@ SUBROUTINE INITPOST_NMM ! remapped grid in copygb; otherwise, use a Lambert conformal. Make ! sure to specify the correct pole for the S. Hemisphere (LCC). ! - IF ( abs(CENLAT).GT.15000) THEN + IF ( abs(CENLAT)>15000) THEN write(6,*)' Copygb LCC Navigation Information' - IF (CENLAT .GT.0) THEN ! Northern Hemisphere + IF (CENLAT >0) THEN ! Northern Hemisphere write(6,1000) IMM,JM,LATSTART,LONSTART,CENLON, & IFDX,IFDY,CENLAT,CENLAT write(inav,1000) IMM,JM,LATSTART,LONSTART,CENLON, & @@ -2520,11 +2520,11 @@ SUBROUTINE INITPOST_NMM dlat = (latnm-latsm)/(JM-1) nlat = INT (dlat) - if (lonem .lt. 0) lonem = 360000. + lonem - if (lonwm .lt. 0) lonwm = 360000. + lonwm + if (lonem < 0) lonem = 360000. + lonem + if (lonwm < 0) lonwm = 360000. + lonwm dlon = lonem-lonwm - if (dlon .lt. 0.) dlon = dlon + 360000. + if (dlon < 0.) dlon = dlon + 360000. dlon = (dlon)/(IMM-1) nlon = INT (dlon) @@ -2543,7 +2543,7 @@ SUBROUTINE INITPOST_NMM !HC WRITE IGDS OUT FOR WEIGHTMAKER TO READ IN AS KGDSIN igdout=110 - if (maptype .eq. 1)THEN ! Lambert conformal + if (maptype == 1)THEN ! Lambert conformal WRITE(igdout)3 WRITE(6,*)'igd(1)=',3 WRITE(igdout)im @@ -2559,7 +2559,7 @@ SUBROUTINE INITPOST_NMM ! JW WRITE(igdout)TRUELAT2 ! JW WRITE(igdout)TRUELAT1 WRITE(igdout)255 - ELSE IF(MAPTYPE .EQ. 2)THEN !Polar stereographic + ELSE IF(MAPTYPE == 2)THEN !Polar stereographic WRITE(igdout)5 WRITE(igdout)im WRITE(igdout)jm @@ -2578,7 +2578,7 @@ SUBROUTINE INITPOST_NMM ! lat/lon and the PSMAPF ! Get map factor at 60 degrees (N or S) for PS projection, which will ! be needed to correctly define the DX and DY values in the GRIB GDS - if (TRUELAT1 .LT. 0.) THEN + if (TRUELAT1 < 0.) THEN LAT = -60. else LAT = 60. @@ -2586,7 +2586,7 @@ SUBROUTINE INITPOST_NMM CALL MSFPS (LAT,TRUELAT1*0.001,PSMAPF) - ELSE IF(MAPTYPE .EQ. 3)THEN !Mercator + ELSE IF(MAPTYPE == 3)THEN !Mercator WRITE(igdout)1 WRITE(igdout)im WRITE(igdout)jm @@ -2601,7 +2601,7 @@ SUBROUTINE INITPOST_NMM WRITE(igdout)DXVAL WRITE(igdout)DYVAL WRITE(igdout)255 - ELSE IF(MAPTYPE.EQ.0 .OR. MAPTYPE.EQ.203)THEN !A STAGGERED E-GRID + ELSE IF(MAPTYPE==0 .OR. MAPTYPE==203)THEN !A STAGGERED E-GRID WRITE(igdout)203 WRITE(igdout)im WRITE(igdout)jm diff --git a/sorc/ncep_post.fd/LFMFLD.f b/sorc/ncep_post.fd/LFMFLD.f index 546215305..d0446c2d6 100644 --- a/sorc/ncep_post.fd/LFMFLD.f +++ b/sorc/ncep_post.fd/LFMFLD.f @@ -135,33 +135,33 @@ SUBROUTINE LFMFLD(RH3310,RH6610,RH3366,PW3310) QS=PQ0/PM*EXP(A2*(TM-A3)/(TM-A4)) END IF RH = QM/QS - IF (RH.GT.H1) THEN + IF (RH>H1) THEN RH = H1 QM = RH*QS ENDIF - IF (RH.LT.D01) THEN + IF (RH=P66)) THEN Z6610 = Z6610 + DZ RH6610(I,J) = RH6610(I,J) + RH*DZ ENDIF ! ! 0.33-1.00 RELATIVE HUMIDITY AND PRECIPITABLE WATER. - IF ((PM.LE.P10).AND.(PM.GE.P33)) THEN + IF ((PM<=P10).AND.(PM>=P33)) THEN Z3310 = Z3310 + DZ RH3310(I,J)= RH3310(I,J)+RH*DZ PW3310(I,J)= PW3310(I,J)+(Q(I,J,L)+CWM(I,J,L))*DP*GI ENDIF ! ! 0.33-0.66 RELATIVE HUMIDITY. - IF ((PM.LE.P66).AND.(PM.GE.P33)) THEN + IF ((PM<=P66).AND.(PM>=P33)) THEN Z3366 = Z3366 + DZ RH3366(I,J) = RH3366(I,J) + RH*DZ ENDIF @@ -171,19 +171,19 @@ SUBROUTINE LFMFLD(RH3310,RH6610,RH3366,PW3310) ! NORMALIZE TO GET MEAN RELATIVE HUMIDITIES. AT ! ONE TIME WE DIVIDED PRECIPITABLE WATER BY DENSITY ! TO GET THE EQUIVALENT WATER DEPTH IN METERS. NO MORE. - IF (Z6610.GT.D00) THEN + IF (Z6610>D00) THEN RH6610(I,J) = RH6610(I,J)/Z6610 ELSE RH6610(I,J) = SPVAL ENDIF ! - IF (Z3310.GT.D00) THEN + IF (Z3310>D00) THEN RH3310(I,J) = RH3310(I,J)/Z3310 ELSE RH3310(I,J) = SPVAL ENDIF ! - IF (Z3366.GT.D00) THEN + IF (Z3366>D00) THEN RH3366(I,J) = RH3366(I,J)/Z3366 ELSE RH3366(I,J) = SPVAL diff --git a/sorc/ncep_post.fd/LFMFLD_GFS.f b/sorc/ncep_post.fd/LFMFLD_GFS.f index bb6fff3ff..37df02a78 100644 --- a/sorc/ncep_post.fd/LFMFLD_GFS.f +++ b/sorc/ncep_post.fd/LFMFLD_GFS.f @@ -154,30 +154,30 @@ SUBROUTINE LFMFLD_GFS(RH4410,RH7294,RH4472,RH3310) ! ! ! JUMP OUT OF THIS LOOP IF WE ARE ABOVE THE HIGHEST TARGET PRESSURE. - IF (PM.LE.P33) exit + IF (PM<=P33) exit ! ! 0.44-1.00 RELATIVE HUMIDITY. -! IF ((PM.LE.P10).AND.(PM.GE.P44)) THEN +! IF ((PM<=P10).AND.(PM>=P44)) THEN P4410 = P4410 + DP1 Q4410 = Q4410 + QM*DP1 QS4410 = QS4410+ QS*DP1 ! ENDIF ! ! 0.33-1.00 RELATIVE HUMIDITY -! IF ((PM.LE.P10).AND.(PM.GE.P33)) THEN +! IF ((PM<=P10).AND.(PM>=P33)) THEN P3310 = P3310 + DP4 Q3310 = Q3310 + QM*DP4 QS3310 = QS3310+ QS*DP4 ! ENDIF ! ! 0.44-0.72 RELATIVE HUMIDITY. -! IF ((PM.LE.P66).AND.(PM.GE.P33)) THEN +! IF ((PM<=P66).AND.(PM>=P33)) THEN P4472 = P4472 + DP3 Q4472 = Q4472 + QM*DP3 QS4472 = QS4472+ QS*DP3 ! ENDIF ! 0.72-0.94 RELATIVE HUMIDITY. -! IF ((PM.LE.P66).AND.(PM.GE.P33)) THEN +! IF ((PM<=P66).AND.(PM>=P33)) THEN P7294 = P7294 + DP2 Q7294 = Q7294 + QM*DP2 QS7294 = QS7294+ QS*DP2 @@ -188,25 +188,25 @@ SUBROUTINE LFMFLD_GFS(RH4410,RH7294,RH4472,RH3310) ! NORMALIZE TO GET MEAN RELATIVE HUMIDITIES. AT ! ONE TIME WE DIVIDED PRECIPITABLE WATER BY DENSITY ! TO GET THE EQUIVALENT WATER DEPTH IN METERS. NO MORE. - IF (P4410.GT.D00) THEN + IF (P4410>D00) THEN RH4410(I,J) = Q4410/QS4410 ELSE RH4410(I,J) = SPVAL ENDIF ! - IF (P3310.GT.D00) THEN + IF (P3310>D00) THEN RH3310(I,J) = Q3310/QS3310 ELSE RH3310(I,J) = SPVAL ENDIF ! - IF (P4472.GT.D00) THEN + IF (P4472>D00) THEN RH4472(I,J) = Q4472/QS4472 ELSE RH4472(I,J) = SPVAL ENDIF - IF (P7294.GT.D00) THEN + IF (P7294>D00) THEN RH7294(I,J) = Q7294/QS7294 ELSE RH7294(I,J) = SPVAL diff --git a/sorc/ncep_post.fd/MAPSSLP.f b/sorc/ncep_post.fd/MAPSSLP.f index c57c50307..03e98fec5 100644 --- a/sorc/ncep_post.fd/MAPSSLP.f +++ b/sorc/ncep_post.fd/MAPSSLP.f @@ -54,7 +54,7 @@ SUBROUTINE MAPSSLP(TPRES) ! smooth 700 mb temperature first - if(MAPTYPE.EQ.6) then + if(MAPTYPE==6) then if(grib=='grib2') then dxm=(DXVAL / 360.)*(ERAD*2.*pi)/1.d6 ! [mm] endif @@ -74,13 +74,13 @@ SUBROUTINE MAPSSLP(TPRES) ENDIF ii=im/2 jj=(jsta+jend)/2 - if(i.eq.ii.and.j.eq.jj) & + if(i==ii.and.j==jj) & print*,'Debug TH700(i,j), i,j',TH700(i,j), i,j DO J=JSTA,JEND DO I=1,IM T700(I,J) = TH700(I,J)*(70000./P1000)**CAPA - IF (T700(I,J).GT.100.) THEN + IF (T700(I,J)>100.) THEN TSFCNEW = T700(I,J)*(PMID(I,J,LM)/70000.)**EXPo ! effective sfc T based on 700 mb temp ELSE diff --git a/sorc/ncep_post.fd/MDL2AGL.f b/sorc/ncep_post.fd/MDL2AGL.f index ade02ff3f..03333e058 100644 --- a/sorc/ncep_post.fd/MDL2AGL.f +++ b/sorc/ncep_post.fd/MDL2AGL.f @@ -128,8 +128,8 @@ SUBROUTINE MDL2AGL ! VERTICAL INTERPOLATION OF EVERYTHING ELSE. EXECUTE ONLY ! IF THERE'S SOMETHING WE WANT. ! - IF (IGET(253).GT.0 .OR. IGET(279).GT.0 .OR. IGET(280).GT.0 .OR. & - & IGET(281).GT.0 ) THEN + IF (IGET(253)>0 .OR. IGET(279)>0 .OR. IGET(280)>0 .OR. & + & IGET(281)>0 ) THEN ! !--------------------------------------------------------------------- !*** @@ -177,12 +177,12 @@ SUBROUTINE MDL2AGL NL1X(I,J) = LM ENDIF ! -! if(NL1X(I,J).EQ.LMP1)print*,'Debug: NL1X=LMP1 AT ' +! if(NL1X(I,J)==LMP1)print*,'Debug: NL1X=LMP1 AT ' ! 1 ,i,j,lp ENDDO ENDDO ! -!mptest IF(NHOLD.EQ.0)GO TO 310 +!mptest IF(NHOLD==0)GO TO 310 ! !!$omp parallel do !!$omp& private(nn,i,j,ll,fact,qsat,rhl) @@ -199,9 +199,9 @@ SUBROUTINE MDL2AGL !*** HUMIDITY, CLOUD WATER/ICE, OMEGA, WINDS, AND TKE. !--------------------------------------------------------------------- ! -!HC IF(NL1X(I,J).LE.LM)THEN +!HC IF(NL1X(I,J)<=LM)THEN LLMH = NINT(LMH(I,J)) - IF(NL1X(I,J).LE.LLMH)THEN + IF(NL1X(I,J)<=LLMH)THEN ! !--------------------------------------------------------------------- ! INTERPOLATE LINEARLY IN LOG(P) @@ -225,21 +225,21 @@ SUBROUTINE MDL2AGL DBZR1(I,J) = DBZR(I,J,LL) + (DBZR(I,J,LL)-DBZR(I,J,LL-1))*FACT DBZI1(I,J) = DBZI(I,J,LL) + (DBZI(I,J,LL)-DBZI(I,J,LL-1))*FACT DBZC1(I,J) = DBZC(I,J,LL) + (DBZC(I,J,LL)-DBZC(I,J,LL-1))*FACT - if(MODELNAME.EQ.'RAPR') then - if(DBZ1(I,J).GT.0.) then + if(MODELNAME=='RAPR') then + if(DBZ1(I,J)>0.) then DBZ1LOG(I,J)= 10.*LOG10(DBZ1(I,J)) else DBZ1LOG(I,J)= -100. endif endif -! IF(I.eq.ii.and.j.eq.jj)print*,'Debug AGL RADAR REF', +! IF(I==ii.and.j==jj)print*,'Debug AGL RADAR REF', ! & i,j,ll,zagl(lp),ZINT(I,J,NINT(LMH(I,J))+1) ! & ,ZMID(I,J,LL-1),ZMID(I,J,LL) ! & ,DBZ(I,J,LL-1),DBZ(I,J,LL),DBZ1(I,J) ! & ,DBZR(I,J,LL-1),DBZR(I,J,LL),DBZR1(I,J) ! & ,DBZI(I,J,LL-1),DBZI(I,J,LL),DBZI1(I,J) ! & ,DBZC(I,J,LL-1),DBZC(I,J,LL),DBZC1(I,J) - if(MODELNAME.EQ.'RAPR') then + if(MODELNAME=='RAPR') then DBZ1LOG(I,J)=MAX(DBZ1LOG(I,J),DBZmin) else DBZ1(I,J)=MAX(DBZ1(I,J),DBZmin) @@ -272,8 +272,8 @@ SUBROUTINE MDL2AGL ! ! !--- Radar Reflectivity - IF((IGET(253).GT.0) )THEN - if(MODELNAME.EQ.'RAPR') then + IF((IGET(253)>0) )THEN + if(MODELNAME=='RAPR') then DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=DBZ1LOG(I,J) @@ -294,7 +294,7 @@ SUBROUTINE MDL2AGL endif END IF !--- Radar reflectivity from rain - IF((IGET(279).GT.0) )THEN + IF((IGET(279)>0) )THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=DBZR1(I,J) @@ -308,7 +308,7 @@ SUBROUTINE MDL2AGL endif END IF !--- Radar reflectivity from all ice habits (snow + graupel + sleet, etc.) - IF((IGET(280).GT.0) )THEN + IF((IGET(280)>0) )THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=DBZI1(I,J) @@ -322,7 +322,7 @@ SUBROUTINE MDL2AGL endif END IF !--- Radar reflectivity from parameterized convection - IF((IGET(281).GT.0) )THEN + IF((IGET(281)>0) )THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=DBZC1(I,J) @@ -347,7 +347,7 @@ SUBROUTINE MDL2AGL ! SRD LP=1 !--- Max Derived Radar Reflectivity - IF((IGET(421).GT.0) )THEN + IF((IGET(421)>0) )THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=REFD_MAX(I,J) @@ -358,7 +358,7 @@ SUBROUTINE MDL2AGL fld_info(cfld)%ifld=IAVBLFLD(IGET(421)) fld_info(cfld)%lvl=LVLSXML(LP,IGET(421)) fld_info(cfld)%tinvstat=1 - if (IFHR .gt. 0) then + if (IFHR > 0) then fld_info(cfld)%tinvstat=1 else fld_info(cfld)%tinvstat=0 @@ -369,7 +369,7 @@ SUBROUTINE MDL2AGL END IF !--- Max Derived Radar Reflectivity at -10C - IF((IGET(785).GT.0) )THEN + IF((IGET(785)>0) )THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=REFDM10C_MAX(I,J) @@ -379,7 +379,7 @@ SUBROUTINE MDL2AGL cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(785)) fld_info(cfld)%lvl=LVLSXML(LP,IGET(785)) - if (IFHR .gt. 0) then + if (IFHR > 0) then fld_info(cfld)%tinvstat=1 else fld_info(cfld)%tinvstat=0 @@ -390,7 +390,7 @@ SUBROUTINE MDL2AGL END IF !--- Max Updraft Helicity - IF((IGET(420).GT.0) )THEN + IF((IGET(420)>0) )THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=UP_HELI_MAX(I,J) @@ -411,7 +411,7 @@ SUBROUTINE MDL2AGL END IF !--- Max Updraft Helicity 1-6 km - IF((IGET(700).GT.0) )THEN + IF((IGET(700)>0) )THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=UP_HELI_MAX16(I,J) @@ -432,7 +432,7 @@ SUBROUTINE MDL2AGL END IF !--- Min Updraft Helicity - IF((IGET(786).GT.0) )THEN + IF((IGET(786)>0) )THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=UP_HELI_MIN(I,J) @@ -453,7 +453,7 @@ SUBROUTINE MDL2AGL END IF !--- Min Updraft Helicity 1-6 km - IF((IGET(787).GT.0) )THEN + IF((IGET(787)>0) )THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=UP_HELI_MIN16(I,J) @@ -474,7 +474,7 @@ SUBROUTINE MDL2AGL END IF !--- Max Updraft Helicity 0-2 km - IF((IGET(788).GT.0) )THEN + IF((IGET(788)>0) )THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=UP_HELI_MAX02(I,J) @@ -494,7 +494,7 @@ SUBROUTINE MDL2AGL endif END IF !--- Min Updraft Helicity 0-2 km - IF((IGET(789).GT.0) )THEN + IF((IGET(789)>0) )THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=UP_HELI_MIN02(I,J) @@ -515,7 +515,7 @@ SUBROUTINE MDL2AGL END IF !--- Max Updraft Helicity 0-3 km - IF((IGET(790).GT.0) )THEN + IF((IGET(790)>0) )THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=UP_HELI_MAX03(I,J) @@ -536,7 +536,7 @@ SUBROUTINE MDL2AGL END IF !--- Min Updraft Helicity 0-3 km - IF((IGET(791).GT.0) )THEN + IF((IGET(791)>0) )THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=UP_HELI_MIN03(I,J) @@ -557,7 +557,7 @@ SUBROUTINE MDL2AGL END IF !--- Max Relative Vertical Vorticity 0-2 km - IF((IGET(792).GT.0) )THEN + IF((IGET(792)>0) )THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=REL_VORT_MAX(I,J) @@ -578,7 +578,7 @@ SUBROUTINE MDL2AGL END IF !--- Max Relative Vertical Vorticity 0-1 km - IF((IGET(793).GT.0) )THEN + IF((IGET(793)>0) )THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=REL_VORT_MAX01(I,J) @@ -598,7 +598,7 @@ SUBROUTINE MDL2AGL endif END IF !--- Max Relative Vertical Vorticity @ hybrid level 1 - IF((IGET(890).GT.0) )THEN + IF((IGET(890)>0) )THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=REL_VORT_MAXHY1(I,J) @@ -619,7 +619,7 @@ SUBROUTINE MDL2AGL END IF !--- Max Hail Diameter in Column - IF((IGET(794).GT.0) )THEN + IF((IGET(794)>0) )THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=HAIL_MAX2D(I,J) @@ -640,7 +640,7 @@ SUBROUTINE MDL2AGL END IF !--- Max Hail Diameter at k=1 - IF((IGET(795).GT.0) )THEN + IF((IGET(795)>0) )THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=HAIL_MAXK1(I,J) @@ -663,7 +663,7 @@ SUBROUTINE MDL2AGL !--- Max hail diameter at surface from WRF HAILCAST algorithm (HRRR !applications) ! (J. Kenyon/GSD, added 1 May 2019) - IF((IGET(728).GT.0) )THEN + IF((IGET(728)>0) )THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=HAIL_MAXHAILCAST(I,J)/1000.0 ! convert mm to m @@ -684,7 +684,7 @@ SUBROUTINE MDL2AGL END IF !--- Max Column Integrated Graupel - IF((IGET(429).GT.0) )THEN + IF((IGET(429)>0) )THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=GRPL_MAX(I,J) @@ -705,7 +705,7 @@ SUBROUTINE MDL2AGL END IF !--- Max Lightning Threat 1 - IF((IGET(702).GT.0) )THEN + IF((IGET(702)>0) )THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=LTG1_MAX(I,J) @@ -726,7 +726,7 @@ SUBROUTINE MDL2AGL END IF !--- Max Lightning Threat 2 - IF((IGET(703).GT.0) )THEN + IF((IGET(703)>0) )THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=LTG2_MAX(I,J) @@ -747,7 +747,7 @@ SUBROUTINE MDL2AGL END IF !--- Max Lightning Threat 3 - IF((IGET(704).GT.0) )THEN + IF((IGET(704)>0) )THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=LTG3_MAX(I,J) @@ -768,7 +768,7 @@ SUBROUTINE MDL2AGL END IF !--- GSD Updraft Helicity - IF((IGET(727).GT.0) )THEN + IF((IGET(727)>0) )THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=UP_HELI(I,J) @@ -783,7 +783,7 @@ SUBROUTINE MDL2AGL END IF !--- Updraft Helicity 1-6 km layer - IF((IGET(701).GT.0) )THEN + IF((IGET(701)>0) )THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=UP_HELI16(I,J) @@ -798,7 +798,7 @@ SUBROUTINE MDL2AGL END IF !--- Convective Initiation Lightning - IF((IGET(705).GT.0) )THEN + IF((IGET(705)>0) )THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=NCI_LTG(I,J)/60.0 @@ -819,7 +819,7 @@ SUBROUTINE MDL2AGL END IF !--- Convective Activity Lightning - IF((IGET(706).GT.0) )THEN + IF((IGET(706)>0) )THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=NCA_LTG(I,J)/60.0 @@ -840,7 +840,7 @@ SUBROUTINE MDL2AGL END IF !--- Convective Initiation Vertical Hydrometeor Flux - IF((IGET(707).GT.0) )THEN + IF((IGET(707)>0) )THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=NCI_WQ(I,J)/60.0 @@ -861,7 +861,7 @@ SUBROUTINE MDL2AGL END IF !--- Convective Activity Vertical Hydrometeor Flux - IF((IGET(708).GT.0) )THEN + IF((IGET(708)>0) )THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=NCA_WQ(I,J)/60.0 @@ -882,7 +882,7 @@ SUBROUTINE MDL2AGL END IF !--- Convective Initiation Reflectivity - IF((IGET(709).GT.0) )THEN + IF((IGET(709)>0) )THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=NCI_REFD(I,J)/60.0 @@ -903,7 +903,7 @@ SUBROUTINE MDL2AGL END IF !--- Convective Activity Reflectivity - IF((IGET(710).GT.0) )THEN + IF((IGET(710)>0) )THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=NCA_REFD(I,J)/60.0 @@ -926,7 +926,7 @@ SUBROUTINE MDL2AGL ! SRD ! - IF((IGET(259).GT.0) )THEN + IF((IGET(259)>0) )THEN ! !--------------------------------------------------------------------- !*** @@ -971,12 +971,12 @@ SUBROUTINE MDL2AGL NL1X(I,J)=LM ENDIF ! -! if(NL1X(I,J).EQ.LMP1)print*,'Debug: NL1X=LMP1 AT ' +! if(NL1X(I,J)==LMP1)print*,'Debug: NL1X=LMP1 AT ' ! 1 ,i,j,lp ENDDO ENDDO ! -!mptest IF(NHOLD.EQ.0)GO TO 310 +!mptest IF(NHOLD==0)GO TO 310 ! !!$omp parallel do !!$omp& private(nn,i,j,ll,fact,qsat,rhl) @@ -1024,9 +1024,9 @@ SUBROUTINE MDL2AGL !*** HUMIDITY, CLOUD WATER/ICE, OMEGA, WINDS, AND TKE. !--------------------------------------------------------------------- ! -!HC IF(NL1X(I,J).LE.LM)THEN +!HC IF(NL1X(I,J)<=LM)THEN LLMH = NINT(LMH(I,J)) - IF(NL1X(I,J).LE.LLMH)THEN + IF(NL1X(I,J)<=LLMH)THEN ! !--------------------------------------------------------------------- ! INTERPOLATE LINEARLY IN LOG(P) @@ -1123,8 +1123,8 @@ SUBROUTINE MDL2AGL DO J=JSTA,JEND DO I=1,IM - IF(ABS(UAGL(I,J)-SPVAL).GT.SMALL .AND. & - ABS(VAGL(I,J)-SPVAL).GT.SMALL)THEN + IF(ABS(UAGL(I,J)-SPVAL)>SMALL .AND. & + ABS(VAGL(I,J)-SPVAL)>SMALL)THEN IF(GRIDTYPE=='B' .OR. GRIDTYPE=='E')THEN GRID1(I,J)=SQRT((UAGL(I,J)-U10H(I,J))**2+ & (VAGL(I,J)-V10H(I,J))**2)*1.943*ZAGL2(LP)/ & @@ -1155,7 +1155,7 @@ SUBROUTINE MDL2AGL ! ENDIF ! CRA - IF (IGET(411).GT.0 .OR. IGET(412).GT.0 .OR. IGET(413).GT.0) THEN + IF (IGET(411)>0 .OR. IGET(412)>0 .OR. IGET(413)>0) THEN ! !--------------------------------------------------------------------- !*** @@ -1200,16 +1200,16 @@ SUBROUTINE MDL2AGL ! WE WILL NOT CONSIDER IT UNDERGROUND AND THE INTERPOLATION ! WILL EXTRAPOLATE TO THAT POINT ! - IF(NL1X(I,J).EQ.(LLMH+1) .AND. ZAGL3(LP).GT.0.)THEN + IF(NL1X(I,J)==(LLMH+1) .AND. ZAGL3(LP)>0.)THEN NL1X(I,J) = LM ENDIF ! -! if(NL1X(I,J).EQ.LMP1)print*,'Debug: NL1X=LMP1 AT ' +! if(NL1X(I,J)==LMP1)print*,'Debug: NL1X=LMP1 AT ' ! 1 ,i,j,lp ENDDO ENDDO ! -!mptest IF(NHOLD.EQ.0)GO TO 310 +!mptest IF(NHOLD==0)GO TO 310 ! !!$omp parallel do !!$omp& private(nn,i,j,ll,fact,qsat,rhl) @@ -1225,9 +1225,9 @@ SUBROUTINE MDL2AGL !*** HUMIDITY, CLOUD WATER/ICE, OMEGA, WINDS, AND TKE. !--------------------------------------------------------------------- ! -!CHC IF(NL1X(I,J).LE.LM)THEN +!CHC IF(NL1X(I,J)<=LM)THEN LLMH = NINT(LMH(I,J)) - IF(NL1X(I,J).LE.LLMH)THEN + IF(NL1X(I,J)<=LLMH)THEN ! !--------------------------------------------------------------------- ! INTERPOLATE LINEARLY IN LOG(P) @@ -1287,7 +1287,7 @@ SUBROUTINE MDL2AGL ! ! !--- Wind Energy Potential -- 0.5 * moist air density * wind speed^3 - IF((IGET(411).GT.0) ) THEN + IF((IGET(411)>0) ) THEN DO J=JSTA,JEND DO I=1,IM QAGL(I,J)=QAGL(I,J)/1000.0 @@ -1304,7 +1304,7 @@ SUBROUTINE MDL2AGL endif ENDIF !--- U Component of wind - IF((IGET(412).GT.0) ) THEN + IF((IGET(412)>0) ) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=UAGL(I,J) @@ -1318,7 +1318,7 @@ SUBROUTINE MDL2AGL endif ENDIF !--- V Component of wind - IF((IGET(413).GT.0) ) THEN + IF((IGET(413)>0) ) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=VAGL(I,J) diff --git a/sorc/ncep_post.fd/MDL2P.f b/sorc/ncep_post.fd/MDL2P.f index fd25d1258..f8a38443f 100644 --- a/sorc/ncep_post.fd/MDL2P.f +++ b/sorc/ncep_post.fd/MDL2P.f @@ -321,7 +321,7 @@ SUBROUTINE MDL2P(iostatusD3D) LL = NL1X(I,J) LLMH = NINT(LMH(I,J)) -!HC IF(NL1X(I,J).LE.LM)THEN +!HC IF(NL1X(I,J)<=LM)THEN IF(SPL(LP) < PINT(I,J,2)) THEN ! Above second interface IF(T(I,J,1) < SPVAL) TSL(I,J) = T(I,J,1) @@ -714,12 +714,12 @@ SUBROUTINE MDL2P(iostatusD3D) ! 3 *LOG(SPL(LP)/SPL(LP-1))/2.0 ! if(abs(SPL(LP)-97500.0) < 0.01)then -! if(gdlat(i,j) > 35.0.and.gdlat(i,j).le.37.0 .and. & +! if(gdlat(i,j) > 35.0.and.gdlat(i,j)<=37.0 .and. & ! gdlon(i,j) > -100.0 .and. gdlon(i,j) < -96.0)print*, & ! 'Debug:I,J,FPRS(LP-1),TPRS(LP-1),TSL,SPL(LP),SPL(LP-1)=' & ! ,i,j,FPRS(I,J,LP-1),TPRS(I,J,LP-1),TSL(I,J),SPL(LP) & ! ,SPL(LP-1) -! if(gdlat(i,j) > 35.0.and.gdlat(i,j).le.37.0 .and. +! if(gdlat(i,j) > 35.0.and.gdlat(i,j)<=37.0 .and. ! 1 gdlon(i,j) > -100.0 .and. gdlon(i,j) < -96.0)print*, ! 2 'Debug:I,J,PNL1,TSL,NL1X,ZINT,FSL= ',I,J,PNL1,TSL(I,J) ! 3 ,NL1X(I,J),ZINT(I,J,NL1X(I,J)),FSL(I,J)/G @@ -758,7 +758,7 @@ SUBROUTINE MDL2P(iostatusD3D) END IF ELSE LA = NL1XF(I,J) - IF(NL1XF(I,J).LE.(LLMH+1)) THEN + IF(NL1XF(I,J)<=(LLMH+1)) THEN FACT = (ALSL(LP)-LOG(PINT(I,J,LA)))/ & (LOG(PINT(I,J,LA))-LOG(PINT(I,J,LA-1))) IF(ZINT(I,J,LA) < SPVAL .AND. ZINT(I,J,LA-1) < SPVAL) & @@ -872,14 +872,14 @@ SUBROUTINE MDL2P(iostatusD3D) !*** VERTICAL INTERPOLATION OF WINDS FOR A-E GRID !--------------------------------------------------------------------- ! -!HC IF(NL1X(I,J).LE.LM)THEN +!HC IF(NL1X(I,J)<=LM)THEN LLMH = NINT(LMH(I,J)) IF(SPL(LP) < PINT(I,J,2))THEN ! Above second interface IF(UH(I,J,1) < SPVAL) USL(I,J) = UH(I,J,1) IF(VH(I,J,1) < SPVAL) VSL(I,J) = VH(I,J,1) - ELSE IF(NL1X(I,J).LE.LLMH)THEN + ELSE IF(NL1X(I,J)<=LLMH)THEN ! !--------------------------------------------------------------------- ! INTERPOLATE LINEARLY IN LOG(P) @@ -957,14 +957,14 @@ SUBROUTINE MDL2P(iostatusD3D) !*** VERTICAL INTERPOLATION OF WINDS FOR A-E GRID !--------------------------------------------------------------------- ! -!HC IF(NL1X(I,J).LE.LM)THEN +!HC IF(NL1X(I,J)<=LM)THEN LLMH = NINT(LMH(I,J)) IF(SPL(LP) < PINT(I,J,2))THEN ! Above second interface IF(UH(I,J,1) < SPVAL) USL(I,J) = UH(I,J,1) IF(VH(I,J,1) < SPVAL) VSL(I,J) = VH(I,J,1) - ELSE IF(NL1X(I,J).LE.LLMH)THEN + ELSE IF(NL1X(I,J)<=LLMH)THEN ! !--------------------------------------------------------------------- ! INTERPOLATE LINEARLY IN LOG(P) @@ -1046,8 +1046,8 @@ SUBROUTINE MDL2P(iostatusD3D) ! !*** FROM NWS SHUELL SLP. NGMSLP2 COMPUTES 1000MB GEOPOTENTIAL. ! -!HC ELSEIF(IGET(023).LE.0.AND.LP == LSM)THEN -!HC IF(IGET(023).LE.0.AND.LP == LSM)THEN +!HC ELSEIF(IGET(023)<=0.AND.LP == LSM)THEN +!HC IF(IGET(023)<=0.AND.LP == LSM)THEN !!$omp parallel do private(i,j) !HC DO J=JSTA,JEND !HC DO I=1,IM @@ -1159,8 +1159,8 @@ SUBROUTINE MDL2P(iostatusD3D) !*** virtual TEMPERATURE ! - IF(IGET(910).GT.0) THEN - IF(LVLS(LP,IGET(910)).GT.0)THEN + IF(IGET(910)>0) THEN + IF(LVLS(LP,IGET(910))>0)THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -2148,21 +2148,21 @@ SUBROUTINE MDL2P(iostatusD3D) ENDDO ID(1:25)=0 ITD3D = NINT(TD3D) - if (ITD3D .ne. 0) then + if (ITD3D /= 0) then IFINCR = MOD(IFHR,ITD3D) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITD3D*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITD3D*60) else IFINCR = 0 endif ID(18) = 0 ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 IF (IFINCR == 0) THEN ID(18) = IFHR-ITD3D ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF if(grib == 'grib2')then cfld = cfld + 1 @@ -2195,21 +2195,21 @@ SUBROUTINE MDL2P(iostatusD3D) ENDDO ID(1:25)=0 ITD3D = NINT(TD3D) - if (ITD3D .ne. 0) then + if (ITD3D /= 0) then IFINCR = MOD(IFHR,ITD3D) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITD3D*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITD3D*60) else IFINCR = 0 endif ID(18) = 0 ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 IF (IFINCR == 0) THEN ID(18) = IFHR-ITD3D ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF if(grib == 'grib2')then cfld = cfld + 1 @@ -2242,21 +2242,21 @@ SUBROUTINE MDL2P(iostatusD3D) ENDDO ID(1:25)=0 ITD3D = NINT(TD3D) - if (ITD3D .ne. 0) then + if (ITD3D /= 0) then IFINCR = MOD(IFHR,ITD3D) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITD3D*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITD3D*60) else IFINCR = 0 endif ID(18) = 0 ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 IF (IFINCR == 0) THEN ID(18) = IFHR-ITD3D ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF if(grib == 'grib2')then cfld = cfld + 1 @@ -2289,21 +2289,21 @@ SUBROUTINE MDL2P(iostatusD3D) ENDDO ID(1:25)=0 ITD3D = NINT(TD3D) - if (ITD3D .ne. 0) then + if (ITD3D /= 0) then IFINCR = MOD(IFHR,ITD3D) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITD3D*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITD3D*60) else IFINCR = 0 endif ID(18) = 0 ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 IF (IFINCR == 0) THEN ID(18) = IFHR-ITD3D ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF if(grib == 'grib2')then cfld = cfld + 1 @@ -2336,21 +2336,21 @@ SUBROUTINE MDL2P(iostatusD3D) ENDDO ID(1:25)=0 ITD3D = NINT(TD3D) - if (ITD3D .ne. 0) then + if (ITD3D /= 0) then IFINCR = MOD(IFHR,ITD3D) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITD3D*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITD3D*60) else IFINCR = 0 endif ID(18) = 0 ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 IF (IFINCR == 0) THEN ID(18) = IFHR-ITD3D ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF if(grib == 'grib2')then cfld = cfld + 1 @@ -2383,21 +2383,21 @@ SUBROUTINE MDL2P(iostatusD3D) ENDDO ID(1:25)=0 ITD3D = NINT(TD3D) - if (ITD3D .ne. 0) then + if (ITD3D /= 0) then IFINCR = MOD(IFHR,ITD3D) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITD3D*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITD3D*60) else IFINCR = 0 endif ID(18) = 0 ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 IF (IFINCR == 0) THEN ID(18) = IFHR-ITD3D ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF if(grib == 'grib2')then cfld = cfld + 1 @@ -2430,21 +2430,21 @@ SUBROUTINE MDL2P(iostatusD3D) ENDDO ID(1:25)=0 ITD3D = NINT(TD3D) - if (ITD3D .ne. 0) then + if (ITD3D /= 0) then IFINCR = MOD(IFHR,ITD3D) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITD3D*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITD3D*60) else IFINCR = 0 endif ID(18) = 0 ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 IF (IFINCR == 0) THEN ID(18) = IFHR-ITD3D ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF if(grib == 'grib2')then cfld = cfld + 1 @@ -2477,21 +2477,21 @@ SUBROUTINE MDL2P(iostatusD3D) ENDDO ID(1:25)=0 ITD3D = NINT(TD3D) - if (ITD3D .ne. 0) then + if (ITD3D /= 0) then IFINCR = MOD(IFHR,ITD3D) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITD3D*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITD3D*60) else IFINCR = 0 endif ID(18) = 0 ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 IF (IFINCR == 0) THEN ID(18) = IFHR-ITD3D ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF if(grib == 'grib2')then cfld = cfld + 1 @@ -2524,21 +2524,21 @@ SUBROUTINE MDL2P(iostatusD3D) ENDDO ID(1:25)=0 ITD3D = NINT(TD3D) - if (ITD3D .ne. 0) then + if (ITD3D /= 0) then IFINCR = MOD(IFHR,ITD3D) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITD3D*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITD3D*60) else IFINCR = 0 endif ID(18) = 0 ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 IF (IFINCR == 0) THEN ID(18) = IFHR-ITD3D ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF if(grib == 'grib2')then cfld = cfld + 1 @@ -2571,22 +2571,22 @@ SUBROUTINE MDL2P(iostatusD3D) ENDDO ID(1:25)=0 ITD3D = NINT(TD3D) - if (ITD3D .ne. 0) then + if (ITD3D /= 0) then IFINCR = MOD(IFHR,ITD3D) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITD3D*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITD3D*60) else IFINCR = 0 endif ID(02)=133 ! Table 133 ID(18) = 0 ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 IF (IFINCR == 0) THEN ID(18) = IFHR-ITD3D ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF if(grib == 'grib2')then cfld = cfld + 1 @@ -2619,22 +2619,22 @@ SUBROUTINE MDL2P(iostatusD3D) ENDDO ID(1:25)=0 ITD3D = NINT(TD3D) - if (ITD3D .ne. 0) then + if (ITD3D /= 0) then IFINCR = MOD(IFHR,ITD3D) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITD3D*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITD3D*60) else IFINCR = 0 endif ID(02)=133 ! Table 133 ID(18) = 0 ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 IF (IFINCR == 0) THEN ID(18) = IFHR-ITD3D ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF if(grib == 'grib2')then cfld = cfld + 1 @@ -2667,22 +2667,22 @@ SUBROUTINE MDL2P(iostatusD3D) ENDDO ID(1:25)=0 ITD3D = NINT(TD3D) - if (ITD3D .ne. 0) then + if (ITD3D /= 0) then IFINCR = MOD(IFHR,ITD3D) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITD3D*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITD3D*60) else IFINCR = 0 endif ID(02)=133 ! Table 133 ID(18) = 0 ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 IF (IFINCR == 0) THEN ID(18) = IFHR-ITD3D ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF if(grib == 'grib2')then cfld = cfld + 1 @@ -2715,22 +2715,22 @@ SUBROUTINE MDL2P(iostatusD3D) ENDDO ID(1:25)=0 ITD3D = NINT(TD3D) - if (ITD3D .ne. 0) then + if (ITD3D /= 0) then IFINCR = MOD(IFHR,ITD3D) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITD3D*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITD3D*60) else IFINCR = 0 endif ID(02)=133 ! Table 133 ID(18) = 0 ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 IF (IFINCR == 0) THEN ID(18) = IFHR-ITD3D ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF if(grib == 'grib2')then cfld = cfld + 1 @@ -2763,22 +2763,22 @@ SUBROUTINE MDL2P(iostatusD3D) ENDDO ID(1:25)=0 ITD3D = NINT(TD3D) - if (ITD3D .ne. 0) then + if (ITD3D /= 0) then IFINCR = MOD(IFHR,ITD3D) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITD3D*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITD3D*60) else IFINCR = 0 endif ID(02)=133 ! Table 133 ID(18) = 0 ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 IF (IFINCR == 0) THEN ID(18) = IFHR-ITD3D ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF if(grib == 'grib2')then cfld = cfld + 1 @@ -2811,22 +2811,22 @@ SUBROUTINE MDL2P(iostatusD3D) ENDDO ID(1:25)=0 ITD3D = NINT(TD3D) - if (ITD3D .ne. 0) then + if (ITD3D /= 0) then IFINCR = MOD(IFHR,ITD3D) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITD3D*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITD3D*60) else IFINCR = 0 endif ID(02)=133 ! Table 133 ID(18) = 0 ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 IF (IFINCR == 0) THEN ID(18) = IFHR-ITD3D ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF if(grib == 'grib2')then cfld = cfld + 1 @@ -2859,21 +2859,21 @@ SUBROUTINE MDL2P(iostatusD3D) ENDDO ID(1:25)=0 ITD3D = NINT(TD3D) - if (ITD3D .ne. 0) then + if (ITD3D /= 0) then IFINCR = MOD(IFHR,ITD3D) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITD3D*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITD3D*60) else IFINCR = 0 endif ID(18) = 0 ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 IF (IFINCR == 0) THEN ID(18) = IFHR-ITD3D ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF if(grib == 'grib2')then cfld = cfld + 1 @@ -2906,22 +2906,22 @@ SUBROUTINE MDL2P(iostatusD3D) ENDDO ID(1:25)=0 ITD3D = NINT(TD3D) - if (ITD3D .ne. 0) then + if (ITD3D /= 0) then IFINCR = MOD(IFHR,ITD3D) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITD3D*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITD3D*60) else IFINCR = 0 endif ID(02)=133 ! Table 133 ID(18) = 0 ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 IF (IFINCR == 0) THEN ID(18) = IFHR-ITD3D ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF if(grib == 'grib2')then cfld = cfld + 1 @@ -2954,22 +2954,22 @@ SUBROUTINE MDL2P(iostatusD3D) ENDDO ID(1:25)=0 ITD3D = NINT(TD3D) - if (ITD3D .ne. 0) then + if (ITD3D /= 0) then IFINCR = MOD(IFHR,ITD3D) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITD3D*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITD3D*60) else IFINCR = 0 endif ID(02)=133 ! Table 133 ID(18) = 0 ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 IF (IFINCR == 0) THEN ID(18) = IFHR-ITD3D ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF if(grib == 'grib2')then cfld = cfld + 1 @@ -3002,21 +3002,21 @@ SUBROUTINE MDL2P(iostatusD3D) ENDDO ID(1:25)=0 ITD3D = NINT(TD3D) - if (ITD3D .ne. 0) then + if (ITD3D /= 0) then IFINCR = MOD(IFHR,ITD3D) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITD3D*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITD3D*60) else IFINCR = 0 endif ID(18) = 0 ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 IF (IFINCR == 0) THEN ID(18) = IFHR-ITD3D ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF if(grib == 'grib2')then cfld = cfld + 1 @@ -3049,22 +3049,22 @@ SUBROUTINE MDL2P(iostatusD3D) ENDDO ID(1:25)=0 ITD3D = NINT(TD3D) - if (ITD3D .ne. 0) then + if (ITD3D /= 0) then IFINCR = MOD(IFHR,ITD3D) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITD3D*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITD3D*60) else IFINCR = 0 endif ID(02)=133 ! Table 133 ID(18) = 0 ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 IF (IFINCR == 0) THEN ID(18) = IFHR-ITD3D ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF if(grib == 'grib2')then cfld = cfld + 1 @@ -3097,22 +3097,22 @@ SUBROUTINE MDL2P(iostatusD3D) ENDDO ID(1:25)=0 ITD3D = NINT(TD3D) - if (ITD3D .ne. 0) then + if (ITD3D /= 0) then IFINCR = MOD(IFHR,ITD3D) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITD3D*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITD3D*60) else IFINCR = 0 endif ID(02)=133 ! Table 133 ID(18) = 0 ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 IF (IFINCR == 0) THEN ID(18) = IFHR-ITD3D ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF if(grib == 'grib2')then cfld = cfld + 1 @@ -3145,21 +3145,21 @@ SUBROUTINE MDL2P(iostatusD3D) ENDDO ID(1:25)=0 ITD3D = NINT(TD3D) - if (ITD3D .ne. 0) then + if (ITD3D /= 0) then IFINCR = MOD(IFHR,ITD3D) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITD3D*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITD3D*60) else IFINCR = 0 endif ID(18) = 0 ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 IF (IFINCR == 0) THEN ID(18) = IFHR-ITD3D ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF if(grib == 'grib2') then cfld = cfld + 1 @@ -3198,21 +3198,21 @@ SUBROUTINE MDL2P(iostatusD3D) ENDDO ID(1:25)=0 ITD3D = NINT(TD3D) - if (ITD3D .ne. 0) then + if (ITD3D /= 0) then IFINCR = MOD(IFHR,ITD3D) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITD3D*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITD3D*60) else IFINCR = 0 endif ID(18) = 0 ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 IF (IFINCR == 0) THEN ID(18) = IFHR-ITD3D ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF if(grib == 'grib2') then cfld = cfld + 1 @@ -3245,22 +3245,22 @@ SUBROUTINE MDL2P(iostatusD3D) ENDDO ID(1:25)=0 ITD3D = NINT(TD3D) - if (ITD3D .ne. 0) then + if (ITD3D /= 0) then IFINCR = MOD(IFHR,ITD3D) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITD3D*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITD3D*60) else IFINCR = 0 endif ID(02)=133 ! Table 133 ID(18) = 0 ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 IF (IFINCR == 0) THEN ID(18) = IFHR-ITD3D ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF if(grib == 'grib2') then cfld = cfld + 1 @@ -3293,22 +3293,22 @@ SUBROUTINE MDL2P(iostatusD3D) ENDDO ID(1:25)=0 ITD3D = NINT(TD3D) - if (ITD3D .ne. 0) then + if (ITD3D /= 0) then IFINCR = MOD(IFHR,ITD3D) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITD3D*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITD3D*60) else IFINCR = 0 endif ID(02)=133 ! Table 133 ID(18) = 0 ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 IF (IFINCR == 0) THEN ID(18) = IFHR-ITD3D ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF if(grib == 'grib2') then cfld = cfld + 1 @@ -3341,22 +3341,22 @@ SUBROUTINE MDL2P(iostatusD3D) ENDDO ID(1:25)=0 ITD3D = NINT(TD3D) - if (ITD3D .ne. 0) then + if (ITD3D /= 0) then IFINCR = MOD(IFHR,ITD3D) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITD3D*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITD3D*60) else IFINCR = 0 endif ID(02)=133 ! Table 133 ID(18) = 0 ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 IF (IFINCR == 0) THEN ID(18) = IFHR-ITD3D ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF if(grib == 'grib2') then cfld = cfld + 1 @@ -3389,22 +3389,22 @@ SUBROUTINE MDL2P(iostatusD3D) ENDDO ID(1:25)=0 ITD3D = NINT(TD3D) - if (ITD3D .ne. 0) then + if (ITD3D /= 0) then IFINCR = MOD(IFHR,ITD3D) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITD3D*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITD3D*60) else IFINCR = 0 endif ID(02)=133 ! Table 133 ID(18) = 0 ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 IF (IFINCR == 0) THEN ID(18) = IFHR-ITD3D ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF if(grib == 'grib2') then cfld = cfld + 1 @@ -3437,22 +3437,22 @@ SUBROUTINE MDL2P(iostatusD3D) ENDDO ID(1:25)=0 ITD3D = NINT(TD3D) - if (ITD3D .ne. 0) then + if (ITD3D /= 0) then IFINCR = MOD(IFHR,ITD3D) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITD3D*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITD3D*60) else IFINCR = 0 endif ID(02)=133 ! Table 133 ID(18) = 0 ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 IF (IFINCR == 0) THEN ID(18) = IFHR-ITD3D ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF if(grib == 'grib2') then cfld = cfld + 1 @@ -3637,7 +3637,7 @@ SUBROUTINE MDL2P(iostatusD3D) cfld = cfld + 1 fld_info(cfld)%ifld = IAVBLFLD(IGET(423)) fld_info(cfld)%lvl = LVLSXML(LP,IGET(423)) - if (IFHR .gt. 0) then + if (IFHR > 0) then fld_info(cfld)%tinvstat=1 else fld_info(cfld)%tinvstat=0 @@ -3667,7 +3667,7 @@ SUBROUTINE MDL2P(iostatusD3D) cfld = cfld + 1 fld_info(cfld)%ifld=IAVBLFLD(IGET(424)) fld_info(cfld)%lvl=LVLSXML(LP,IGET(424)) - if (IFHR .gt. 0) then + if (IFHR > 0) then fld_info(cfld)%tinvstat=1 else fld_info(cfld)%tinvstat=0 diff --git a/sorc/ncep_post.fd/MDL2SIGMA.f b/sorc/ncep_post.fd/MDL2SIGMA.f index 229adf7c5..1e4b35fe6 100644 --- a/sorc/ncep_post.fd/MDL2SIGMA.f +++ b/sorc/ncep_post.fd/MDL2SIGMA.f @@ -117,14 +117,14 @@ SUBROUTINE MDL2SIGMA ! VERTICAL INTERPOLATION OF EVERYTHING ELSE. EXECUTE ONLY ! IF THERE'S SOMETHING WE WANT. ! - IF((IGET(205).GT.0).OR.(IGET(206).GT.0).OR. & - (IGET(207).GT.0).OR.(IGET(208).GT.0).OR. & - (IGET(209).GT.0).OR.(IGET(210).GT.0).OR. & - (IGET(216).GT.0).OR.(IGET(217).GT.0).OR. & - (IGET(211).GT.0).OR.(IGET(212).GT.0).OR. & - (IGET(213).GT.0).OR.(IGET(214).GT.0).OR. & - (IGET(215).GT.0).OR.(IGET(222).GT.0).OR. & - (IGET(243).GT.0) ) THEN !!Air Quality (Plee Oct2003) + IF((IGET(205)>0).OR.(IGET(206)>0).OR. & + (IGET(207)>0).OR.(IGET(208)>0).OR. & + (IGET(209)>0).OR.(IGET(210)>0).OR. & + (IGET(216)>0).OR.(IGET(217)>0).OR. & + (IGET(211)>0).OR.(IGET(212)>0).OR. & + (IGET(213)>0).OR.(IGET(214)>0).OR. & + (IGET(215)>0).OR.(IGET(222)>0).OR. & + (IGET(243)>0) ) THEN !!Air Quality (Plee Oct2003) ! !--------------------------------------------------------------------- ! @@ -198,7 +198,7 @@ SUBROUTINE MDL2SIGMA AKH(I,J)=SPVAL NL1XF(I,J)=LP1 DO L=1,LP1 - IF(NL1XF(I,J).EQ.LP1.AND.PINT(I,J,L).GT.PTSIGO)THEN + IF(NL1XF(I,J)==LP1.AND.PINT(I,J,L)>PTSIGO)THEN NL1XF(I,J)=L ENDIF ENDDO @@ -212,20 +212,20 @@ SUBROUTINE MDL2SIGMA PNL1=PINT(I,J,NL1XF(I,J)) LL=NL1XF(I,J) LLMH = NINT(LMH(I,J)) - IF(NL1XF(I,J).EQ.1 .AND. T(I,J,1).LT.SPVAL & - .AND. T(I,J,2).LT.SPVAL .AND. Q(I,J,1).LT.SPVAL & - .AND. Q(I,J,2).LT.SPVAL)THEN + IF(NL1XF(I,J)==1 .AND. T(I,J,1)H1)THEN RHU=H1 QU =RHU*QSAT ENDIF - IF(RHU.LT.D01)THEN + IF(RHUH1)THEN RHL=H1 QL =RHL*QSAT ENDIF - IF(RHL.LT.D01)THEN + IF(RHL(LLMH+1))THEN AKH(I,J)=0.0 ELSE FACT=(APFSIGO-LOG(PINT(I,J,LL)))/ & & (LOG(PINT(I,J,LL))-LOG(PINT(I,J,LL-1))) ! EXCH_H is on the bottom of model interfaces - IF(EXCH_H(I,J,LL-2).LT.SPVAL .AND. EXCH_H(I,J,LL-1).LT.SPVAL) & + IF(EXCH_H(I,J,LL-2)0) THEN + IF (LVLS(1,IGET(205))>0) THEN !$omp parallel do DO J=JSTA,JEND DO I=1,IM - IF(FSL1(I,J).LT.SPVAL) THEN + IF(FSL1(I,J)0) THEN !!Air Quality (Plee Oct2003) ^^^^^ + IF (LVLS(1,IGET(243))>0) THEN !$omp parallel do DO J=JSTA,JEND DO I=1,IM @@ -337,7 +337,7 @@ SUBROUTINE MDL2SIGMA datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend) endif - if(me.eq.0)print*,'output Heat Diffusivity' + if(me==0)print*,'output Heat Diffusivity' ENDIF ENDIF @@ -375,7 +375,7 @@ SUBROUTINE MDL2SIGMA DO L=2,LM LLMH = NINT(LMH(I,J)) PSIGO=PTSIGO+ASIGO(LP)*(PINT(I,J,LLMH+1)-PTSIGO) - IF(NL1X(I,J).EQ.LP1.AND.PMID(I,J,L).GT.PSIGO)THEN + IF(NL1X(I,J)==LP1.AND.PMID(I,J,L)>PSIGO)THEN NL1X(I,J)=L ENDIF ENDDO @@ -385,16 +385,16 @@ SUBROUTINE MDL2SIGMA ! WE WILL NOT CONSIDER IT UNDERGROUND AND THE INTERPOLATION ! WILL EXTRAPOLATE TO THAT POINT ! - IF(NL1X(I,J).EQ.LP1.AND.PINT(I,J,LLMH+1).GE.PSIGO)THEN + IF(NL1X(I,J)==LP1.AND.PINT(I,J,LLMH+1)>=PSIGO)THEN NL1X(I,J)=LM ENDIF ! -! if(NL1X(I,J).EQ.LP1)print*,'Debug: NL1X=LP1 AT ' +! if(NL1X(I,J)==LP1)print*,'Debug: NL1X=LP1 AT ' ! 1 ,i,j,lp ENDDO ENDDO ! -!mptest IF(NHOLD.EQ.0)GO TO 310 +!mptest IF(NHOLD==0)GO TO 310 ! !$omp parallel do private(i,j,ll,llmh,psigo,apsigo,fact,dum,pl, & !$omp & zl,tl,ql,ai,bi,qsat,rhl,tvrl,tvrblo,tblo,tmt0, & @@ -411,11 +411,11 @@ SUBROUTINE MDL2SIGMA !*** HUMIDITY, CLOUD WATER/ICE, OMEGA, WINDS, AND TKE. !--------------------------------------------------------------------- ! -!HC IF(NL1X(I,J).LE.LM)THEN +!HC IF(NL1X(I,J)<=LM)THEN LLMH = NINT(LMH(I,J)) PSIGO=PTSIGO+ASIGO(LP)*(PINT(I,J,LLMH+1)-PTSIGO) APSIGO=LOG(PSIGO) - IF(NL1X(I,J).LE.LLMH)THEN + IF(NL1X(I,J)<=LLMH)THEN ! !--------------------------------------------------------------------- ! INTERPOLATE LINEARLY IN LOG(P) @@ -428,17 +428,17 @@ SUBROUTINE MDL2SIGMA FACT=(APSIGO-LOG(PMID(I,J,LL)))/ & & (LOG(PMID(I,J,LL))-LOG(PMID(I,J,LL-1))) TSL(I,J)=T(I,J,LL)+(T(I,J,LL)-T(I,J,LL-1))*FACT - IF(Q(I,J,LL).LT.SPVAL .AND. Q(I,J,LL-1).LT.SPVAL) & + IF(Q(I,J,LL)1.) QSL(I,J)=QSAT +!hc IF(RHL<0.01) QSL(I,J)=0.01*QSAT + IF(Q2SL(I,J)<0.0) Q2SL(I,J)=0.0 ! !HC ADD FERRIER'S HYDROMETEOR - IF(CWM(I,J,LL).LT.SPVAL .AND. CWM(I,J,LL-1).LT.SPVAL) & + IF(CWM(I,J,LL)1.)THEN RHL=1. QL =RHL*QSAT ENDIF ! - IF(RHL.LT.0.01)THEN + IF(RHL<0.01)THEN RHL=0.01 QL =RHL*QSAT ENDIF @@ -520,7 +520,7 @@ SUBROUTINE MDL2SIGMA TMT0=TBLO-A3 AI=0.008855 BI=1. - IF(TMT0.LT.-20.)THEN + IF(TMT0<-20.)THEN AI=0.007225 BI=0.9674 ENDIF @@ -559,7 +559,7 @@ SUBROUTINE MDL2SIGMA LLMH = NINT(LMH(I,J)) PSIGO=PTSIGO+SIGO(LP+1)*(PINT(I,J,LLMH+1)-PTSIGO) DO L=1,LP1 - IF(NL1XF(I,J).EQ.LP1.AND.PINT(I,J,L).GT.PSIGO)THEN + IF(NL1XF(I,J)==LP1.AND.PINT(I,J,L)>PSIGO)THEN NL1XF(I,J)=L ENDIF ENDDO @@ -577,9 +577,9 @@ SUBROUTINE MDL2SIGMA APFSIGO=LOG(PFSIGO) PNL1F=PINT(I,J,NL1XF(I,J)) LL=NL1XF(I,J) - IF(NL1XF(I,J).EQ.1 .AND. T(I,J,1).LT.SPVAL & - & .AND. T(I,J,2).LT.SPVAL .AND. Q(I,J,1).LT.SPVAL & - & .AND. Q(I,J,2).LT.SPVAL)THEN + IF(NL1XF(I,J)==1 .AND. T(I,J,1)H1)THEN RHU=H1 QU =RHU*QSAT ENDIF - IF(RHU.LT.D01)THEN + IF(RHUH1)THEN RHL=H1 QL =RHL*QSAT ENDIF - IF(RHL.LT.D01)THEN + IF(RHL0) THEN + IF(LVLS(LP,IGET(206))>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=TSL(I,J) @@ -985,8 +985,8 @@ SUBROUTINE MDL2SIGMA ! !*** PRESSURE ! - IF(IGET(216).GT.0)THEN - IF(LVLS(LP,IGET(216)).GT.0)THEN + IF(IGET(216)>0)THEN + IF(LVLS(LP,IGET(216))>0)THEN !$omp parallel do DO J=JSTA,JEND DO I=1,IM @@ -1005,8 +1005,8 @@ SUBROUTINE MDL2SIGMA ! !*** SPECIFIC HUMIDITY. ! - IF(IGET(207).GT.0)THEN - IF(LVLS(LP,IGET(207)).GT.0)THEN + IF(IGET(207)>0)THEN + IF(LVLS(LP,IGET(207))>0)THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=QSL(I,J) @@ -1024,8 +1024,8 @@ SUBROUTINE MDL2SIGMA ! !*** OMEGA ! - IF(IGET(210).GT.0)THEN - IF(LVLS(LP,IGET(210)).GT.0)THEN + IF(IGET(210)>0)THEN + IF(LVLS(LP,IGET(210))>0)THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=OSL(I,J) @@ -1042,8 +1042,8 @@ SUBROUTINE MDL2SIGMA ! !*** U AND/OR V WIND ! - IF(IGET(208).GT.0.OR.IGET(209).GT.0)THEN - IF(LVLS(LP,IGET(208)).GT.0.OR.LVLS(LP,IGET(209)).GT.0) then + IF(IGET(208)>0.OR.IGET(209)>0)THEN + IF(LVLS(LP,IGET(208))>0.OR.LVLS(LP,IGET(209))>0) then DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=USL(I,J) @@ -1065,8 +1065,8 @@ SUBROUTINE MDL2SIGMA ! !*** TURBULENT KINETIC ENERGY ! - IF (IGET(217).GT.0) THEN - IF (LVLS(LP,IGET(217)).GT.0) THEN + IF (IGET(217)>0) THEN + IF (LVLS(LP,IGET(217))>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=Q2SL(I,J) @@ -1083,8 +1083,8 @@ SUBROUTINE MDL2SIGMA ! !*** CLOUD WATER ! - IF (IGET(211).GT.0) THEN - IF (LVLS(LP,IGET(211)).GT.0) THEN + IF (IGET(211)>0) THEN + IF (LVLS(LP,IGET(211))>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=QW1(I,J) @@ -1101,8 +1101,8 @@ SUBROUTINE MDL2SIGMA ! !*** CLOUD ICE ! - IF (IGET(212).GT.0) THEN - IF (LVLS(LP,IGET(212)).GT.0) THEN + IF (IGET(212)>0) THEN + IF (LVLS(LP,IGET(212))>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=QI1(I,J) @@ -1118,8 +1118,8 @@ SUBROUTINE MDL2SIGMA ENDIF ! !--- RAIN - IF (IGET(213).GT.0) THEN - IF (LVLS(LP,IGET(213)).GT.0) THEN + IF (IGET(213)>0) THEN + IF (LVLS(LP,IGET(213))>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=QR1(I,J) @@ -1135,8 +1135,8 @@ SUBROUTINE MDL2SIGMA ENDIF ! !--- SNOW - IF (IGET(214).GT.0) THEN - IF (LVLS(LP,IGET(214)).GT.0) THEN + IF (IGET(214)>0) THEN + IF (LVLS(LP,IGET(214))>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=QS1(I,J) @@ -1152,8 +1152,8 @@ SUBROUTINE MDL2SIGMA ENDIF ! !--- GRAUPEL - IF (IGET(255).GT.0) THEN - IF (LVLS(LP,IGET(255)).GT.0) THEN + IF (IGET(255)>0) THEN + IF (LVLS(LP,IGET(255))>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=QG1(I,J) @@ -1169,8 +1169,8 @@ SUBROUTINE MDL2SIGMA ENDIF ! !--- TOTAL CONDENSATE - IF (IGET(215).GT.0) THEN - IF (LVLS(LP,IGET(215)).GT.0) THEN + IF (IGET(215)>0) THEN + IF (LVLS(LP,IGET(215))>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=C1D(I,J) @@ -1186,8 +1186,8 @@ SUBROUTINE MDL2SIGMA ENDIF ! ! TOTAL CLOUD COVER - IF (IGET(222).GT.0) THEN - IF (LVLS(LP,IGET(222)).GT.0) THEN + IF (IGET(222)>0) THEN + IF (LVLS(LP,IGET(222))>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=CFRSIG(I,J) diff --git a/sorc/ncep_post.fd/MDL2SIGMA2.f b/sorc/ncep_post.fd/MDL2SIGMA2.f index 82d2c7898..9ca042a7a 100644 --- a/sorc/ncep_post.fd/MDL2SIGMA2.f +++ b/sorc/ncep_post.fd/MDL2SIGMA2.f @@ -95,7 +95,7 @@ SUBROUTINE MDL2SIGMA2 ! VERTICAL INTERPOLATION OF EVERYTHING ELSE. EXECUTE ONLY ! IF THERE'S SOMETHING WE WANT. ! - IF((IGET(296).GT.0) ) THEN !!Air Quality (Plee Oct2003) + IF((IGET(296)>0) ) THEN !!Air Quality (Plee Oct2003) ! !--------------------------------------------------------------------- ! @@ -144,7 +144,7 @@ SUBROUTINE MDL2SIGMA2 DO L=2,LM LLMH = NINT(LMH(I,J)) PSIGO=PTSIGO+ASIGO(LP)*(PINT(I,J,LLMH+1)-PTSIGO) - IF(NL1X(I,J).EQ.LP1.AND.PMID(I,J,L).GT.PSIGO)THEN + IF(NL1X(I,J)==LP1.AND.PMID(I,J,L)>PSIGO)THEN NL1X(I,J)=L ENDIF ENDDO @@ -154,16 +154,16 @@ SUBROUTINE MDL2SIGMA2 ! WE WILL NOT CONSIDER IT UNDERGROUND AND THE INTERPOLATION ! WILL EXTRAPOLATE TO THAT POINT ! - IF(NL1X(I,J).EQ.LP1.AND.PINT(I,J,LLMH+1).GE.PSIGO)THEN + IF(NL1X(I,J)==LP1.AND.PINT(I,J,LLMH+1)>=PSIGO)THEN NL1X(I,J)=LM ENDIF ! -! if(NL1X(I,J).EQ.LP1)print*,'Debug: NL1X=LP1 AT ' +! if(NL1X(I,J)==LP1)print*,'Debug: NL1X=LP1 AT ' ! 1 ,i,j,lp ENDDO ENDDO ! -!mptest IF(NHOLD.EQ.0)GO TO 310 +!mptest IF(NHOLD==0)GO TO 310 ! !!$omp parallel do !!$omp& private(nn,i,j,ll,fact,qsat,rhl) @@ -180,11 +180,11 @@ SUBROUTINE MDL2SIGMA2 !*** HUMIDITY, CLOUD WATER/ICE, OMEGA, WINDS, AND TKE. !--------------------------------------------------------------------- ! -!HC IF(NL1X(I,J).LE.LM)THEN +!HC IF(NL1X(I,J)<=LM)THEN LLMH = NINT(LMH(I,J)) PSIGO=PTSIGO+ASIGO(LP)*(PINT(I,J,LLMH+1)-PTSIGO) APSIGO=LOG(PSIGO) - IF(NL1X(I,J).LE.LLMH)THEN + IF(NL1X(I,J)<=LLMH)THEN ! !--------------------------------------------------------------------- ! INTERPOLATE LINEARLY IN LOG(P) @@ -204,7 +204,7 @@ SUBROUTINE MDL2SIGMA2 ELSE ii=91 jj=13 -! if(i.eq.ii.and.j.eq.jj) & +! if(i==ii.and.j==jj) & ! print*,'Debug: underg extra at i,j,lp',i,j,lp PL = PINT(I,J,LM-1) ZL = ZINT(I,J,LM-1) @@ -213,7 +213,7 @@ SUBROUTINE MDL2SIGMA2 TMT0 = Tl - A3 AI = 0.008855 BI = 1. - IF(TMT0.LT.-20.)THEN + IF(TMT0<-20.)THEN AI = 0.007225 BI = 0.9674 ENDIF @@ -221,12 +221,12 @@ SUBROUTINE MDL2SIGMA2 ! RHL = QL/QSAT ! - IF(RHL.GT.1.)THEN + IF(RHL>1.)THEN RHL = 1. QL = RHL*QSAT ENDIF ! - IF(RHL.LT.0.01)THEN + IF(RHL<0.01)THEN RHL = 0.01 QL = RHL*QSAT ENDIF @@ -239,7 +239,7 @@ SUBROUTINE MDL2SIGMA2 TMT0 = TBLO-A3 AI = 0.008855 BI = 1. - IF(TMT0.LT.-20.)THEN + IF(TMT0<-20.)THEN AI = 0.007225 BI = 0.9674 ENDIF @@ -258,8 +258,8 @@ SUBROUTINE MDL2SIGMA2 ! !*** TEMPERATURE ! - IF(IGET(296).GT.0) THEN - IF(LVLS(LP,IGET(296)).GT.0)THEN + IF(IGET(296)>0) THEN + IF(LVLS(LP,IGET(296))>0)THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=TSL(I,J) diff --git a/sorc/ncep_post.fd/MDL2THANDPV.f b/sorc/ncep_post.fd/MDL2THANDPV.f index fd9f20634..7878ba96b 100644 --- a/sorc/ncep_post.fd/MDL2THANDPV.f +++ b/sorc/ncep_post.fd/MDL2THANDPV.f @@ -533,10 +533,10 @@ SUBROUTINE MDL2THANDPV(kth,kpv,th,pv) ! ,dum1d12(l),dum1d13(l) ! end do ! end if - IF((IGET(332).GT.0).OR.(IGET(333).GT.0).OR. & - (IGET(334).GT.0).OR.(IGET(335).GT.0).OR. & - (IGET(351).GT.0).OR.(IGET(352).GT.0).OR. & - (IGET(353).GT.0).OR.(IGET(378).GT.0))THEN + IF((IGET(332)>0).OR.(IGET(333)>0).OR. & + (IGET(334)>0).OR.(IGET(335)>0).OR. & + (IGET(351)>0).OR.(IGET(352)>0).OR. & + (IGET(353)>0).OR.(IGET(378)>0))THEN ! interpolate to isentropic levels CALL P2TH(LM,DUM1D11,UH(I,J,1:LM),VH(I,J,1:LM) & ,DUM1D7,T(I,J,1:LM),DUM1D13,DUM1D12,DUM1D14 & @@ -549,9 +549,9 @@ SUBROUTINE MDL2THANDPV(kth,kpv,th,pv) ,OTH(I,J,1:KTH))!output END IF ! interpolate to PV levels - IF((IGET(336).GT.0).OR.(IGET(337).GT.0).OR. & - (IGET(338).GT.0).OR.(IGET(339).GT.0).OR. & - (IGET(340).GT.0).OR.(IGET(341).GT.0))THEN + IF((IGET(336)>0).OR.(IGET(337)>0).OR. & + (IGET(338)>0).OR.(IGET(339)>0).OR. & + (IGET(340)>0).OR.(IGET(341)>0))THEN CALL P2PV(LM,DUM1D13,ZMID(I,J,1:LM),T(I,J,1:LM),PMID(I,J,1:LM) & ,UH(I,J,1:LM),VH(I,J,1:LM),KPV,PV,PVPT,PVPB*PINT(I,J,LM+1) & ,LPV,UPV(I,J,1:KPV),VPV(I,J,1:KPV),HPV(I,J,1:KPV) & diff --git a/sorc/ncep_post.fd/MDLFLD.f b/sorc/ncep_post.fd/MDLFLD.f index a9c3d2f14..d04c9cc57 100644 --- a/sorc/ncep_post.fd/MDLFLD.f +++ b/sorc/ncep_post.fd/MDLFLD.f @@ -213,7 +213,7 @@ SUBROUTINE MDLFLD RDTPHS=24.*3.6E6/DTQ2 DO J=JSTA,JEND DO I=1,IM - IF ((HBOT(I,J)-HTOP(I,J)) .LE. 1.0) THEN + IF ((HBOT(I,J)-HTOP(I,J)) <= 1.0) THEN ICBOT(I,J)=0 ICTOP(I,J)=0 CNVCFR(I,J)=0. @@ -222,11 +222,11 @@ SUBROUTINE MDLFLD ICTOP(I,J)=NINT(HTOP(I,J)) CFRdum=CC(1) PMOD=RDTPHS*CPRATE(I,J) ! mm/day - IF (PMOD .GT. PPT(1)) THEN + IF (PMOD > PPT(1)) THEN DO NC=1,10 - IF(PMOD.GT.PPT(NC)) NMOD=NC + IF(PMOD>PPT(NC)) NMOD=NC ENDDO - IF (NMOD .GE. 10) THEN + IF (NMOD >= 10) THEN CFRdum=CC(10) ELSE CC1=CC(NMOD) @@ -234,12 +234,12 @@ SUBROUTINE MDLFLD P1=PPT(NMOD) P2=PPT(NMOD+1) CFRdum=CC1+(CC2-CC1)*(PMOD-P1)/(P2-P1) - ENDIF !--- End IF (NMOD .GE. 10) ... + ENDIF !--- End IF (NMOD >= 10) ... CFRdum=MIN(H1, CFRdum) - ENDIF !--- End IF (PMOD .GT. PPT(1)) ... + ENDIF !--- End IF (PMOD > PPT(1)) ... ! CNVCFR(I,J)=100.*CFRdum CNVCFR(I,J)=CFRdum - ENDIF !--- End IF (HBOT(I,J)-HTOP(I,J) .LE. 1.0) ... + ENDIF !--- End IF (HBOT(I,J)-HTOP(I,J) <= 1.0) ... ENDDO !--- DO I=1,IM ENDDO !--- DO J=JSTA,JEND ENDIF !-- IF (MODELNAME=='NMM' .OR. imp_physics==5) THEN @@ -263,13 +263,13 @@ SUBROUTINE MDLFLD ! CUPRATE=CUPPT(I,J)*1000./TRDLW !--- mm/h Zfrz(I,J)=ZMID(I,J,NINT(LMH(I,J))) !-- Initialize to lowest model level DO L=1,NINT(LMH(I,J)) !-- Start from the top, work down - IF (T(I,J,L) .GE. TFRZ) THEN + IF (T(I,J,L) >= TFRZ) THEN Zfrz(I,J)=ZMID(I,J,L) !-- Find highest level where T>0C EXIT ENDIF ENDDO !--- DO L=1,NINT(LMH(I,J)) -! IF (CUPRATE .LE. 0. .OR. CUPPT(I,J).LE.0.) THEN - IF (CUPRATE .LE. 0. .or. htop(i,j)>=spval) THEN ! bug fix, post doesn not use CUPPT +! IF (CUPRATE <= 0. .OR. CUPPT(I,J)<=0.) THEN + IF (CUPRATE <= 0. .or. htop(i,j)>=spval) THEN ! bug fix, post doesn not use CUPPT CUREFL_S(I,J)=0. CUREFL_I(I,J)=0. ELSE @@ -282,7 +282,7 @@ SUBROUTINE MDLFLD ! decrease occurs in the first 1 km above the 0C level. ! CUREFL_I(I,J)=-2./MAX( 1000., ZMID(I,J,Lctop)-Zfrz(I,J) ) - ENDIF !--- IF (CUPRATE .LE. 0. .OR. CUPPT(I,J).LE.0.) THEN + ENDIF !--- IF (CUPRATE <= 0. .OR. CUPPT(I,J)<=0.) THEN ENDDO !--- End DO I ENDDO @@ -306,23 +306,23 @@ SUBROUTINE MDLFLD !--- Estimate radar reflectivity factor at level L ! CUREFL(I,J)=0. - IF (CUREFL_S(I,J) .GT. 0.) THEN + IF (CUREFL_S(I,J) > 0.) THEN FCTR=0. LLMH = NINT(LMH(I,J)) Lctop=NINT(HTOP(I,J)) !--- Cu cld top level - IF (L.GE.Lctop .AND. L.LE.LLMH) THEN + IF (L>=Lctop .AND. L<=LLMH) THEN DELZ=ZMID(I,J,L)-Zfrz(I,J) - IF (DELZ .LE. 0.) THEN + IF (DELZ <= 0.) THEN FCTR=1. !-- Below the highest freezing level ELSE ! !--- Reduce convective radar reflectivity above freezing level ! FCTR=10.**(CUREFL_I(I,J)*DELZ) - ENDIF !-- End IF (DELZ .LE. 0.) - ENDIF !-- End IF (L.GE.HTOP(I,J) .OR. L.LE.LLMH) + ENDIF !-- End IF (DELZ <= 0.) + ENDIF !-- End IF (L>=HTOP(I,J) .OR. L<=LLMH) CUREFL(I,J)=FCTR*CUREFL_S(I,J) - ENDIF !-- End IF (CUREFL_S(I,J) .GT. 0.) + ENDIF !-- End IF (CUREFL_S(I,J) > 0.) ENDDO !-- End DO I loop ENDDO !-- End DO J loop @@ -424,7 +424,7 @@ SUBROUTINE MDLFLD DO J=JSTA,JEND DO I=1,IM LLMH = NINT(LMH(I,J)) - IF (L .GT. LLMH) THEN + IF (L > LLMH) THEN QQW(I,J,L) = D00 QQI(I,J,L) = D00 QQR(I,J,L) = D00 @@ -445,7 +445,7 @@ SUBROUTINE MDLFLD DBZC(I,J,L) = MAX(DBZmin, DBZC1(I,J)) NLICE(I,J,L) = MAX(D00, NLICE1(I,J)) NRAIN(I,J,L) = MAX(D00, NRAIN1(I,J)) - ENDIF !-- End IF (L .GT. LMH(I,J)) ... + ENDIF !-- End IF (L > LMH(I,J)) ... ENDDO !-- End DO I loop ENDDO !-- End DO J loop @@ -466,7 +466,7 @@ SUBROUTINE MDLFLD DO J=JSTA,JEND DO I=1,IM LLMH = NINT(LMH(I,J)) - IF (L .GT. LLMH) THEN + IF (L > LLMH) THEN QQW(I,J,L) = D00 QQI(I,J,L) = D00 QQR(I,J,L) = D00 @@ -485,7 +485,7 @@ SUBROUTINE MDLFLD DBZR(I,J,L) = DBZmin DBZI(I,J,L) = DBZmin DBZC(I,J,L) = DBZmin - ENDIF !-- End IF (L .GT. LMH(I,J)) ... + ENDIF !-- End IF (L > LMH(I,J)) ... ENDDO !-- End DO I loop ENDDO ! END DO L LOOP END DO @@ -494,7 +494,7 @@ SUBROUTINE MDLFLD DO J=JSTA,JEND DO I=1,IM LLMH = NINT(LMH(I,J)) - IF (L .GT. LLMH) THEN + IF (L > LLMH) THEN QQW(I,J,L)=D00 QQI(I,J,L)=D00 QQR(I,J,L)=D00 @@ -515,15 +515,15 @@ SUBROUTINE MDLFLD DBZI(I,J,L)= DBZI(I,J,L)+((QQS(I,J,L)*DENS)**1.75)* & & 2.18500E-10 * 1.E18 ! Z FOR SNOW DBZ(I,J,L)=DBZR(I,J,L)+DBZI(I,J,L) - IF (DBZ(I,J,L).GT.0.) DBZ(I,J,L)=10.0*LOG10(DBZ(I,J,L)) ! DBZ - IF (DBZR(I,J,L).GT.0.)DBZR(I,J,L)=10.0*LOG10(DBZR(I,J,L)) ! DBZ - IF (DBZI(I,J,L).GT.0.) & + IF (DBZ(I,J,L)>0.) DBZ(I,J,L)=10.0*LOG10(DBZ(I,J,L)) ! DBZ + IF (DBZR(I,J,L)>0.)DBZR(I,J,L)=10.0*LOG10(DBZR(I,J,L)) ! DBZ + IF (DBZI(I,J,L)>0.) & & DBZI(I,J,L)=10.0*LOG10(DBZI(I,J,L)) ! DBZ DBZ(I,J,L)=MAX(DBZmin, DBZ(I,J,L)) DBZR(I,J,L)=MAX(DBZmin, DBZR(I,J,L)) DBZI(I,J,L)=MAX(DBZmin, DBZI(I,J,L)) - ENDIF !-- End IF (L .GT. LMH(I,J)) ... + ENDIF !-- End IF (L > LMH(I,J)) ... ENDDO !-- End DO I loop ENDDO END DO @@ -562,13 +562,13 @@ SUBROUTINE MDLFLD CUPRATE=RDTPHS*CPRATE(I,J) !--- Cu precip rate, R (mm/h) Zfrz(I,J)=ZMID(I,J,NINT(LMH(I,J))) !-- Initialize to lowest model level DO L=1,NINT(LMH(I,J)) !-- Start from the top, work down - IF (T(I,J,L) .GE. TFRZ) THEN + IF (T(I,J,L) >= TFRZ) THEN Zfrz(I,J)=ZMID(I,J,L) !-- Find highest level where T>0C EXIT ENDIF ENDDO !--- DO L=1,NINT(LMH(I,J)) -! IF (CUPRATE .LE. 0. .OR. CUPPT(I,J).LE.0.) THEN - IF (CUPRATE .LE. 0. .or. htop(i,j)>=spval) THEN ! bug fix, post doesn not use CUPPT +! IF (CUPRATE <= 0. .OR. CUPPT(I,J)<=0.) THEN + IF (CUPRATE <= 0. .or. htop(i,j)>=spval) THEN ! bug fix, post doesn not use CUPPT CUREFL_S(I,J)=0. CUREFL_I(I,J)=0. ELSE @@ -581,7 +581,7 @@ SUBROUTINE MDLFLD ! decrease occurs in the first 1 km above the 0C level. ! CUREFL_I(I,J)=-2./MAX( 1000., ZMID(I,J,Lctop)-Zfrz(I,J) ) - ENDIF !--- IF (CUPRATE .LE. 0. .OR. CUPPT(I,J).LE.0.) THEN + ENDIF !--- IF (CUPRATE <= 0. .OR. CUPPT(I,J)<=0.) THEN ENDDO !--- End DO I ENDDO @@ -594,24 +594,24 @@ SUBROUTINE MDLFLD !--- Estimate radar reflectivity factor from convection at level L ! CUREFL(I,J)=0. - IF (CUREFL_S(I,J) .GT. 0.) THEN + IF (CUREFL_S(I,J) > 0.) THEN FCTR=0. LLMH = NINT(LMH(I,J)) Lctop=NINT(HTOP(I,J)) !--- Cu cld top level - IF (L.GE.Lctop .AND. L.LE.LLMH) THEN + IF (L>=Lctop .AND. L<=LLMH) THEN DELZ=ZMID(I,J,L)-Zfrz(I,J) - IF (DELZ .LE. 0.) THEN + IF (DELZ <= 0.) THEN FCTR=1. !-- Below the highest freezing level ELSE ! !--- Reduce convective radar reflectivity above freezing level ! FCTR=10.**(CUREFL_I(I,J)*DELZ) - ENDIF !-- End IF (DELZ .LE. 0.) - ENDIF !-- End IF (L.GE.HTOP(I,J) .OR. L.LE.LLMH) + ENDIF !-- End IF (DELZ <= 0.) + ENDIF !-- End IF (L>=HTOP(I,J) .OR. L<=LLMH) CUREFL(I,J)=FCTR*CUREFL_S(I,J) DBZC(I,J,L)=CUREFL(I,J) - ENDIF !-- End IF (CUREFL_S(I,J) .GT. 0.) + ENDIF !-- End IF (CUREFL_S(I,J) > 0.) ! IF(T(I,J,L) < 1.0E-3) print*,'ZERO T' IF(T(I,J,L) > 1.0E-3) & @@ -659,7 +659,7 @@ SUBROUTINE MDLFLD ELSE DBZ(I,J,L) = DBZR(I,J,L) + DBZI(I,J,L) + CUREFL(I,J) END IF -! IF(L.EQ.27.and.QQR(I,J,L).gt.1.e-4)print*, & +! IF(L==27.and.QQR(I,J,L)>1.e-4)print*, & ! 'sample QQR DEN,DBZ= ',QQR(I,J,L),DENS,DBZ(I,J,L) ENDIF IF (DBZ(I,J,L) > 0.) DBZ(I,J,L) = 10.0*LOG10(DBZ(I,J,L)) ! DBZ @@ -709,8 +709,8 @@ SUBROUTINE MDLFLD DO L=1,LM LL=LM-L+1 - IF(T(I,J,LL) .LT. 1.0E-3)print*,'ZERO T' - IF(T(I,J,LL) .gt. 1.0E-3) & + IF(T(I,J,LL) < 1.0E-3)print*,'ZERO T' + IF(T(I,J,LL) > 1.0E-3) & RHOD=PMID(I,J,LL)/ & (RD*T(I,J,LL)*(Q(I,J,LL)*D608+1.0)) ! DENSITY DZ=ZINT(i,j,ll)-ZINT(i,j,lm+1) @@ -750,7 +750,7 @@ SUBROUTINE MDLFLD ! For bright band, increase reflectivity by factor of 5.28, ! which is ratio of dielectric factors for water/ice (.930/.176) - IF (T(i,j,ll) .gt. 273.15) & + IF (T(i,j,ll) > 273.15) & ze_s = ze_s*(1. + 4.28*bb) endif @@ -768,19 +768,19 @@ SUBROUTINE MDLFLD ! Stoelinga Eq. 5 applied to graupel ! For bright band - IF (t(i,j,ll) .gt. 273.15) & + IF (t(i,j,ll) > 273.15) & ze_g = ze_g*(1. + 4.28*bb) endif ! -- total grid scale ze_nc = ze_r + ze_s + ze_g - if (iz1km.eq.0 .and. dz.gt.1000.) then + if (iz1km==0 .and. dz>1000.) then ze_nc_1km = ze_nc iz1km = 1 end if - if (iz4km.eq.0 .and. dz.gt.4000.) then + if (iz4km==0 .and. dz>4000.) then ze_nc_4km = ze_nc iz4km = 1 end if @@ -844,37 +844,37 @@ SUBROUTINE MDLFLD ! ! allocate (RH3D(im,jsta_2l:jend_2u,lm)) - IF ( (IGET(001).GT.0).OR.(IGET(077).GT.0).OR. & - (IGET(002).GT.0).OR.(IGET(003).GT.0).OR. & - (IGET(004).GT.0).OR.(IGET(005).GT.0).OR. & - (IGET(006).GT.0).OR.(IGET(083).GT.0).OR. & - (IGET(007).GT.0).OR.(IGET(008).GT.0).OR. & - (IGET(009).GT.0).OR.(IGET(010).GT.0).OR. & - (IGET(084).GT.0).OR.(IGET(011).GT.0).OR. & - (IGET(041).GT.0).OR.(IGET(124).GT.0).OR. & - (IGET(078).GT.0).OR.(IGET(079).GT.0).OR. & - (IGET(125).GT.0).OR.(IGET(145).GT.0).OR. & - (IGET(140).GT.0).OR.(IGET(040).GT.0).OR. & - (IGET(181).GT.0).OR.(IGET(182).GT.0).OR. & - (IGET(199).GT.0).OR.(IGET(185).GT.0).OR. & - (IGET(186).GT.0).OR.(IGET(187).GT.0).OR. & - (IGET(250).GT.0).OR.(IGET(252).GT.0).OR. & - (IGET(276).GT.0).OR.(IGET(277).GT.0).OR. & - (IGET(750).GT.0).OR.(IGET(751).GT.0).OR. & - (IGET(752).GT.0).OR.(IGET(754).GT.0).OR. & - (IGET(278).GT.0).OR.(IGET(264).GT.0).OR. & - (IGET(450).GT.0).OR.(IGET(480).GT.0).OR. & - (IGET(774).GT.0).OR.(IGET(747).GT.0).OR. & - (IGET(464).GT.0).OR.(IGET(467).GT.0).OR. & - (IGET(629).GT.0).OR.(IGET(630).GT.0).OR. & - (IGET(470).GT.0).OR. & - (IGET(909).GT.0).OR.(IGET(737).GT.0) ) THEN + IF ( (IGET(001)>0).OR.(IGET(077)>0).OR. & + (IGET(002)>0).OR.(IGET(003)>0).OR. & + (IGET(004)>0).OR.(IGET(005)>0).OR. & + (IGET(006)>0).OR.(IGET(083)>0).OR. & + (IGET(007)>0).OR.(IGET(008)>0).OR. & + (IGET(009)>0).OR.(IGET(010)>0).OR. & + (IGET(084)>0).OR.(IGET(011)>0).OR. & + (IGET(041)>0).OR.(IGET(124)>0).OR. & + (IGET(078)>0).OR.(IGET(079)>0).OR. & + (IGET(125)>0).OR.(IGET(145)>0).OR. & + (IGET(140)>0).OR.(IGET(040)>0).OR. & + (IGET(181)>0).OR.(IGET(182)>0).OR. & + (IGET(199)>0).OR.(IGET(185)>0).OR. & + (IGET(186)>0).OR.(IGET(187)>0).OR. & + (IGET(250)>0).OR.(IGET(252)>0).OR. & + (IGET(276)>0).OR.(IGET(277)>0).OR. & + (IGET(750)>0).OR.(IGET(751)>0).OR. & + (IGET(752)>0).OR.(IGET(754)>0).OR. & + (IGET(278)>0).OR.(IGET(264)>0).OR. & + (IGET(450)>0).OR.(IGET(480)>0).OR. & + (IGET(774)>0).OR.(IGET(747)>0).OR. & + (IGET(464)>0).OR.(IGET(467)>0).OR. & + (IGET(629)>0).OR.(IGET(630)>0).OR. & + (IGET(470)>0).OR. & + (IGET(909)>0).OR.(IGET(737)>0) ) THEN DO 190 L=1,LM ! PRESSURE ON MDL SURFACES. - IF (IGET(001).GT.0) THEN - IF (LVLS(L,IGET(001)).GT.0) THEN + IF (IGET(001)>0) THEN + IF (LVLS(L,IGET(001))>0) THEN LL=LM-L+1 !$omp parallel do private(i,j) DO J=JSTA,JEND @@ -900,8 +900,8 @@ SUBROUTINE MDLFLD ! !--- CLOUD WATER on MDL SURFACE (Jin, '01; Ferrier, Feb '02) ! - IF (IGET(124) .GT. 0) THEN - IF (LVLS(L,IGET(124)) .GT. 0) THEN + IF (IGET(124) > 0) THEN + IF (LVLS(L,IGET(124)) > 0) THEN LL=LM-L+1 !$omp parallel do private(i,j) DO J=JSTA,JEND @@ -927,8 +927,8 @@ SUBROUTINE MDLFLD ! !--- CLOUD ICE ON MDL SURFACE (Jin, '01; Ferrier, Feb '02) ! - IF (IGET(125) .GT. 0) THEN - IF (LVLS(L,IGET(125)) .GT. 0) THEN + IF (IGET(125) > 0) THEN + IF (LVLS(L,IGET(125)) > 0) THEN LL=LM-L+1 !$omp parallel do private(i,j,jj) DO J=JSTA,JEND @@ -954,8 +954,8 @@ SUBROUTINE MDLFLD ! !--- RAIN ON MDL SURFACE (Jin, '01; Ferrier, Feb '02) ! - IF (IGET(181) .GT. 0) THEN - IF (LVLS(L,IGET(181)) .GT. 0) THEN + IF (IGET(181) > 0) THEN + IF (LVLS(L,IGET(181)) > 0) THEN LL=LM-L+1 !$omp parallel do private(i,j) DO J=JSTA,JEND @@ -981,8 +981,8 @@ SUBROUTINE MDLFLD ! !--- SNOW ON MDL SURFACE (Jin, '01; Ferrier, Feb '02) ! - IF (IGET(182) .GT. 0) THEN - IF (LVLS(L,IGET(182)) .GT. 0)THEN + IF (IGET(182) > 0) THEN + IF (LVLS(L,IGET(182)) > 0)THEN LL=LM-L+1 !$omp parallel do private(i,j) DO J=JSTA,JEND @@ -1008,8 +1008,8 @@ SUBROUTINE MDLFLD ! !--- GRAUPEL ON MDL SURFACE --tgs ! - IF (IGET(415) .GT. 0) THEN - IF (LVLS(L,IGET(415)) .GT. 0)THEN + IF (IGET(415) > 0) THEN + IF (LVLS(L,IGET(415)) > 0)THEN LL=LM-L+1 !$omp parallel do private(i,j) DO J=JSTA,JEND @@ -1035,8 +1035,8 @@ SUBROUTINE MDLFLD ! !--- QNCLOUD ON MDL SURFACE --cra ! - IF (IGET(747) .GT. 0) THEN - IF (LVLS(L,IGET(747)) .GT. 0)THEN + IF (IGET(747) > 0) THEN + IF (LVLS(L,IGET(747)) > 0)THEN LL=LM-L+1 !$omp parallel do private(i,j) DO J=JSTA,JEND @@ -1062,8 +1062,8 @@ SUBROUTINE MDLFLD ! !--- QNICE ON MDL SURFACE --tgs ! - IF (IGET(752) .GT. 0) THEN - IF (LVLS(L,IGET(752)) .GT. 0)THEN + IF (IGET(752) > 0) THEN + IF (LVLS(L,IGET(752)) > 0)THEN LL=LM-L+1 !$omp parallel do private(i,j) DO J=JSTA,JEND @@ -1089,8 +1089,8 @@ SUBROUTINE MDLFLD ! !--- QNRAIN ON MDL SURFACE --tgs ! - IF (IGET(754) .GT. 0) THEN - IF (LVLS(L,IGET(754)) .GT. 0)THEN + IF (IGET(754) > 0) THEN + IF (LVLS(L,IGET(754)) > 0)THEN LL=LM-L+1 !$omp parallel do private(i,j) DO J=JSTA,JEND @@ -1115,12 +1115,12 @@ SUBROUTINE MDLFLD ENDIF ! QNWFA ON MDL SURFACE --tgs ! - IF (IGET(766) .GT. 0) THEN - IF (LVLS(L,IGET(766)) .GT. 0)THEN + IF (IGET(766) > 0) THEN + IF (LVLS(L,IGET(766)) > 0)THEN LL=LM-L+1 DO J=JSTA,JEND DO I=1,IM - if(QQNWFA(I,J,LL).lt.1.e-8)QQNWFA(I,J,LL)=0. !tgs + if(QQNWFA(I,J,LL)<1.e-8)QQNWFA(I,J,LL)=0. !tgs GRID1(I,J)=QQNWFA(I,J,LL) ENDDO ENDDO @@ -1135,12 +1135,12 @@ SUBROUTINE MDLFLD ! !--- QNIFA ON MDL SURFACE --tgs ! - IF (IGET(767) .GT. 0) THEN - IF (LVLS(L,IGET(767)) .GT. 0)THEN + IF (IGET(767) > 0) THEN + IF (LVLS(L,IGET(767)) > 0)THEN LL=LM-L+1 DO J=JSTA,JEND DO I=1,IM - if(QQNIFA(I,J,LL).lt.1.e-8)QQNIFA(I,J,LL)=0. !tgs + if(QQNIFA(I,J,LL)<1.e-8)QQNIFA(I,J,LL)=0. !tgs GRID1(I,J)=QQNIFA(I,J,LL) ENDDO ENDDO @@ -1155,8 +1155,8 @@ SUBROUTINE MDLFLD ! !--- Total cloud fraction on MDL surfaces. (Ferrier, Nov '04) ! - IF (IGET(145) .GT. 0) THEN - IF (LVLS(L,IGET(145)) .GT. 0) THEN + IF (IGET(145) > 0) THEN + IF (LVLS(L,IGET(145)) > 0) THEN LL=LM-L+1 !$omp parallel do private(i,j) DO J=JSTA,JEND @@ -1183,8 +1183,8 @@ SUBROUTINE MDLFLD !--- Model-state cloud fraction (unprocessed) on model surfaces (JSK, 8 Jan 2015) ! - IF (IGET(774) .GT. 0) THEN - IF (LVLS(L,IGET(774)) .GT. 0) THEN + IF (IGET(774) > 0) THEN + IF (LVLS(L,IGET(774)) > 0) THEN LL=LM-L+1 !$omp parallel do private(i,j) DO J=JSTA,JEND @@ -1213,8 +1213,8 @@ SUBROUTINE MDLFLD !--- Equivalent radar reflectivity factor. ! - IF (IGET(250) .GT. 0) THEN - IF (LVLS(L,IGET(250)) .GT. 0) THEN + IF (IGET(250) > 0) THEN + IF (LVLS(L,IGET(250)) > 0) THEN LL=LM-L+1 ! @@ -1259,8 +1259,8 @@ SUBROUTINE MDLFLD ! !--- TOTAL CONDENSATE ON MDL SURFACE (CWM array; Ferrier, Feb '02) ! - IF (IGET(199).GT.0) THEN - IF (LVLS(L,IGET(199)).GT.0) THEN + IF (IGET(199)>0) THEN + IF (LVLS(L,IGET(199))>0) THEN LL=LM-L+1 !$omp parallel do private(i,j) DO J=JSTA,JEND @@ -1285,8 +1285,8 @@ SUBROUTINE MDLFLD ! !--- F_rain ON MDL SURFACE (Jin, '01; Ferrier, Feb '02) ! - IF (IGET(185).GT.0) THEN - IF (LVLS(L,IGET(185)).GT.0) THEN + IF (IGET(185)>0) THEN + IF (LVLS(L,IGET(185))>0) THEN LL=LM-L+1 !$omp parallel do private(i,j) DO J=JSTA,JEND @@ -1311,8 +1311,8 @@ SUBROUTINE MDLFLD ! !--- F_ice ON MDL SURFACE (Jin, '01; Ferrier, Feb '02) ! - IF (IGET(186).GT.0) THEN - IF (LVLS(L,IGET(186)).GT.0) THEN + IF (IGET(186)>0) THEN + IF (LVLS(L,IGET(186))>0) THEN LL=LM-L+1 !$omp parallel do private(i,j) DO J=JSTA,JEND @@ -1337,8 +1337,8 @@ SUBROUTINE MDLFLD ! !--- F_RimeF ON MDL SURFACE (Jin, '01; Ferrier, Feb '02) ! - IF (IGET(187).GT.0) THEN - IF (LVLS(L,IGET(187)).GT.0) THEN + IF (IGET(187)>0) THEN + IF (LVLS(L,IGET(187))>0) THEN !--- Filter "rime factor" for non-zero precip rates and % frozen precip LL=LM-L+1 !$omp parallel do private(i,j) @@ -1364,8 +1364,8 @@ SUBROUTINE MDLFLD ENDIF ! ! HEIGHTS ON MDL SURFACES. - IF (IGET(077).GT.0) THEN - IF (LVLS(L,IGET(077)).GT.0) THEN + IF (IGET(077)>0) THEN + IF (LVLS(L,IGET(077))>0) THEN LL=LM-L+1 !$omp parallel do private(i,j) DO J=JSTA,JEND @@ -1390,8 +1390,8 @@ SUBROUTINE MDLFLD ENDIF ! ! TEMPERATURE ON MDL SURFACES. - IF (IGET(002).GT.0) THEN - IF (LVLS(L,IGET(002)).GT.0) THEN + IF (IGET(002)>0) THEN + IF (LVLS(L,IGET(002))>0) THEN LL=LM-L+1 !$omp parallel do private(i,j) DO J=JSTA,JEND @@ -1416,8 +1416,8 @@ SUBROUTINE MDLFLD ENDIF ! VIRTUAL TEMPERATURE ON MDL SURFACES. - IF (IGET(909).GT.0) THEN - IF (LVLS(L,IGET(909)).GT.0) THEN + IF (IGET(909)>0) THEN + IF (LVLS(L,IGET(909))>0) THEN LL=LM-L+1 !$omp parallel do private(i,j) DO J=JSTA,JEND @@ -1436,8 +1436,8 @@ SUBROUTINE MDLFLD ENDIF ! ! POTENTIAL TEMPERATURE ON MDL SURFACES. - IF (IGET(003).GT.0) THEN - IF (LVLS(L,IGET(003)).GT.0) THEN + IF (IGET(003)>0) THEN + IF (LVLS(L,IGET(003))>0) THEN LL=LM-L+1 !$omp parallel do private(i,j) DO J=JSTA,JEND @@ -1471,8 +1471,8 @@ SUBROUTINE MDLFLD ENDIF ! ! VIRTUAL POTENTIAL TEMPERATURE ON MDL SURFACES. - IF (IGET(751).GT.0) THEN - IF (LVLS(L,IGET(751)).GT.0) THEN + IF (IGET(751)>0) THEN + IF (LVLS(L,IGET(751))>0) THEN LL=LM-L+1 !$omp parallel do private(i,j) DO J=JSTA,JEND @@ -1551,8 +1551,8 @@ SUBROUTINE MDLFLD ! ! DEWPOINT ON MDL SURFACES. - IF (IGET(004).GT.0) THEN - IF (LVLS(L,IGET(004)).GT.0) THEN + IF (IGET(004)>0) THEN + IF (LVLS(L,IGET(004))>0) THEN LL=LM-L+1 !$omp parallel do private(i,j) DO J=JSTA,JEND @@ -1585,8 +1585,8 @@ SUBROUTINE MDLFLD ENDIF ! ! SPECIFIC HUMIDITY ON MDL SURFACES. - IF (IGET(005).GT.0) THEN - IF (LVLS(L,IGET(005)).GT.0) THEN + IF (IGET(005)>0) THEN + IF (LVLS(L,IGET(005))>0) THEN LL=LM-L+1 !$omp parallel do private(i,j) DO J=JSTA,JEND @@ -1611,8 +1611,8 @@ SUBROUTINE MDLFLD ENDIF ! ! WATER VAPOR MIXING RATIO ON MDL SURFACES. - IF (IGET(750).GT.0) THEN - IF (LVLS(L,IGET(750)).GT.0) THEN + IF (IGET(750)>0) THEN + IF (LVLS(L,IGET(750))>0) THEN LL=LM-L+1 !$omp parallel do private(i,j) DO J=JSTA,JEND @@ -1640,8 +1640,8 @@ SUBROUTINE MDLFLD ! write(0,*)'iget083=',iget(083),' l=',l LLL = 0 if (IGET(083) > 0) LLL = LVLS(L,IGET(083)) - IF (IGET(083).GT.0 .OR. IGET(295).GT.0) THEN - IF (LLL .GT.0 .OR. IGET(295).GT.0) THEN + IF (IGET(083)>0 .OR. IGET(295)>0) THEN + IF (LLL >0 .OR. IGET(295)>0) THEN LL=LM-L+1 !$omp parallel do private(i,j) DO J=JSTA_2L,JEND_2U @@ -1659,7 +1659,7 @@ SUBROUTINE MDLFLD MCVG(I,J,LL) = EGRID3(I,J) ENDDO ENDDO - IF(IGET(083).GT.0 .AND. LLL.GT.0)THEN + IF(IGET(083)>0 .AND. LLL>0)THEN if(grib=="grib2") then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(083)) @@ -1678,8 +1678,8 @@ SUBROUTINE MDLFLD ! ! U AND/OR V WIND ON MDL SURFACES. !MEB needs to be modified to do u at u-points and v at v-points - IF (IGET(007).GT.0.OR.IGET(008).GT.0) THEN - IF (LVLS(L,IGET(007)).GT.0.OR.LVLS(L,IGET(008)).GT.0 ) THEN + IF (IGET(007)>0.OR.IGET(008)>0) THEN + IF (LVLS(L,IGET(007))>0.OR.LVLS(L,IGET(008))>0 ) THEN LL=LM-L+1 !$omp parallel do private(i,j) DO J=JSTA,JEND @@ -1714,8 +1714,8 @@ SUBROUTINE MDLFLD ENDIF ! ! OMEGA ON MDL SURFACES. - IF (IGET(009).GT.0) THEN - IF (LVLS(L,IGET(009)).GT.0) THEN + IF (IGET(009)>0) THEN + IF (LVLS(L,IGET(009))>0) THEN LL=LM-L+1 !$omp parallel do private(i,j) DO J=JSTA,JEND @@ -1739,8 +1739,8 @@ SUBROUTINE MDLFLD ENDIF ! ! W ON MDL SURFACES. - IF (IGET(264).GT.0) THEN - IF (LVLS(L,IGET(264)).GT.0) THEN + IF (IGET(264)>0) THEN + IF (LVLS(L,IGET(264))>0) THEN LL=LM-L+1 !$omp parallel do private(i,j) DO J=JSTA,JEND @@ -1764,8 +1764,8 @@ SUBROUTINE MDLFLD ENDIF ! ! ABSOLUTE VORTICITY ON MDL SURFACES. - IF (IGET(010).GT.0) THEN - IF (LVLS(L,IGET(010)).GT.0) THEN + IF (IGET(010)>0) THEN + IF (LVLS(L,IGET(010))>0) THEN LL=LM-L+1 !$omp parallel do private(i,j) DO J=JSTA_2L,JEND_2U @@ -1797,8 +1797,8 @@ SUBROUTINE MDLFLD ENDIF ! ! GEOSTROPHIC STREAMFUNCTION ON MDL SURFACES. - IF (IGET(084).GT.0) THEN - IF (LVLS(L,IGET(084)).GT.0) THEN + IF (IGET(084)>0) THEN + IF (LVLS(L,IGET(084))>0) THEN LL=LM-L+1 !$omp parallel do private(i,j) DO J=JSTA,JEND @@ -1829,8 +1829,8 @@ SUBROUTINE MDLFLD ENDIF ! ! TURBULENT KINETIC ENERGY ON MDL SURFACES. - IF (IGET(011).GT.0) THEN - IF (LVLS(L,IGET(011)).GT.0) THEN + IF (IGET(011)>0) THEN + IF (LVLS(L,IGET(011))>0) THEN LL=LM-L+1 !$omp parallel do private(i,j) DO J=JSTA,JEND @@ -1854,11 +1854,11 @@ SUBROUTINE MDLFLD ENDIF ! ! CLOUD WATER CONTENT -!HC IF (IGET(124).GT.0) THEN -!HC IF (LVLS(L,IGET(124)).GT.0) THEN +!HC IF (IGET(124)>0) THEN +!HC IF (LVLS(L,IGET(124))>0) THEN !HC DO J=JSTA,JEND !HC DO I=1,IM -!HC IF(CWM(I,J,L).LT.0..AND.CWM(I,J,L).GT.-1.E-10) +!HC IF(CWM(I,J,L)<0..AND.CWM(I,J,L)>-1.E-10) !HC 1 CWM(I,J,L)=0. !HC GRID1(I,J)=CWM(I,J,L) !HC ENDDO @@ -1870,8 +1870,8 @@ SUBROUTINE MDLFLD ! ! CLOUD ICE CONTENT. !commented out until QICE is brought into post -! IF (IGET(125).GT.0) THEN -! IF (LVLS(L,IGET(125)).GT.0) THEN +! IF (IGET(125)>0) THEN +! IF (LVLS(L,IGET(125))>0) THEN ! DO J=JSTA,JEND ! DO I=1,IM ! GRID1(I,J)=QICE(I,J,L) @@ -1885,8 +1885,8 @@ SUBROUTINE MDLFLD ! CLOUD FRACTION ! !commented out until CFRC is brought into post -! IF (IGET(145).GT.0) THEN -! IF (LVLS(L,IGET(145)).GT.0) THEN +! IF (IGET(145)>0) THEN +! IF (LVLS(L,IGET(145))>0) THEN ! DO J=JSTA,JEND ! DO I=1,IM ! GRID1(I,J)=CFRC(I,J,L) @@ -1899,8 +1899,8 @@ SUBROUTINE MDLFLD ! ! TEMPERATURE TENDENCY DUE TO RADIATIVE FLUX CONVERGENCE !commented out until TTND is brought into post - IF (IGET(140).GT.0) THEN - IF (LVLS(L,IGET(140)).GT.0) THEN + IF (IGET(140)>0) THEN + IF (LVLS(L,IGET(140))>0) THEN LL=LM-L+1 !$omp parallel do private(i,j) DO J=JSTA,JEND @@ -1925,8 +1925,8 @@ SUBROUTINE MDLFLD ! ! TEMPERATURE TENDENCY DUE TO SHORT WAVE RADIATION. !commented out until RSWTT is brought into post - IF (IGET(040).GT.0) THEN - IF (LVLS(L,IGET(040)).GT.0) THEN + IF (IGET(040)>0) THEN + IF (LVLS(L,IGET(040))>0) THEN LL=LM-L+1 !$omp parallel do private(i,j) DO J=JSTA,JEND @@ -1951,8 +1951,8 @@ SUBROUTINE MDLFLD ! ! TEMPERATURE TENDENCY DUE TO LONG WAVE RADIATION. !commented out until RLWTT is brought into post - IF (IGET(041).GT.0) THEN - IF (LVLS(L,IGET(041)).GT.0) THEN + IF (IGET(041)>0) THEN + IF (LVLS(L,IGET(041))>0) THEN LL=LM-L+1 !$omp parallel do private(i,j) DO J=JSTA,JEND @@ -1979,10 +1979,10 @@ SUBROUTINE MDLFLD ! PROCESS NEXT MDL LEVEL. ! ! LATENT HEATING FROM GRID SCALE RAIN/EVAP. (TIME AVE) - IF (IGET(078).GT.0) THEN - IF (LVLS(L,IGET(078)).GT.0) THEN + IF (IGET(078)>0) THEN + IF (LVLS(L,IGET(078))>0) THEN LL=LM-L+1 - IF(AVRAIN.GT.0.)THEN + IF(AVRAIN>0.)THEN RRNUM=1./AVRAIN ELSE RRNUM=0. @@ -1995,20 +1995,20 @@ SUBROUTINE MDLFLD ENDDO ID(1:25) = 0 ITHEAT = INT(THEAT) - IF (ITHEAT .NE. 0) THEN + IF (ITHEAT /= 0) THEN IFINCR = MOD(IFHR,ITHEAT) ELSE IFINCR=0 END IF ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITHEAT ELSE ID(18) = IFHR-IFINCR ENDIF - IF(IFMIN .GE. 1)ID(18)=ID(18)*60 + IF(IFMIN >= 1)ID(18)=ID(18)*60 if(grib=="grib2") then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(078)) @@ -2031,10 +2031,10 @@ SUBROUTINE MDLFLD ENDIF ! ! LATENT HEATING FROM CONVECTION. (TIME AVE) - IF (IGET(079).GT.0) THEN - IF (LVLS(L,IGET(079)).GT.0) THEN + IF (IGET(079)>0) THEN + IF (LVLS(L,IGET(079))>0) THEN LL=LM-L+1 - IF(AVCNVC.GT.0.)THEN + IF(AVCNVC>0.)THEN RRNUM=1./AVCNVC ELSE RRNUM=0. @@ -2047,20 +2047,20 @@ SUBROUTINE MDLFLD ENDDO ID(1:25) = 0 ITHEAT = INT(THEAT) - IF (ITHEAT .NE. 0) THEN + IF (ITHEAT /= 0) THEN IFINCR = MOD(IFHR,ITHEAT) ELSE IFINCR=0 END IF ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITHEAT ELSE ID(18) = IFHR-IFINCR ENDIF - IF(IFMIN .GE. 1)ID(18)=ID(18)*60 + IF(IFMIN >= 1)ID(18)=ID(18)*60 if(grib=="grib2") then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(079)) @@ -2083,8 +2083,8 @@ SUBROUTINE MDLFLD ENDIF ! ! OZONE - IF (IGET(267).GT.0) THEN - IF (LVLS(L,IGET(267)).GT.0) THEN + IF (IGET(267)>0) THEN + IF (LVLS(L,IGET(267))>0) THEN LL=LM-L+1 !$omp parallel do private(i,j) DO J=JSTA,JEND @@ -2109,8 +2109,8 @@ SUBROUTINE MDLFLD ! ! E. James - 8 Dec 2017: SMOKE from WRF-CHEM ! SMOKE - IF (IGET(737).GT.0) THEN - IF (LVLS(L,IGET(737)).GT.0) THEN + IF (IGET(737)>0) THEN + IF (LVLS(L,IGET(737))>0) THEN LL=LM-L+1 !$omp parallel do private(i,j) DO J=JSTA,JEND @@ -2134,8 +2134,8 @@ SUBROUTINE MDLFLD ENDIF ! ! DUST 1 - IF (IGET(629).GT.0) THEN - IF (LVLS(L,IGET(629)).GT.0) THEN + IF (IGET(629)>0) THEN + IF (LVLS(L,IGET(629))>0) THEN LL=LM-L+1 !$omp parallel do private(i,j) DO J=JSTA,JEND @@ -2160,8 +2160,8 @@ SUBROUTINE MDLFLD ENDIF ! DUST 2 - IF (IGET(630).GT.0) THEN - IF (LVLS(L,IGET(630)).GT.0) THEN + IF (IGET(630)>0) THEN + IF (LVLS(L,IGET(630))>0) THEN LL=LM-L+1 !$omp parallel do private(i,j) DO J=JSTA,JEND @@ -2186,8 +2186,8 @@ SUBROUTINE MDLFLD ENDIF ! DUST 3 - IF (IGET(631).GT.0) THEN - IF (LVLS(L,IGET(631)).GT.0) THEN + IF (IGET(631)>0) THEN + IF (LVLS(L,IGET(631))>0) THEN LL=LM-L+1 !$omp parallel do private(i,j) DO J=JSTA,JEND @@ -2212,8 +2212,8 @@ SUBROUTINE MDLFLD ENDIF ! DUST 4 - IF (IGET(632).GT.0) THEN - IF (LVLS(L,IGET(632)).GT.0) THEN + IF (IGET(632)>0) THEN + IF (LVLS(L,IGET(632))>0) THEN LL=LM-L+1 !$omp parallel do private(i,j) DO J=JSTA,JEND @@ -2238,8 +2238,8 @@ SUBROUTINE MDLFLD ENDIF ! DUST 5 - IF (IGET(633).GT.0) THEN - IF (LVLS(L,IGET(633)).GT.0) THEN + IF (IGET(633)>0) THEN + IF (LVLS(L,IGET(633))>0) THEN LL=LM-L+1 !$omp parallel do private(i,j) DO J=JSTA,JEND @@ -2264,8 +2264,8 @@ SUBROUTINE MDLFLD ENDIF ! SEASALT 1 - IF (IGET(634).GT.0) THEN - IF (LVLS(L,IGET(634)).GT.0) THEN + IF (IGET(634)>0) THEN + IF (LVLS(L,IGET(634))>0) THEN LL=LM-L+1 !$omp parallel do private(i,j) DO J=JSTA,JEND @@ -2289,8 +2289,8 @@ SUBROUTINE MDLFLD ENDIF ! SEASALT 2 - IF (IGET(635).GT.0) THEN - IF (LVLS(L,IGET(635)).GT.0) THEN + IF (IGET(635)>0) THEN + IF (LVLS(L,IGET(635))>0) THEN LL=LM-L+1 !$omp parallel do private(i,j) DO J=JSTA,JEND @@ -2314,8 +2314,8 @@ SUBROUTINE MDLFLD ENDIF ! SEASALT 3 - IF (IGET(636).GT.0) THEN - IF (LVLS(L,IGET(636)).GT.0) THEN + IF (IGET(636)>0) THEN + IF (LVLS(L,IGET(636))>0) THEN LL=LM-L+1 !$omp parallel do private(i,j) DO J=JSTA,JEND @@ -2339,8 +2339,8 @@ SUBROUTINE MDLFLD ENDIF ! SEASALT 4 - IF (IGET(637).GT.0) THEN - IF (LVLS(L,IGET(637)).GT.0) THEN + IF (IGET(637)>0) THEN + IF (LVLS(L,IGET(637))>0) THEN LL=LM-L+1 !$omp parallel do private(i,j) DO J=JSTA,JEND @@ -2364,8 +2364,8 @@ SUBROUTINE MDLFLD ENDIF ! SEASALT 0 - IF (IGET(638).GT.0) THEN - IF (LVLS(L,IGET(638)).GT.0) THEN + IF (IGET(638)>0) THEN + IF (LVLS(L,IGET(638))>0) THEN LL=LM-L+1 !$omp parallel do private(i,j) DO J=JSTA,JEND @@ -2389,8 +2389,8 @@ SUBROUTINE MDLFLD ENDIF ! SULFATE - IF (IGET(639).GT.0) THEN - IF (LVLS(L,IGET(639)).GT.0) THEN + IF (IGET(639)>0) THEN + IF (LVLS(L,IGET(639))>0) THEN LL=LM-L+1 !$omp parallel do private(i,j) DO J=JSTA,JEND @@ -2415,8 +2415,8 @@ SUBROUTINE MDLFLD ENDIF ! OC DRY (HYDROPHOBIC ORGANIC CARBON) - IF (IGET(640).GT.0) THEN - IF (LVLS(L,IGET(640)).GT.0) THEN + IF (IGET(640)>0) THEN + IF (LVLS(L,IGET(640))>0) THEN LL=LM-L+1 !$omp parallel do private(i,j) DO J=JSTA,JEND @@ -2441,8 +2441,8 @@ SUBROUTINE MDLFLD ENDIF ! OC WET (HYDROPHILIC ORGANIC CARBON) - IF (IGET(641).GT.0) THEN - IF (LVLS(L,IGET(641)).GT.0) THEN + IF (IGET(641)>0) THEN + IF (LVLS(L,IGET(641))>0) THEN LL=LM-L+1 !$omp parallel do private(i,j) DO J=JSTA,JEND @@ -2467,8 +2467,8 @@ SUBROUTINE MDLFLD ENDIF ! BC DRY (HYDROPHOBIC BLACK CARBON) - IF (IGET(642).GT.0) THEN - IF (LVLS(L,IGET(642)).GT.0) THEN + IF (IGET(642)>0) THEN + IF (LVLS(L,IGET(642))>0) THEN LL=LM-L+1 !$omp parallel do private(i,j) DO J=JSTA,JEND @@ -2493,8 +2493,8 @@ SUBROUTINE MDLFLD ENDIF ! BC WET (HYDROPHILIC BLACK CARBON) - IF (IGET(643).GT.0) THEN - IF (LVLS(L,IGET(643)).GT.0) THEN + IF (IGET(643)>0) THEN + IF (LVLS(L,IGET(643))>0) THEN LL=LM-L+1 !$omp parallel do private(i,j) DO J=JSTA,JEND @@ -2519,8 +2519,8 @@ SUBROUTINE MDLFLD ENDIF ! AIR DENSITY - IF (IGET(644).GT.0) THEN - IF (LVLS(L,IGET(644)).GT.0) THEN + IF (IGET(644)>0) THEN + IF (LVLS(L,IGET(644))>0) THEN LL=LM-L+1 !$omp parallel do private(i,j) DO J=JSTA,JEND @@ -2544,8 +2544,8 @@ SUBROUTINE MDLFLD ENDIF ! LAYER THICKNESS - IF (IGET(645).GT.0) THEN - IF (LVLS(L,IGET(645)).GT.0) THEN + IF (IGET(645)>0) THEN + IF (LVLS(L,IGET(645))>0) THEN LL=LM-L+1 !$omp parallel do private(i,j) DO J=JSTA,JEND @@ -2579,7 +2579,7 @@ SUBROUTINE MDLFLD ! ENDIF ! VISIBILITY -! IF (IGET(180).GT.0) THEN +! IF (IGET(180)>0) THEN !comment out until we get QICE, QSNOW brought into post !MEB RDTPHS= 1./(NPHS*DT) !MEB modifying this Eta-specific code, assuming WRF physics will @@ -2589,7 +2589,7 @@ SUBROUTINE MDLFLD ! NEED TO CALCULATE RAIN WATER AND SNOW MIXING RATIOS ! DO J=JSTA,JEND ! DO I=1,IM -!MEB IF (PREC(I,J).EQ.0) THEN +!MEB IF (PREC(I,J)==0) THEN !MEB QSNO(I,J)=0. !MEB QRAIN(I,J)=0. !MEB ELSE @@ -2628,7 +2628,7 @@ SUBROUTINE MDLFLD ! ! INSTANTANEOUS CONVECTIVE PRECIPITATION RATE. ! -! IF (IGET(249).GT.0) THEN +! IF (IGET(249)>0) THEN ! RDTPHS=1000./DTQ2 ! DO J=JSTA,JEND ! DO I=1,IM @@ -2708,7 +2708,7 @@ SUBROUTINE MDLFLD ! COMPUTE VIL (radar derived vertically integrated liquid water in each column) ! Per Mei Xu, VIL is radar derived vertically integrated liquid water based ! on emprical conversion factors (0.00344) - IF (IGET(581).GT.0) THEN + IF (IGET(581)>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=0.0 @@ -2733,7 +2733,7 @@ SUBROUTINE MDLFLD ! !-- COMPOSITE RADAR REFLECTIVITY FROM RAIN (maximum dBZ in each column due to rain) ! - IF (IGET(276).GT.0) THEN + IF (IGET(276)>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=DBZmin @@ -2758,7 +2758,7 @@ SUBROUTINE MDLFLD !-- COMPOSITE RADAR REFLECTIVITY FROM ICE ! (maximum dBZ in each column due to all ice habits; snow + graupel + etc.) ! - IF (IGET(277).GT.0) THEN + IF (IGET(277)>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=DBZmin @@ -2785,7 +2785,7 @@ SUBROUTINE MDLFLD ! post assuming a constant reflectivity from the surface to the 0C level, ! and decreasing with height at higher levels) ! - IF (IGET(278).GT.0) THEN + IF (IGET(278)>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=DBZmin @@ -2811,12 +2811,12 @@ SUBROUTINE MDLFLD ! J.Case, ENSCO Inc. (5/26/2008) -- Output Echo Tops (Highest HGT in meters ! of the 18-dBZ reflectivity on a model level) - IF (IGET(426).GT.0) THEN + IF (IGET(426)>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=0.0 DO L=1,NINT(LMH(I,J)) - IF (DBZ(I,J,L).GE.18.0) THEN + IF (DBZ(I,J,L)>=18.0) THEN GRID1(I,J)=ZMID(I,J,L)*3.2808/1000. EXIT ENDIF @@ -2851,7 +2851,7 @@ SUBROUTINE MDLFLD DO I=1,IM GRID1(I,J) = -999. DO L=1,NINT(LMH(I,J)) - IF (REF_10CM(I,J,L).GE.18.0) THEN + IF (REF_10CM(I,J,L)>=18.0) THEN GRID1(I,J)=ZMID(I,J,L) EXIT ENDIF @@ -2903,7 +2903,7 @@ SUBROUTINE MDLFLD ! ! Vertically integrated liquid in kg/m^2 ! - IF (IGET(769).GT.0) THEN + IF (IGET(769)>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=0.0 @@ -2975,7 +2975,7 @@ SUBROUTINE MDLFLD ! !--- VISIBILITY ! - IF (IGET(180).GT.0) THEN + IF (IGET(180)>0) THEN RDTPHS=1./DTQ2 ! !--- Needed values at 1st level above ground (Jin, '01; Ferrier, Feb '02) @@ -2984,7 +2984,7 @@ SUBROUTINE MDLFLD DO I=1,IM LLMH=NINT(LMH(I,J)) Q1D(I,J)=Q(I,J,LLMH) - if(Q1D(I,J).le.0.) Q1D(I,J)=0. !tgs + if(Q1D(I,J)<=0.) Q1D(I,J)=0. !tgs QW1(I,J)=QQW(I,J,LLMH) QR1(I,J)=QQR(I,J,LLMH) QI1(I,J)=QQI(I,J,LLMH) @@ -2997,9 +2997,9 @@ SUBROUTINE MDLFLD ! contribution to visibility for all non GFS models ! IF(MODELNAME/='GFS')THEN - IF(imp_physics.ne.99)THEN - IF (CPRATE(I,J) .GT. 0. .and. CPRATE(I,J) .LT. SPVAL) THEN -! IF (CUPPT(I,J) .GT. 0.) THEN + IF(imp_physics/=99)THEN + IF (CPRATE(I,J) > 0. .and. CPRATE(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.) TERM1=(T(I,J,LM)/PMID(I,J,LM))**0.4167 @@ -3007,7 +3007,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) .GT. 0.) THEN + IF (SR(I,J) > 0.) 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 @@ -3021,10 +3021,10 @@ SUBROUTINE MDLFLD ! However, microphysics option 9 in WRF is Milbrandt-Yau 2-moment scheme. ! 3/14/2013: Ratko comitted NEMS change (r26409) to change mp_physics from 9 to 99 for Zhao ! scheme used with NMMB. Post is changing accordingly -! IF(imp_physics.eq.99)THEN ! use rain rate for visibility +! IF(imp_physics==99)THEN ! use rain rate for visibility IF (prec(i,j) < spval .and. prec(I,J) > 0. .and. & sr(i,j) 0.) THEN RAINRATE=(1-SR(I,J))*PREC(I,J)*RDTPHS ! RAINRATE=(1-SR(I,J))*CUPPT(I,J)/(TRDLW*3600.) TERM1=(T(I,J,LM)/PMID(I,J,LM))**0.4167 @@ -3061,7 +3061,7 @@ SUBROUTINE MDLFLD DO J=JSTA,JEND DO I=1,IM - IF(abs(vis(i,j)).gt.24135.1)print*,'bad visbility' & + 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) GRID1(I,J)=VIS(I,J) @@ -3078,7 +3078,7 @@ SUBROUTINE MDLFLD ! ! --- GSD VISIBILITY ! - IF (IGET(410).GT.0) THEN + IF (IGET(410)>0) THEN CALL CALVIS_GSD(CZEN,VIS) DO J=JSTA,JEND DO I=1,IM @@ -3162,7 +3162,7 @@ SUBROUTINE MDLFLD ENDIF ! RADAR REFLECTIVITY AT -10C LEVEL - IF (IGET(912).GT.0) THEN + IF (IGET(912)>0) THEN Zm10c=spval DO J=JSTA,JEND DO I=1,IM @@ -3170,7 +3170,7 @@ SUBROUTINE MDLFLD if (slp(i,j) < spval) then Zm10c(I,J)=ZMID(I,J,NINT(LMH(I,J))) DO L=NINT(LMH(I,J)),1,-1 - IF (T(I,J,L) .LE. 263.15) THEN + IF (T(I,J,L) <= 263.15) THEN Zm10c(I,J)= L !-- Find lowest level where T<-10C EXIT ENDIF @@ -3186,7 +3186,7 @@ SUBROUTINE MDLFLD ! Chuang: use Thompson reflectivity direct output for all ! models ! - IF(IMP_PHYSICS.EQ.8 .or. IMP_PHYSICS.EQ.28) THEN + IF(IMP_PHYSICS==8 .or. IMP_PHYSICS==28) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -3223,14 +3223,14 @@ SUBROUTINE MDLFLD ! ASYMPTOTIC AND FREE ATMOSPHERE MASTER LENGTH SCALE (EL), PLUS ! GRADIENT RICHARDSON NUMBER. ! - IF ( (IGET(111).GT.0) .OR. (IGET(146).GT.0) .OR. & - (IGET(147).GT.0) ) THEN + IF ( (IGET(111)>0) .OR. (IGET(146)>0) .OR. & + (IGET(147)>0) ) THEN ! ! COMPUTE ASYMPTOTIC MASTER LENGTH SCALE. CALL CLMAX(EL0(1,jsta),EGRID2(1,jsta),EGRID3(1,jsta),EGRID4(1,jsta),EGRID5(1,jsta)) ! ! IF REQUESTED, POST ASYMPTOTIC MASTER LENGTH SCALE. - IF (IGET(147).GT.0) THEN + IF (IGET(147)>0) THEN ! DO J=JSTA,JEND DO I=1,IM @@ -3247,7 +3247,7 @@ SUBROUTINE MDLFLD ! IF REQUESTED, POST FREE ATMOSPHERE MASTER LENGTH SCALE ! AND/OR THE GRADIENT RICHARDSON NUMBER. ! - IF ( (IGET(111).GT.0) .OR. (IGET(146).GT.0) ) THEN + IF ( (IGET(111)>0) .OR. (IGET(146)>0) ) THEN ! ! COMPUTE FREE ATMOSPHERE MASTER LENGTH SCALE. !$omp parallel do private(i,j,l) @@ -3259,9 +3259,9 @@ SUBROUTINE MDLFLD ENDDO ENDDO - IF(MODELNAME .EQ. 'NCAR'.OR.MODELNAME.EQ.'RSM'.OR. MODELNAME == 'RAPR')THEN + IF(MODELNAME == 'NCAR'.OR.MODELNAME=='RSM'.OR. MODELNAME == 'RAPR')THEN ! CALL MIXLEN(EL0,EL) - ELSE IF(MODELNAME .EQ. 'NMM')THEN + ELSE IF(MODELNAME == 'NMM')THEN DO L=1,LM DO J=JSTA,JEND DO I=1,IM @@ -3273,17 +3273,17 @@ SUBROUTINE MDLFLD ! ! COMPUTE GRADIENT RICHARDSON NUMBER IF REQUESTED. ! - IF ( (IGET(111).GT.0) ) CALL CALRCH(EL,RICHNO) + IF ( (IGET(111)>0) ) CALL CALRCH(EL,RICHNO) ! ! LOOP OVER MDL LAYERS. DO 200 L = 1,LM ! ! POST MIXING LENGTH. ! - IF (IGET(146).GT.0) THEN + IF (IGET(146)>0) THEN ! ! - IF (LVLS(L,IGET(146)).GT.0) THEN + IF (LVLS(L,IGET(146))>0) THEN LL=LM-L+1 !$omp parallel do private(i,j) DO J=JSTA,JEND @@ -3308,9 +3308,9 @@ SUBROUTINE MDLFLD ! ! POST GRADIENT RICHARDSON NUMBER. ! - IF(L .LT. LM)THEN - IF (IGET(111).GT.0) THEN - IF (LVLS(L,IGET(111)).GT.0) THEN + IF(L < LM)THEN + IF (IGET(111)>0) THEN + IF (LVLS(L,IGET(111))>0) THEN LL=LM-L+1 !$omp parallel do private(i,j) DO J=JSTA,JEND @@ -3342,8 +3342,8 @@ SUBROUTINE MDLFLD ! ! COMPUTE PBL HEIGHT BASED ON RICHARDSON NUMBER ! - IF ( (IGET(289).GT.0) .OR. (IGET(389).GT.0) .OR. (IGET(454).GT.0) & - .OR. (IGET(245).GT.0) .or. IGET(464)>0 .or. IGET(467)>0 & + IF ( (IGET(289)>0) .OR. (IGET(389)>0) .OR. (IGET(454)>0) & + .OR. (IGET(245)>0) .or. IGET(464)>0 .or. IGET(467)>0 & .or. IGET(470)>0 ) THEN ! should only compute pblri if pblh from model is not computed based on Ri ! post does not yet read pbl scheme used by model. Will do this soon @@ -3405,7 +3405,7 @@ SUBROUTINE MDLFLD DO I=1,IM if (EGRID5(I,J) <= EGRID4(I,J)) then -! if (I .eq. 50 .and. J .eq. 50) then +! if (I == 50 .and. J == 50) then ! write(0,*) 'working with L : ', L ! endif HCOUNT = HCOUNT+1 @@ -3448,7 +3448,7 @@ SUBROUTINE MDLFLD HCOUNT=0 DO J=JSTA,JEND DO I=1,IM - if (EGRID5(I,J) .le. EGRID4(I,J)) then + if (EGRID5(I,J) <= EGRID4(I,J)) then HCOUNT=HCOUNT+1 DP = EGRID6(I,J) - EGRID7(I,J) EGRID1(I,J) = EGRID1(I,J) + VH(I,J,L)*DP @@ -3486,7 +3486,7 @@ SUBROUTINE MDLFLD EGRID3(I,J) = sqrt((EGRID1(I,J)*EGRID1(I,J)+EGRID2(I,J)*EGRID2(I,J))) END IF -! if (mod(I,20) .eq. 0 .and. mod(J,20) .eq. 0) then +! if (mod(I,20) == 0 .and. mod(J,20) == 0) then ! write(0,*) 'wind speed ', I,J, EGRID1(I,J) ! endif @@ -3530,13 +3530,13 @@ SUBROUTINE MDLFLD DO J=JSTA,JEND DO I=1,IM - IF (PBLRI(I,J) .ne. SPVAL .and. EGRID3(I,J).ne.SPVAL) then + IF (PBLRI(I,J) /= SPVAL .and. EGRID3(I,J)/=SPVAL) then GRID1(I,J) = EGRID3(I,J)*PBLRI(I,J) else GRID1(I,J) = 0. ENDIF -! if ( (I .ge. 15 .and. I .le. 17) .and. J .ge. 193 .and. J .le. 195) then +! if ( (I >= 15 .and. I <= 17) .and. J >= 193 .and. J <= 195) then ! write(0,*) 'I,J,EGRID1(I,J) (wind speed): ', I,J, EGRID1(I,J) ! write(0,*) 'I,J,PBLH: ', I,J, EGRID4(I,J) ! write(0,*) 'I,J,GRID1 (ventilation rate): ', I,J, GRID1(I,J) @@ -3561,8 +3561,8 @@ SUBROUTINE MDLFLD ENDIF ! ! CALCULATE Gust based on Ri PBL - IF (IGET(245).GT.0 .or. IGET(464)>0 .or. IGET(467)>0.or. IGET(470)>0) THEN - IF(MODELNAME.EQ.'RAPR') THEN + IF (IGET(245)>0 .or. IGET(464)>0 .or. IGET(467)>0.or. IGET(470)>0) THEN + IF(MODELNAME=='RAPR') THEN !tgs - 24may17 - smooth PBLHGUST if(MAPTYPE == 6) then if(grib=='grib2') then @@ -3597,32 +3597,32 @@ SUBROUTINE MDLFLD LPBL(I,J)=LM ZSFC=ZINT(I,J,NINT(LMH(I,J))+1) loopL:DO L=NINT(LMH(I,J)),1,-1 - IF(MODELNAME.EQ.'RAPR') THEN + IF(MODELNAME=='RAPR') THEN HGT=ZMID(I,J,L) PBLHOLD=PBLHGUST(I,J) ELSE HGT=ZINT(I,J,L) PBLHOLD=PBLRI(I,J) ENDIF - IF(HGT .GT. PBLHOLD+ZSFC)THEN + IF(HGT > PBLHOLD+ZSFC)THEN LPBL(I,J)=L+1 - IF(LPBL(I,J).GE.LP1) LPBL(I,J) = LM + IF(LPBL(I,J)>=LP1) LPBL(I,J) = LM EXIT loopL END IF ENDDO loopL if(lpbl(i,j)<1)print*,'zero lpbl',i,j,pblri(i,j),lpbl(i,j) ENDDO ENDDO - IF(MODELNAME.EQ.'RAPR') THEN + IF(MODELNAME=='RAPR') THEN CALL CALGUST(LPBL,PBLHGUST,GUST) ELSE CALL CALGUST(LPBL,PBLRI,GUST) END IF - IF (IGET(245).GT.0) THEN + IF (IGET(245)>0) THEN !$omp parallel do private(i,j,jj) DO J=JSTA,JEND DO I=1,IM -! if(GUST(I,J) .gt. 200. .and. gust(i,j).lt.spval) & +! if(GUST(I,J) > 200. .and. gust(i,j)0) THEN allocate(PBLREGIME(im,jsta_2l:jend_2u)) CALL CALPBLREGIME(PBLREGIME) !$omp parallel do private(i,j) @@ -3669,7 +3669,7 @@ SUBROUTINE MDLFLD ! ! RADAR ECHO TOP (highest 18.3 dBZ level in each column) ! - IF(IGET(400).GT.0)THEN + IF(IGET(400)>0)THEN DO J=JSTA,JEND DO I=1,IM !Initialed as 'undetected'. Nov. 17, 2014, B. ZHOU: @@ -3733,9 +3733,9 @@ SUBROUTINE MDLFLD end do ENDIF - IF (IGET(470).GT.0) THEN + IF (IGET(470)>0) THEN Do L=1,LM - IF (LVLS(L,IGET(470)).GT.0) THEN + IF (LVLS(L,IGET(470))>0) THEN LL=LM-L+1 DO J=JSTA,JEND DO I=1,IM @@ -3797,7 +3797,7 @@ SUBROUTINE MDLFLD end IF ! COMPUTE NCAR FIP - IF(IGET(450).GT.0 .or. IGET(480).GT.0)THEN + IF(IGET(450)>0 .or. IGET(480)>0)THEN ! cape and cin ITYPE = 1 @@ -3842,7 +3842,7 @@ SUBROUTINE MDLFLD ENDDO ! Chuang: Change to output isobaric NCAR icing ! do l=1,lm -! if(LVLS(L,IGET(450)).GT.0 .or. LVLS(L,IGET(480)).GT.0)then +! if(LVLS(L,IGET(450))>0 .or. LVLS(L,IGET(480))>0)then ! do j=jsta,jend ! do i=1,im ! grid1(i,j)=icing_gfip(i,j,l) diff --git a/sorc/ncep_post.fd/MISCLN.f b/sorc/ncep_post.fd/MISCLN.f index 86362b0d8..d57af3dde 100644 --- a/sorc/ncep_post.fd/MISCLN.f +++ b/sorc/ncep_post.fd/MISCLN.f @@ -369,10 +369,10 @@ SUBROUTINE MISCLN ! ! ***BLOCK 1: TROPOPAUSE P, Z, T, U, V, AND WIND SHEAR. ! - IF ((IGET(054).GT.0).OR.(IGET(055).GT.0).OR. & - (IGET(056).GT.0).OR.(IGET(057).GT.0).OR. & - (IGET(177).GT.0).OR. & - (IGET(058).GT.0).OR.(IGET(108).GT.0) ) THEN + IF ((IGET(054)>0).OR.(IGET(055)>0).OR. & + (IGET(056)>0).OR.(IGET(057)>0).OR. & + (IGET(177)>0).OR. & + (IGET(058)>0).OR.(IGET(108)>0) ) THEN ! Chuang: Use GFS algorithm per Iredell's and DiMego's decision on unification !$omp parallel do private(i,j) DO J=JSTA,JEND @@ -410,7 +410,7 @@ SUBROUTINE MISCLN ENDIF ! ICAO HEIGHT OF TROPOPAUSE - IF (IGET(399).GT.0) THEN + IF (IGET(399)>0) THEN CALL ICAOHEIGHT(P1D, GRID1(1,jsta)) ! print*,'sample TROPOPAUSE ICAO HEIGHTS',GRID1(im/2,(jsta+jend)/2) if(grib=='grib2') then @@ -494,7 +494,7 @@ SUBROUTINE MISCLN ENDDO ENDDO if(grib=='grib2') then - if(IGET(056).GT.0) then + if(IGET(056)>0) then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(056)) !$omp parallel do private(i,j,jj) @@ -505,7 +505,7 @@ SUBROUTINE MISCLN enddo enddo endif - if(IGET(057).GT.0) then + if(IGET(057)>0) then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(057)) !$omp parallel do private(i,j,jj) @@ -545,8 +545,8 @@ SUBROUTINE MISCLN ! ***BLOCK 2: MAX WIND LEVEL P, Z, U, AND V ! ! MAX WIND LEVEL CALCULATIONS - IF ((IGET(173).GT.0) .OR. (IGET(174).GT.0) .OR. & - (IGET(175).GT.0) .OR. (IGET(176).GT.0)) THEN + IF ((IGET(173)>0) .OR. (IGET(174)>0) .OR. & + (IGET(175)>0) .OR. (IGET(176)>0)) THEN allocate(MAXWP(IM,jsta:jend), MAXWZ(IM,jsta:jend), & MAXWU(IM,jsta:jend), MAXWV(IM,jsta:jend),MAXWT(IM,jsta:jend)) @@ -587,7 +587,7 @@ SUBROUTINE MISCLN endif ENDIF ! ICAO HEIGHT OF MAX WIND LEVEL - IF (IGET(398).GT.0) THEN + IF (IGET(398)>0) THEN CALL ICAOHEIGHT(MAXWP, GRID1(1,jsta)) ! print*,'sample MAX WIND ICAO HEIGHTS',GRID1(im/2,(jsta+jend)/2) if(grib=='grib2') then @@ -679,12 +679,12 @@ SUBROUTINE MISCLN ! ! ***BLOCK 3-1: FD LEVEL (selected) T, Q, U, AND V. ! - IF ( (IGET(059).GT.0.or.IGET(586)>0).OR.IGET(911)>0.OR. & - (IGET(060).GT.0.or.IGET(576)>0).OR. & - (IGET(061).GT.0.or.IGET(577)>0).OR. & - (IGET(601).GT.0.or.IGET(602)>0.or.IGET(603)>0).OR. & - (IGET(604).GT.0.or.IGET(605)>0).OR. & - (IGET(451).GT.0.or.IGET(578)>0).OR.IGET(580).GT.0 ) THEN + IF ( (IGET(059)>0.or.IGET(586)>0).OR.IGET(911)>0.OR. & + (IGET(060)>0.or.IGET(576)>0).OR. & + (IGET(061)>0.or.IGET(577)>0).OR. & + (IGET(601)>0.or.IGET(602)>0.or.IGET(603)>0).OR. & + (IGET(604)>0.or.IGET(605)>0).OR. & + (IGET(451)>0.or.IGET(578)>0).OR.IGET(580)>0 ) THEN ALLOCATE(T7D(IM,JSTA:JEND,NFD), Q7D(IM,JSTA:JEND,NFD), & U7D(IM,JSTA:JEND,NFD), V6D(IM,JSTA:JEND,NFD), & @@ -696,56 +696,56 @@ SUBROUTINE MISCLN ! ITYPEFDLVL=1 DO IFD = 1,NFD - IF (IGET(059).GT.0) THEN - IF (LVLS(IFD,IGET(059)).GT.1) ITYPEFDLVL(IFD)=2 + IF (IGET(059)>0) THEN + IF (LVLS(IFD,IGET(059))>1) ITYPEFDLVL(IFD)=2 ENDIF - IF (IGET(911).GT.0) THEN - IF (LVLS(IFD,IGET(911)).GT.1) ITYPEFDLVL(IFD)=2 + IF (IGET(911)>0) THEN + IF (LVLS(IFD,IGET(911))>1) ITYPEFDLVL(IFD)=2 ENDIF !for grib2, spec hgt only - IF (IGET(586).GT.0) THEN + IF (IGET(586)>0) THEN IF(LVLS(IFD,IGET(586))>0) ITYPEFDLVL(IFD)=2 ENDIF - IF (IGET(060).GT.0) THEN - IF (LVLS(IFD,IGET(060)).GT.1) ITYPEFDLVL(IFD)=2 + IF (IGET(060)>0) THEN + IF (LVLS(IFD,IGET(060))>1) ITYPEFDLVL(IFD)=2 ENDIF - IF (IGET(576).GT.0) THEN + IF (IGET(576)>0) THEN IF(LVLS(IFD,IGET(576))>0) ITYPEFDLVL(IFD)=2 ENDIF - IF (IGET(061).GT.0) THEN - IF (LVLS(IFD,IGET(061)).GT.1) ITYPEFDLVL(IFD)=2 + IF (IGET(061)>0) THEN + IF (LVLS(IFD,IGET(061))>1) ITYPEFDLVL(IFD)=2 ENDIF - IF (IGET(577).GT.0) then + IF (IGET(577)>0) then if(LVLS(IFD,IGET(577))>0) ITYPEFDLVL(IFD)=2 ENDIF - IF (IGET(451).GT.0) THEN - IF (LVLS(IFD,IGET(451)).GT.1) ITYPEFDLVL(IFD)=2 + IF (IGET(451)>0) THEN + IF (LVLS(IFD,IGET(451))>1) ITYPEFDLVL(IFD)=2 ENDIF - IF (IGET(578).GT.0) then + IF (IGET(578)>0) then if(LVLS(IFD,IGET(578))>0) ITYPEFDLVL(IFD)=2 ENDIF - IF (IGET(580).GT.0) then + IF (IGET(580)>0) then if(LVLS(IFD,IGET(580))>1) ITYPEFDLVL(IFD)=2 ENDIF - IF (IGET(587).GT.0) then + IF (IGET(587)>0) then if(LVLS(IFD,IGET(587))>0) ITYPEFDLVL(IFD)=2 ENDIF - IF (IGET(601).GT.0) THEN - IF (LVLS(IFD,IGET(601)).GT.1) ITYPEFDLVL(IFD)=2 + IF (IGET(601)>0) THEN + IF (LVLS(IFD,IGET(601))>1) ITYPEFDLVL(IFD)=2 ENDIF - IF (IGET(602).GT.0) THEN - IF (LVLS(IFD,IGET(602)).GT.1) ITYPEFDLVL(IFD)=2 + IF (IGET(602)>0) THEN + IF (LVLS(IFD,IGET(602))>1) ITYPEFDLVL(IFD)=2 ENDIF - IF (IGET(603).GT.0) THEN - IF (LVLS(IFD,IGET(603)).GT.1) ITYPEFDLVL(IFD)=2 + IF (IGET(603)>0) THEN + IF (LVLS(IFD,IGET(603))>1) ITYPEFDLVL(IFD)=2 ENDIF - IF (IGET(604).GT.0) THEN - IF (LVLS(IFD,IGET(604)).GT.1) ITYPEFDLVL(IFD)=2 + IF (IGET(604)>0) THEN + IF (LVLS(IFD,IGET(604))>1) ITYPEFDLVL(IFD)=2 ENDIF - IF (IGET(605).GT.0) THEN - IF (LVLS(IFD,IGET(605)).GT.1) ITYPEFDLVL(IFD)=2 + IF (IGET(605)>0) THEN + IF (LVLS(IFD,IGET(605))>1) ITYPEFDLVL(IFD)=2 ENDIF ENDDO @@ -810,8 +810,8 @@ SUBROUTINE MISCLN ENDIF ! FD LEVEL VIRTUAL TEMPERATURE. - IF (IGET(911).GT.0) THEN - IF (LVLS(IFD,IGET(911)).GT.0) THEN + IF (IGET(911)>0) THEN + IF (LVLS(IFD,IGET(911))>0) THEN DO J=JSTA,JEND DO I=1,IM if ( T7D(I,J,IFD) > 600 ) then @@ -822,7 +822,7 @@ SUBROUTINE MISCLN !print *, "grid value ",T7D(I,J,IFD),Q7D(I,J,IFD),T7D(I,J,IFD)*(1.+0.608*Q7D(I,J,IFD)),GRID1(I,J) ENDDO ENDDO - IF(LVLS(IFD,IGET(911)).GT.0) then + IF(LVLS(IFD,IGET(911))>0) then if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(911)) @@ -992,8 +992,8 @@ SUBROUTINE MISCLN ENDIF ! ! ADD FD LEVEL DUST/ASH (GOCART) - IF (IGET(601).GT.0) THEN ! DUST 1 - IF (LVLS(IFD,IGET(601)).GT.0) THEN + IF (IGET(601)>0) THEN ! DUST 1 + IF (LVLS(IFD,IGET(601))>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -1017,8 +1017,8 @@ SUBROUTINE MISCLN ENDIF ENDIF - IF (IGET(602).GT.0) THEN ! DUST 2 - IF (LVLS(IFD,IGET(602)).GT.0) THEN + IF (IGET(602)>0) THEN ! DUST 2 + IF (LVLS(IFD,IGET(602))>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -1042,8 +1042,8 @@ SUBROUTINE MISCLN ENDIF ENDIF - IF (IGET(603).GT.0) THEN ! DUST 3 - IF (LVLS(IFD,IGET(603)).GT.0) THEN + IF (IGET(603)>0) THEN ! DUST 3 + IF (LVLS(IFD,IGET(603))>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -1067,8 +1067,8 @@ SUBROUTINE MISCLN ENDIF ENDIF - IF (IGET(604).GT.0) THEN ! DUST 4 - IF (LVLS(IFD,IGET(604)).GT.0) THEN + IF (IGET(604)>0) THEN ! DUST 4 + IF (LVLS(IFD,IGET(604))>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -1092,8 +1092,8 @@ SUBROUTINE MISCLN ENDIF ENDIF - IF (IGET(605).GT.0) THEN ! DUST 5 - IF (LVLS(IFD,IGET(605)).GT.0) THEN + IF (IGET(605)>0) THEN ! DUST 5 + IF (LVLS(IFD,IGET(605))>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -1120,7 +1120,7 @@ SUBROUTINE MISCLN ! ! ! FD LEVEL U WIND AND/OR V WIND. - IF ((IGET(060).GT.0).OR.(IGET(061).GT.0)) THEN + IF ((IGET(060)>0).OR.(IGET(061)>0)) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -1128,8 +1128,8 @@ SUBROUTINE MISCLN GRID2(I,J)=V6D(I,J,IFD) ENDDO ENDDO - IF (IGET(060).GT.0) THEN - IF (LVLS(IFD,IGET(060)).GT.0) then + IF (IGET(060)>0) THEN + IF (LVLS(IFD,IGET(060))>0) then if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(060)) @@ -1144,8 +1144,8 @@ SUBROUTINE MISCLN endif ENDIF ENDIF - IF (IGET(061).GT.0) THEN - IF (LVLS(IFD,IGET(061)).GT.0) THEN + IF (IGET(061)>0) THEN + IF (LVLS(IFD,IGET(061))>0) THEN if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(061)) @@ -1163,7 +1163,7 @@ SUBROUTINE MISCLN ENDIF ! ! FD LEVEL U WIND AND/OR V WIND. - IF ((IGET(576).GT.0).OR.(IGET(577).GT.0)) THEN + IF ((IGET(576)>0).OR.(IGET(577)>0)) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -1171,8 +1171,8 @@ SUBROUTINE MISCLN GRID2(I,J) = V6D(I,J,IFD) ENDDO ENDDO - IF (IGET(576).GT.0) THEN - IF (LVLS(IFD,IGET(576)).GT.0) then + IF (IGET(576)>0) THEN + IF (LVLS(IFD,IGET(576))>0) then if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(576)) @@ -1187,8 +1187,8 @@ SUBROUTINE MISCLN endif ENDIF ENDIF - IF (IGET(577).GT.0) THEN - IF (LVLS(IFD,IGET(577)).GT.0) THEN + IF (IGET(577)>0) THEN + IF (LVLS(IFD,IGET(577))>0) THEN if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(577)) @@ -1212,7 +1212,7 @@ SUBROUTINE MISCLN ! ! ***BLOCK 3-2: FD LEVEL (from control file) GTG ! - IF(IGET(467).GT.0.or.IGET(468)>0.or.IGET(469).GT.0) THEN + IF(IGET(467)>0.or.IGET(468)>0.or.IGET(469)>0) THEN if(IGET(467)>0) THEN ! GTG N=IAVBLFLD(IGET(467)) NFDCTL=size(pset%param(N)%level) @@ -1229,7 +1229,7 @@ SUBROUTINE MISCLN call FDLVL_MASS(ITYPEFDLVLCTL,NFDCTL,HTFDCTL,GTG,GTGFD) ! print *, "GTG 467 Done GTGFD=",me,GTGFD(IM/2,jend,1:NFDCTL) DO IFD = 1,NFDCTL - IF (LVLS(IFD,IGET(467)).GT.0) THEN + IF (LVLS(IFD,IGET(467))>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -1266,7 +1266,7 @@ SUBROUTINE MISCLN allocate(CATFD(IM,JSTA:JEND,NFDCTL)) call FDLVL_MASS(ITYPEFDLVLCTL,NFDCTL,HTFDCTL,catedr,CATFD) DO IFD = 1,NFDCTL - IF (LVLS(IFD,IGET(468)).GT.0) THEN + IF (LVLS(IFD,IGET(468))>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -1303,7 +1303,7 @@ SUBROUTINE MISCLN allocate(MWTFD(IM,JSTA:JEND,NFDCTL)) call FDLVL_MASS(ITYPEFDLVLCTL,NFDCTL,HTFDCTL,MWT,MWTFD) DO IFD = 1,NFDCTL - IF (LVLS(IFD,IGET(469)).GT.0) THEN + IF (LVLS(IFD,IGET(469))>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -1338,11 +1338,11 @@ SUBROUTINE MISCLN ! ! ***BLOCK 4: FREEZING LEVEL Z, RH AND P. ! - IF ( (IGET(062).GT.0).OR.(IGET(063).GT.0) ) THEN + IF ( (IGET(062)>0).OR.(IGET(063)>0) ) THEN CALL FRZLVL(Z1D,RH1D,P1D) ! ! FREEZING LEVEL HEIGHT. - IF (IGET(062).GT.0) THEN + IF (IGET(062)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -1364,7 +1364,7 @@ SUBROUTINE MISCLN ENDIF ! ! FREEZING LEVEL RELATIVE HUMIDITY. - IF (IGET(063).GT.0) THEN + IF (IGET(063)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -1387,7 +1387,7 @@ SUBROUTINE MISCLN ENDIF ! ! FREEZING LEVEL PRESSURE - IF (IGET(753).GT.0) THEN + IF (IGET(753)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -1409,11 +1409,11 @@ SUBROUTINE MISCLN ENDIF ENDIF - IF (IGET(165).GT.0 .OR. IGET(350).GT.0.OR. IGET(756).GT.0) THEN + IF (IGET(165)>0 .OR. IGET(350)>0.OR. IGET(756)>0) THEN CALL FRZLVL2(TFRZ,Z1D,RH1D,P1D) ! ! HIGHEST FREEZING LEVEL HEIGHT. - IF (IGET(165).GT.0)THEN + IF (IGET(165)>0)THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -1435,7 +1435,7 @@ SUBROUTINE MISCLN END IF ! HIGHEST FREEZING LEVEL RELATIVE HUMIDITY - IF (IGET(350).GT.0)THEN + IF (IGET(350)>0)THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -1457,7 +1457,7 @@ SUBROUTINE MISCLN END IF ! HIGHEST FREEZING LEVEL PRESSURE - IF (IGET(756).GT.0) THEN + IF (IGET(756)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -1481,11 +1481,11 @@ SUBROUTINE MISCLN ! ! HIGHEST -10 C ISOTHERM VALUES ! - IF (IGET(776).GT.0 .OR. IGET(777).GT.0.OR. IGET(778).GT.0) THEN + IF (IGET(776)>0 .OR. IGET(777)>0.OR. IGET(778)>0) THEN CALL FRZLVL2(263.15,Z1D,RH1D,P1D) ! ! HIGHEST -10C ISOTHERM LEVEL HEIGHT. - IF (IGET(776).GT.0)THEN + IF (IGET(776)>0)THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -1507,7 +1507,7 @@ SUBROUTINE MISCLN END IF ! HIGHEST -10C ISOTHERM RELATIVE HUMIDITY - IF (IGET(777).GT.0)THEN + IF (IGET(777)>0)THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -1529,7 +1529,7 @@ SUBROUTINE MISCLN END IF ! HIGHEST -10C ISOTHERM LEVEL PRESSURE - IF (IGET(778).GT.0) THEN + IF (IGET(778)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -1553,11 +1553,11 @@ SUBROUTINE MISCLN ! ! HIGHEST -20 C ISOTHERM VALUES ! - IF (IGET(779).GT.0 .OR. IGET(780).GT.0.OR. IGET(781).GT.0) THEN + IF (IGET(779)>0 .OR. IGET(780)>0.OR. IGET(781)>0) THEN CALL FRZLVL2(253.15,Z1D,RH1D,P1D) ! ! HIGHEST -20C ISOTHERM LEVEL HEIGHT. - IF (IGET(779).GT.0)THEN + IF (IGET(779)>0)THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -1579,7 +1579,7 @@ SUBROUTINE MISCLN END IF ! HIGHEST -20C ISOTHERM RELATIVE HUMIDITY - IF (IGET(780).GT.0)THEN + IF (IGET(780)>0)THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -1601,7 +1601,7 @@ SUBROUTINE MISCLN END IF ! HIGHEST -20C ISOTHERM LEVEL PRESSURE - IF (IGET(781).GT.0) THEN + IF (IGET(781)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -1631,20 +1631,20 @@ SUBROUTINE MISCLN ! ! ***BLOCK 5: BOUNDARY LAYER FIELDS. ! - IF ( (IGET(067).GT.0).OR.(IGET(068).GT.0).OR. & - (IGET(069).GT.0).OR.(IGET(070).GT.0).OR. & - (IGET(071).GT.0).OR.(IGET(072).GT.0).OR. & - (IGET(073).GT.0).OR.(IGET(074).GT.0).OR. & - (IGET(088).GT.0).OR.(IGET(089).GT.0).OR. & - (IGET(090).GT.0).OR.(IGET(075).GT.0).OR. & - (IGET(109).GT.0).OR.(IGET(110).GT.0).OR. & - (IGET(031).GT.0).OR.(IGET(032).GT.0).OR. & - (IGET(573).GT.0).OR. & - (IGET(107).GT.0).OR.(IGET(091).GT.0).OR. & - (IGET(092).GT.0).OR.(IGET(093).GT.0).OR. & - (IGET(094).GT.0).OR.(IGET(095).GT.0).OR. & - (IGET(096).GT.0).OR.(IGET(097).GT.0).OR. & - (IGET(098).GT.0).OR.(IGET(221).GT.0) ) THEN + IF ( (IGET(067)>0).OR.(IGET(068)>0).OR. & + (IGET(069)>0).OR.(IGET(070)>0).OR. & + (IGET(071)>0).OR.(IGET(072)>0).OR. & + (IGET(073)>0).OR.(IGET(074)>0).OR. & + (IGET(088)>0).OR.(IGET(089)>0).OR. & + (IGET(090)>0).OR.(IGET(075)>0).OR. & + (IGET(109)>0).OR.(IGET(110)>0).OR. & + (IGET(031)>0).OR.(IGET(032)>0).OR. & + (IGET(573)>0).OR. & + (IGET(107)>0).OR.(IGET(091)>0).OR. & + (IGET(092)>0).OR.(IGET(093)>0).OR. & + (IGET(094)>0).OR.(IGET(095)>0).OR. & + (IGET(096)>0).OR.(IGET(097)>0).OR. & + (IGET(098)>0).OR.(IGET(221)>0) ) THEN ! allocate(OMGBND(IM,jsta:jend,NBND),PWTBND(IM,jsta:jend,NBND), & QCNVBND(IM,jsta:jend,NBND),LVLBND(IM,jsta:jend,NBND), & @@ -1666,8 +1666,8 @@ SUBROUTINE MISCLN DO 20 LBND = 1,NBND ! ! BOUNDARY LAYER PRESSURE. - IF (IGET(067).GT.0) THEN - IF (LVLS(LBND,IGET(067)).GT.0) THEN + IF (IGET(067)>0) THEN + IF (LVLS(LBND,IGET(067))>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -1690,8 +1690,8 @@ SUBROUTINE MISCLN ENDIF ! ! BOUNDARY LAYER TEMPERATURE. - IF (IGET(068).GT.0) THEN - IF (LVLS(LBND,IGET(068)).GT.0) THEN + IF (IGET(068)>0) THEN + IF (LVLS(LBND,IGET(068))>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -1714,8 +1714,8 @@ SUBROUTINE MISCLN ENDIF ! ! BOUNDARY LAYER POTENTIAL TEMPERATURE. - IF (IGET(069).GT.0) THEN - IF (LVLS(LBND,IGET(069)).GT.0) THEN + IF (IGET(069)>0) THEN + IF (LVLS(LBND,IGET(069))>0) THEN CALL CALPOT(PBND(1,jsta,LBND),TBND(1,jsta,LBND),GRID1(1,jsta)) if(grib=='grib2') then cfld=cfld+1 @@ -1733,8 +1733,8 @@ SUBROUTINE MISCLN ENDIF ! ! BOUNDARY LAYER RELATIVE HUMIDITY. - IF (IGET(072).GT.0) THEN - IF (LVLS(LBND,IGET(072)).GT.0) THEN + IF (IGET(072)>0) THEN + IF (LVLS(LBND,IGET(072))>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -1759,8 +1759,8 @@ SUBROUTINE MISCLN ENDIF ! ! BOUNDARY LAYER DEWPOINT TEMPERATURE. - IF (IGET(070).GT.0) THEN - IF (LVLS(LBND,IGET(070)).GT.0) THEN + IF (IGET(070)>0) THEN + IF (LVLS(LBND,IGET(070))>0) THEN CALL CALDWP(PBND(1,jsta,LBND), QBND(1,jsta,LBND), & GRID1(1,jsta), TBND(1,jsta,LBND)) if(grib=='grib2') then @@ -1779,8 +1779,8 @@ SUBROUTINE MISCLN ENDIF ! ! BOUNDARY LAYER SPECIFIC HUMIDITY. - IF (IGET(071).GT.0) THEN - IF (LVLS(LBND,IGET(071)).GT.0) THEN + IF (IGET(071)>0) THEN + IF (LVLS(LBND,IGET(071))>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -1804,8 +1804,8 @@ SUBROUTINE MISCLN ENDIF ! ! BOUNDARY LAYER MOISTURE CONVERGENCE. - IF (IGET(088).GT.0) THEN - IF (LVLS(LBND,IGET(088)).GT.0) THEN + IF (IGET(088)>0) THEN + IF (LVLS(LBND,IGET(088))>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -1832,11 +1832,11 @@ SUBROUTINE MISCLN FIELD1=.FALSE. FIELD2=.FALSE. ! - IF(IGET(073).GT.0)THEN - IF(LVLS(LBND,IGET(073)).GT.0)FIELD1=.TRUE. + IF(IGET(073)>0)THEN + IF(LVLS(LBND,IGET(073))>0)FIELD1=.TRUE. ENDIF - IF(IGET(074).GT.0)THEN - IF(LVLS(LBND,IGET(074)).GT.0)FIELD2=.TRUE. + IF(IGET(074)>0)THEN + IF(LVLS(LBND,IGET(074))>0)FIELD2=.TRUE. ENDIF ! IF(FIELD1.OR.FIELD2)THEN @@ -1848,8 +1848,8 @@ SUBROUTINE MISCLN ENDDO ENDDO ! - IF (IGET(073).GT.0) THEN - IF (LVLS(LBND,IGET(073)).GT.0) then + IF (IGET(073)>0) THEN + IF (LVLS(LBND,IGET(073))>0) then if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(073)) @@ -1864,8 +1864,8 @@ SUBROUTINE MISCLN endif ENDIF ENDIF - IF (IGET(074).GT.0) THEN - IF (LVLS(LBND,IGET(074)).GT.0) THEN + IF (IGET(074)>0) THEN + IF (LVLS(LBND,IGET(074))>0) THEN if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(074)) @@ -1883,8 +1883,8 @@ SUBROUTINE MISCLN ENDIF ! ! BOUNDARY LAYER OMEGA. - IF (IGET(090).GT.0) THEN - IF (LVLS(LBND,IGET(090)).GT.0) THEN + IF (IGET(090)>0) THEN + IF (LVLS(LBND,IGET(090))>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -1907,8 +1907,8 @@ SUBROUTINE MISCLN ENDIF ! ! BOUNDARY LAYER PRECIPITBLE WATER. - IF (IGET(089).GT.0) THEN - IF (LVLS(LBND,IGET(089)).GT.0) THEN + IF (IGET(089)>0) THEN + IF (LVLS(LBND,IGET(089))>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -1932,11 +1932,11 @@ SUBROUTINE MISCLN ENDIF ! ! BOUNDARY LAYER LIFTED INDEX. - IF (IGET(075).GT.0 .OR. IGET(031)>0 .OR. IGET(573)>0) THEN + IF (IGET(075)>0 .OR. IGET(031)>0 .OR. IGET(573)>0) THEN CALL OTLFT(PBND(1,jsta,LBND),TBND(1,jsta,LBND), & QBND(1,jsta,LBND),GRID1(1,jsta)) IF(IGET(075)>0)THEN - IF (LVLS(LBND,IGET(075)).GT.0) THEN + IF (LVLS(LBND,IGET(075))>0) THEN if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(075)) @@ -2021,17 +2021,17 @@ SUBROUTINE MISCLN FIELD1=.FALSE. FIELD2=.FALSE. ! - IF(IGET(032).GT.0)THEN - IF(LVLS(2,IGET(032)).GT.0)FIELD1=.TRUE. + IF(IGET(032)>0)THEN + IF(LVLS(2,IGET(032))>0)FIELD1=.TRUE. ENDIF - IF(IGET(107).GT.0)THEN - IF(LVLS(2,IGET(107)).GT.0)FIELD2=.TRUE. + IF(IGET(107)>0)THEN + IF(LVLS(2,IGET(107))>0)FIELD2=.TRUE. ENDIF ! - IF(IGET(566).GT.0)THEN + IF(IGET(566)>0)THEN FIELD1=.TRUE. ENDIF - IF(IGET(567).GT.0)THEN + IF(IGET(567)>0)THEN FIELD2=.TRUE. ENDIF ! @@ -2154,10 +2154,10 @@ SUBROUTINE MISCLN ! BOUNDARY LAYER LIFTING CONDENSATION PRESSURE AND HEIGHT. ! EGRID1 IS LCL PRESSURE. EGRID2 IS LCL HEIGHT. ! - IF ( (IGET(109).GT.0).OR.(IGET(110).GT.0) ) THEN + IF ( (IGET(109)>0).OR.(IGET(110)>0) ) THEN CALL CALLCL(PBND(1,jsta,1),TBND(1,jsta,1), & QBND(1,jsta,1),EGRID1,EGRID2) - IF (IGET(109).GT.0) THEN + IF (IGET(109)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -2176,7 +2176,7 @@ SUBROUTINE MISCLN enddo endif ENDIF - IF (IGET(110).GT.0) THEN + IF (IGET(110)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -2199,18 +2199,18 @@ SUBROUTINE MISCLN ! ! NGM BOUNDARY LAYER FIELDS. ! - IF ( (IGET(091).GT.0).OR.(IGET(092).GT.0).OR. & - (IGET(093).GT.0).OR.(IGET(094).GT.0).OR. & - (IGET(095).GT.0).OR.(IGET(095).GT.0).OR. & - (IGET(096).GT.0).OR.(IGET(097).GT.0).OR. & - (IGET(098).GT.0) ) THEN + IF ( (IGET(091)>0).OR.(IGET(092)>0).OR. & + (IGET(093)>0).OR.(IGET(094)>0).OR. & + (IGET(095)>0).OR.(IGET(095)>0).OR. & + (IGET(096)>0).OR.(IGET(097)>0).OR. & + (IGET(098)>0) ) THEN allocate(T78483(im,jsta:jend), T89671(im,jsta:jend), & P78483(im,jsta:jend), P89671(im,jsta:jend)) ! ! COMPUTE SIGMA 0.89671 AND 0.78483 TEMPERATURES ! INTERPOLATE LINEAR IN LOG P - IF (IGET(097).GT.0.OR.IGET(098).GT.0) THEN + IF (IGET(097)>0.OR.IGET(098)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -2239,7 +2239,7 @@ SUBROUTINE MISCLN FAC2 = (P89671(I,J)-PKU1)/(PKL1-PKU1) T89671(I,J) = T(I,J,L)*FAC2 + T(I,J,L-1)*FAC1 DONE(I,J) = .TRUE. -! IF(I.EQ.1 .AND. J.EQ.1)PRINT*,'done(1,1)= ',done(1,1) +! IF(I==1 .AND. J==1)PRINT*,'done(1,1)= ',done(1,1) ENDIF ENDDO ENDDO @@ -2291,12 +2291,12 @@ SUBROUTINE MISCLN ! RHL = QL/QSAT ! - IF(RHL.GT.1.)THEN + IF(RHL>1.)THEN RHL = 1. QL = RHL*QSAT ENDIF ! - IF(RHL.LT.RHmin)THEN + IF(RHL350.)PRINT*,'LARGE T89671 ', & ! I,J,T89671(I,J) ENDDO ENDDO @@ -2337,7 +2337,7 @@ SUBROUTINE MISCLN ENDIF ! ! SIGMA 0.78483 TEMPERATURE - IF (IGET(098).GT.0) THEN + IF (IGET(098)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -2364,14 +2364,14 @@ SUBROUTINE MISCLN ! THE FIRST ETA LAYER BOUNDARY LAYER FIELDS. ! ! - IF ( (IGET(091).GT.0).OR.(IGET(092).GT.0).OR. & - (IGET(093).GT.0).OR.(IGET(094).GT.0).OR. & - (IGET(095).GT.0).OR.(IGET(095).GT.0).OR. & - (IGET(096).GT.0) ) THEN + IF ( (IGET(091)>0).OR.(IGET(092)>0).OR. & + (IGET(093)>0).OR.(IGET(094)>0).OR. & + (IGET(095)>0).OR.(IGET(095)>0).OR. & + (IGET(096)>0) ) THEN ! ! ! PRESSURE. - IF (IGET(091).GT.0) THEN + IF (IGET(091)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -2392,7 +2392,7 @@ SUBROUTINE MISCLN ENDIF ! ! TEMPERATURE. - IF (IGET(092).GT.0) THEN + IF (IGET(092)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -2414,7 +2414,7 @@ SUBROUTINE MISCLN ENDIF ! ! SPECIFIC HUMIDITY. - IF (IGET(093).GT.0) THEN + IF (IGET(093)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -2437,7 +2437,7 @@ SUBROUTINE MISCLN ENDIF ! ! RELATIVE HUMIDITY. - IF (IGET(094).GT.0) THEN + IF (IGET(094)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -2461,7 +2461,7 @@ SUBROUTINE MISCLN ENDIF ! ! U AND/OR V WIND. - IF ((IGET(095).GT.0).OR.(IGET(096).GT.0)) THEN + IF ((IGET(095)>0).OR.(IGET(096)>0)) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -2469,7 +2469,7 @@ SUBROUTINE MISCLN GRID2(I,J) = VBND(I,J,1) ENDDO ENDDO - IF (IGET(095).GT.0) then + IF (IGET(095)>0) then if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(095)) @@ -2483,7 +2483,7 @@ SUBROUTINE MISCLN enddo endif ENDIF - IF (IGET(096).GT.0) then + IF (IGET(096)>0) then if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(096)) @@ -2508,22 +2508,22 @@ SUBROUTINE MISCLN ! ! ***BLOCK 6: MISCELLANEOUS LAYER MEAN LFM AND NGM FIELDS. ! - IF ( (IGET(066).GT.0).OR.(IGET(081).GT.0).OR. & - (IGET(082).GT.0).OR.(IGET(104).GT.0).OR. & - (IGET(099).GT.0).OR.(IGET(100).GT.0).OR. & - (IGET(101).GT.0).OR.(IGET(102).GT.0).OR. & - (IGET(103).GT.0) ) THEN + IF ( (IGET(066)>0).OR.(IGET(081)>0).OR. & + (IGET(082)>0).OR.(IGET(104)>0).OR. & + (IGET(099)>0).OR.(IGET(100)>0).OR. & + (IGET(101)>0).OR.(IGET(102)>0).OR. & + (IGET(103)>0) ) THEN ! ! LFM "MEAN" RELATIVE HUMIDITIES AND PRECIPITABLE WATER. ! - IF ( (IGET(066).GT.0).OR.(IGET(081).GT.0).OR. & - (IGET(082).GT.0).OR.(IGET(104).GT.0) ) THEN + IF ( (IGET(066)>0).OR.(IGET(081)>0).OR. & + (IGET(082)>0).OR.(IGET(104)>0) ) THEN allocate(RH3310(IM,jsta:jend),RH6610(IM,jsta:jend), & RH3366(IM,jsta:jend),PW3310(IM,jsta:jend)) CALL LFMFLD(RH3310,RH6610,RH3366,PW3310) ! ! SIGMA 0.33-1.00 MEAN RELATIVE HUMIIDITY. - IF (IGET(066).GT.0) THEN + IF (IGET(066)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -2549,7 +2549,7 @@ SUBROUTINE MISCLN ENDIF ! ! SIGMA 0.66-1.00 MEAN RELATIVE HUMIIDITY. - IF (IGET(081).GT.0) THEN + IF (IGET(081)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -2573,7 +2573,7 @@ SUBROUTINE MISCLN ENDIF ! ! SIGMA 0.33-0.66 MEAN RELATIVE HUMIIDITY. - IF (IGET(082).GT.0) THEN + IF (IGET(082)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -2597,7 +2597,7 @@ SUBROUTINE MISCLN ENDIF ! ! SIGMA 0.33-1.00 PRECIPITABLE WATER. - IF (IGET(104).GT.0) THEN + IF (IGET(104)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -2623,9 +2623,9 @@ SUBROUTINE MISCLN ! ! VARIOUS LAYER MEAN NGM SIGMA FIELDS. ! - IF ( (IGET(099).GT.0).OR.(IGET(100).GT.0).OR. & - (IGET(101).GT.0).OR.(IGET(102).GT.0).OR. & - (IGET(103).GT.0) ) THEN + IF ( (IGET(099)>0).OR.(IGET(100)>0).OR. & + (IGET(101)>0).OR.(IGET(102)>0).OR. & + (IGET(103)>0) ) THEN allocate(RH4710(IM,jsta_2l:jend_2u),RH4796(IM,jsta_2l:jend_2u), & RH1847(IM,jsta_2l:jend_2u)) allocate(RH8498(IM,jsta_2l:jend_2u),QM8510(IM,jsta_2l:jend_2u)) @@ -2633,7 +2633,7 @@ SUBROUTINE MISCLN CALL NGMFLD(RH4710,RH4796,RH1847,RH8498,QM8510) ! ! SIGMA 0.47191-1.00000 RELATIVE HUMIDITY. - IF (IGET(099).GT.0) THEN + IF (IGET(099)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -2657,7 +2657,7 @@ SUBROUTINE MISCLN ENDIF ! ! SIGMA 0.47191-0.96470 RELATIVE HUMIDITY. - IF (IGET(100).GT.0) THEN + IF (IGET(100)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -2681,7 +2681,7 @@ SUBROUTINE MISCLN ENDIF ! ! SIGMA 0.18019-0.47191 RELATIVE HUMIDITY. - IF (IGET(101).GT.0) THEN + IF (IGET(101)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -2705,7 +2705,7 @@ SUBROUTINE MISCLN ENDIF ! ! SIGMA 0.84368-0.98230 RELATIVE HUMIDITY. - IF (IGET(102).GT.0) THEN + IF (IGET(102)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -2729,7 +2729,7 @@ SUBROUTINE MISCLN ENDIF ! ! SIGMA 0.85000-1.00000 MOISTURE CONVERGENCE. - IF (IGET(103).GT.0) THEN + IF (IGET(103)>0) THEN ! CONVERT TO DIVERGENCE FOR GRIB !$omp parallel do private(i,j) DO J=JSTA,JEND @@ -2755,14 +2755,14 @@ SUBROUTINE MISCLN ENDIF ENDIF - IF ( (IGET(318).GT.0).OR.(IGET(319).GT.0).OR. & - (IGET(320).GT.0))THEN + IF ( (IGET(318)>0).OR.(IGET(319)>0).OR. & + (IGET(320)>0))THEN allocate(RH4410(IM,jsta:jend),RH7294(IM,jsta:jend), & RH4472(IM,jsta:jend),RH3310(IM,jsta:jend)) CALL LFMFLD_GFS(RH4410,RH7294,RH4472,RH3310) ! ! SIGMA 0.44-1.00 MEAN RELATIVE HUMIIDITY. - IF (IGET(318).GT.0) THEN + IF (IGET(318)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -2785,7 +2785,7 @@ SUBROUTINE MISCLN ENDIF ! ! SIGMA 0.72-0.94 MEAN RELATIVE HUMIIDITY. - IF (IGET(319).GT.0) THEN + IF (IGET(319)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -2808,7 +2808,7 @@ SUBROUTINE MISCLN ENDIF ! ! SIGMA 0.44-0.72 MEAN RELATIVE HUMIIDITY. - IF (IGET(320).GT.0) THEN + IF (IGET(320)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -2833,9 +2833,9 @@ SUBROUTINE MISCLN END IF ! GFS computes sigma=0.9950 T, THETA, U, V from lowest two model level fields - IF ( (IGET(321).GT.0).OR.(IGET(322).GT.0).OR. & - (IGET(323).GT.0).OR.(IGET(324).GT.0).OR. & - (IGET(325).GT.0).OR.(IGET(326).GT.0) ) THEN + IF ( (IGET(321)>0).OR.(IGET(322)>0).OR. & + (IGET(323)>0).OR.(IGET(324)>0).OR. & + (IGET(325)>0).OR.(IGET(326)>0) ) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -2855,7 +2855,7 @@ SUBROUTINE MISCLN END DO END DO ! Temperature - IF (IGET(321).GT.0) THEN + IF (IGET(321)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -2879,7 +2879,7 @@ SUBROUTINE MISCLN ! minval(GRID1(1:im,jsta:jend)),'grib=',grib ENDIF ! Potential Temperature - IF (IGET(322).GT.0) THEN + IF (IGET(322)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -2902,7 +2902,7 @@ SUBROUTINE MISCLN endif ENDIF ! RH - IF (IGET(323).GT.0) THEN + IF (IGET(323)>0) THEN !$omp parallel do private(i,j,es1,qs1,rh1,es2,qs2,rh2) DO J=JSTA,JEND DO I=1,IM @@ -2930,7 +2930,7 @@ SUBROUTINE MISCLN endif ENDIF ! U - IF (IGET(324).GT.0) THEN + IF (IGET(324)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -2952,7 +2952,7 @@ SUBROUTINE MISCLN endif ENDIF ! V - IF (IGET(325).GT.0) THEN + IF (IGET(325)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -2974,7 +2974,7 @@ SUBROUTINE MISCLN endif ENDIF ! OMGA - IF (IGET(326).GT.0) THEN + IF (IGET(326)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -3002,17 +3002,17 @@ SUBROUTINE MISCLN FIELD1=.FALSE. FIELD2=.FALSE. ! - IF(IGET(032).GT.0)THEN - IF(LVLS(3,IGET(032)).GT.0)FIELD1=.TRUE. + IF(IGET(032)>0)THEN + IF(LVLS(3,IGET(032))>0)FIELD1=.TRUE. ENDIF - IF(IGET(107).GT.0)THEN - IF(LVLS(3,IGET(107)).GT.0)FIELD2=.TRUE. + IF(IGET(107)>0)THEN + IF(LVLS(3,IGET(107))>0)FIELD2=.TRUE. ENDIF ! - IF(IGET(582).GT.0)THEN + IF(IGET(582)>0)THEN FIELD1=.TRUE. ENDIF - IF(IGET(583).GT.0)THEN + IF(IGET(583)>0)THEN FIELD2=.TRUE. ENDIF @@ -3102,9 +3102,9 @@ SUBROUTINE MISCLN ! MIXED LAYER LIFTING CONDENSATION PRESSURE AND HEIGHT. ! EGRID1 IS LCL PRESSURE. EGRID2 IS LCL HEIGHT. ! -! IF ( (IGET(109).GT.0).OR.(IGET(110).GT.0) ) THEN +! IF ( (IGET(109)>0).OR.(IGET(110)>0) ) THEN ! CALL CALLCL(P1D,T1D,Q1D,EGRID1,EGRID2) -! IF (IGET(109).GT.0) THEN +! IF (IGET(109)>0) THEN ! DO J=JSTA,JEND ! DO I=1,IM ! GRID1(I,J)=EGRID2(I,J) @@ -3117,7 +3117,7 @@ SUBROUTINE MISCLN ! X GRID1,IM,JM) ! ENDIF ! -! IF (IGET(110).GT.0) THEN +! IF (IGET(110)>0) THEN ! DO J=JSTA,JEND ! DO I=1,IM ! GRID1(I,J)=EGRID1(I,J) @@ -3136,18 +3136,18 @@ SUBROUTINE MISCLN FIELD1=.FALSE. FIELD2=.FALSE. ! - IF(IGET(032).GT.0)THEN - IF(LVLS(4,IGET(032)).GT.0)FIELD1=.TRUE. + IF(IGET(032)>0)THEN + IF(LVLS(4,IGET(032))>0)FIELD1=.TRUE. ENDIF - IF(IGET(107).GT.0)THEN - IF(LVLS(4,IGET(107)).GT.0)FIELD2=.TRUE. + IF(IGET(107)>0)THEN + IF(LVLS(4,IGET(107))>0)FIELD2=.TRUE. ENDIF ! - IF(IGET(584).GT.0)THEN + IF(IGET(584)>0)THEN FIELD1=.TRUE. ENDIF - IF(IGET(585).GT.0)THEN + IF(IGET(585)>0)THEN FIELD2=.TRUE. ENDIF ! @@ -3223,7 +3223,7 @@ SUBROUTINE MISCLN ENDIF ! EQUILLIBRIUM HEIGHT - IF (IGET(443).GT.0) THEN + IF (IGET(443)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -3246,7 +3246,7 @@ SUBROUTINE MISCLN ! PRESSURE OF LEVEL FROM WHICH 300 MB MOST UNSTABLE CAPE ! PARCEL WAS LIFTED (eq. PRESSURE OF LEVEL OF HIGHEST THETA-E) - IF (IGET(246).GT.0) THEN + IF (IGET(246)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -3271,7 +3271,7 @@ SUBROUTINE MISCLN ENDIF ! 246 ! GENERAL THUNDER PARAMETER ??? 458 ??? - IF (IGET(444).GT.0) THEN + IF (IGET(444)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -3305,17 +3305,17 @@ SUBROUTINE MISCLN FIELD1=.FALSE. FIELD2=.FALSE. ! - IF(IGET(032).GT.0)THEN - IF(LVLS(3,IGET(032)).GT.0)FIELD1=.TRUE. + IF(IGET(032)>0)THEN + IF(LVLS(3,IGET(032))>0)FIELD1=.TRUE. ENDIF - IF(IGET(107).GT.0)THEN - IF(LVLS(3,IGET(107)).GT.0)FIELD2=.TRUE. + IF(IGET(107)>0)THEN + IF(LVLS(3,IGET(107))>0)FIELD2=.TRUE. ENDIF ! - IF(IGET(950).GT.0)THEN + IF(IGET(950)>0)THEN FIELD1=.TRUE. ENDIF - IF(IGET(951).GT.0)THEN + IF(IGET(951)>0)THEN FIELD2=.TRUE. ENDIF ! @@ -3412,7 +3412,7 @@ SUBROUTINE MISCLN ! LFC HEIGHT - IF (IGET(952).GT.0) THEN + IF (IGET(952)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -3491,7 +3491,7 @@ SUBROUTINE MISCLN ! Critical Angle - IF (IGET(957).GT.0) THEN + IF (IGET(957)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -3517,7 +3517,7 @@ SUBROUTINE MISCLN ! Dendritic Layer Depth, -17C < T < -12C - IF (IGET(955).GT.0) THEN + IF (IGET(955)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -3541,7 +3541,7 @@ SUBROUTINE MISCLN ! Enhanced Stretching Potential - IF (IGET(956).GT.0) THEN + IF (IGET(956)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -3630,7 +3630,7 @@ SUBROUTINE MISCLN ! ! ! RELATIVE HUMIDITY WITH RESPECT TO PRECIPITABLE WATER - IF (IGET(749).GT.0) THEN + IF (IGET(749)>0) THEN CALL CALRH_PW(GRID1(1,jsta)) if(grib=='grib2') then cfld=cfld+1 diff --git a/sorc/ncep_post.fd/MPI_LAST.f b/sorc/ncep_post.fd/MPI_LAST.f index 356f1f7b3..c3b86a02f 100644 --- a/sorc/ncep_post.fd/MPI_LAST.f +++ b/sorc/ncep_post.fd/MPI_LAST.f @@ -39,8 +39,8 @@ SUBROUTINE MPI_LAST integer ierr DATA DONE / .TRUE. / ! - IF ( ME .EQ. 0 ) THEN - IF ( NUM_SERVERS .GT. 0 ) THEN + IF ( ME == 0 ) THEN + IF ( NUM_SERVERS > 0 ) THEN CALL MPI_SEND(DONE,1,MPI_LOGICAL,0,1,MPI_COMM_INTER,IERR) END IF END IF diff --git a/sorc/ncep_post.fd/MSFPS.f b/sorc/ncep_post.fd/MSFPS.f index d20805218..06b2bc63d 100644 --- a/sorc/ncep_post.fd/MSFPS.f +++ b/sorc/ncep_post.fd/MSFPS.f @@ -39,7 +39,7 @@ SUBROUTINE MSFPS(LAT,TRUELAT1,MSF) REAL :: psi1, psix, pole - IF (truelat1 .GE. 0.) THEN + IF (truelat1 >= 0.) THEN psi1 = (90. - truelat1) * rad_per_deg pole =90. ELSE diff --git a/sorc/ncep_post.fd/NGMFLD.f b/sorc/ncep_post.fd/NGMFLD.f index adc0c30a1..7bd962e14 100644 --- a/sorc/ncep_post.fd/NGMFLD.f +++ b/sorc/ncep_post.fd/NGMFLD.f @@ -176,41 +176,41 @@ SUBROUTINE NGMFLD(RH4710,RH4796,RH1847,RH8498,QM8510) QS=PQ0/PM*EXP(A2*(TM-A3)/(TM-A4)) ! RH = QM/QS - IF (RH.GT.H1) THEN + IF (RH>H1) THEN RH = H1 QM = RH*QS ENDIF - IF (RH.LT.D01) THEN + IF (RH=P85)) THEN Z8510(I,J) = Z8510(I,J) + DZ QM8510(I,J) = QM8510(I,J) + QMCVG*DZ ENDIF ! ! SIGMA 0.47-1.00 RELATIVE HUMIDITY. - IF ((PM.LE.P100).AND.(PM.GE.P47)) THEN + IF ((PM<=P100).AND.(PM>=P47)) THEN Z4710(I,J) = Z4710(I,J) + DZ RH4710(I,J) = RH4710(I,J) + RH*DZ ENDIF ! ! SIGMA 0.84-0.98 RELATIVE HUMIDITY. - IF ((PM.LE.P98).AND.(PM.GE.P84)) THEN + IF ((PM<=P98).AND.(PM>=P84)) THEN Z8498(I,J) = Z8498(I,J) + DZ RH8498(I,J) = RH8498(I,J) + RH*DZ ENDIF ! ! SIGMA 0.47-0.96 RELATIVE HUMIDITY. - IF ((PM.LE.P96).AND.(PM.GE.P47)) THEN + IF ((PM<=P96).AND.(PM>=P47)) THEN Z4796(I,J) = Z4796(I,J) + DZ RH4796(I,J) = RH4796(I,J) + RH*DZ ENDIF ! ! SIGMA 0.18-0.47 RELATIVE HUMIDITY. - IF ((PM.LE.P47).AND.(PM.GE.P18)) THEN + IF ((PM<=P47).AND.(PM>=P18)) THEN Z1847(I,J) = Z1847(I,J) + DZ RH1847(I,J) = RH1847(I,J) + RH*DZ ENDIF @@ -222,32 +222,32 @@ SUBROUTINE NGMFLD(RH4710,RH4796,RH1847,RH8498,QM8510) DO J=JSTA_M2,JEND_M2 DO I=2,IM-1 ! NORMALIZE TO GET LAYER MEAN VALUES. - IF (Z8510(I,J).GT.0) THEN + IF (Z8510(I,J)>0) THEN QM8510(I,J) = QM8510(I,J)/Z8510(I,J) ELSE QM8510(I,J) = SPVAL ENDIF - IF (ABS(QM8510(I,J)-SPVAL).LT.SMALL)QM8510(I,J)=H1M12 + IF (ABS(QM8510(I,J)-SPVAL)0) THEN RH4710(I,J) = RH4710(I,J)/Z4710(I,J) ELSE RH4710(I,J) = SPVAL ENDIF ! - IF (Z8498(I,J).GT.0) THEN + IF (Z8498(I,J)>0) THEN RH8498(I,J) = RH8498(I,J)/Z8498(I,J) ELSE RH8498(I,J) = SPVAL ENDIF ! - IF (Z4796(I,J).GT.0) THEN + IF (Z4796(I,J)>0) THEN RH4796(I,J) = RH4796(I,J)/Z4796(I,J) ELSE RH4796(I,J) = SPVAL ENDIF ! - IF (Z1847(I,J).GT.0) THEN + IF (Z1847(I,J)>0) THEN RH1847(I,J) = RH1847(I,J)/Z1847(I,J) ELSE RH1847(I,J) = SPVAL diff --git a/sorc/ncep_post.fd/NGMSLP.f b/sorc/ncep_post.fd/NGMSLP.f index 74fdaf14e..928ea922f 100644 --- a/sorc/ncep_post.fd/NGMSLP.f +++ b/sorc/ncep_post.fd/NGMSLP.f @@ -137,9 +137,9 @@ SUBROUTINE NGMSLP TAUSL = TVRSL*RD*GI ! ! IF NEED BE APPLY SHEULL CORRECTION. - IF ((TAUSL.GT.TAUCR).AND.(TAUSFC.LE.TAUCR)) THEN + IF ((TAUSL>TAUCR).AND.(TAUSFC<=TAUCR)) THEN TAUSL=TAUCR - ELSEIF ((TAUSL.GT.TAUCR).AND.(TAUSFC.GT.TAUCR)) THEN + ELSEIF ((TAUSL>TAUCR).AND.(TAUSFC>TAUCR)) THEN TAUSL = TAUCR-CONST*(TAUSFC-TAUCR)**2 ENDIF ! @@ -147,7 +147,7 @@ SUBROUTINE NGMSLP TAUAVG = D50*(TAUSL+TAUSFC) ! ! COMPUTE SEA LEVEL PRESSURE. - IF (ABS(FIS(I,J)).GT.1.0)SLP(I,J) = PSFC*EXP(ZSFC/TAUAVG) + IF (ABS(FIS(I,J))>1.0)SLP(I,J) = PSFC*EXP(ZSFC/TAUAVG) ! ! COMPUTE 1000MB HEIGHTS. ALPAVG = D50*(ALOG(PSFC)+ALOG(SLP(I,J))) diff --git a/sorc/ncep_post.fd/OTLFT.f b/sorc/ncep_post.fd/OTLFT.f index 921963625..a7416fad1 100644 --- a/sorc/ncep_post.fd/OTLFT.f +++ b/sorc/ncep_post.fd/OTLFT.f @@ -102,11 +102,11 @@ SUBROUTINE OTLFT(PBND,TBND,QBND,SLINDX) ! !--------------KEEPING INDICES WITHIN THE TABLE------------------------- ! - IF(ITTB .LT. 1)THEN + IF(ITTB < 1)THEN ITTB = 1 TQQ = D00 ENDIF - IF(ITTB .GE. JTB)THEN + IF(ITTB >= JTB)THEN ITTB = JTB-1 TQQ = D00 ENDIF @@ -129,11 +129,11 @@ SUBROUTINE OTLFT(PBND,TBND,QBND,SLINDX) ! !--------------KEEPING INDICES WITHIN THE TABLE------------------------- ! - IF(IQTB .LT. 1)THEN + IF(IQTB < 1)THEN IQTB = 1 PPQ = D00 ENDIF - IF(IQTB .GE. ITB)THEN + IF(IQTB >= ITB)THEN IQTB = ITB-1 PPQ = D00 ENDIF @@ -151,7 +151,7 @@ SUBROUTINE OTLFT(PBND,TBND,QBND,SLINDX) ! TPSP = P00+(P10-P00)*PPQ+(P01-P00)*TQQ & +(P00-P10-P01+P11)*PPQ*TQQ - IF(TPSP .LE. D00) TPSP = H10E5 + IF(TPSP <= D00) TPSP = H10E5 APESP = (H10E5/TPSP)**CAPA TTHES = TTHBT*EXP(ELOCP*QBT*APESP/TTHBT) ! @@ -166,11 +166,11 @@ SUBROUTINE OTLFT(PBND,TBND,QBND,SLINDX) ! !--------------KEEPING INDICES WITHIN THE TABLE------------------------- ! - IF(IPTB .LT. 1)THEN + IF(IPTB < 1)THEN IPTB = 1 QQ = D00 ENDIF - IF(IPTB .GE. ITB)THEN + IF(IPTB >= ITB)THEN IPTB = ITB-1 QQ = D00 ENDIF @@ -193,11 +193,11 @@ SUBROUTINE OTLFT(PBND,TBND,QBND,SLINDX) ! !--------------KEEPING INDICES WITHIN THE TABLE------------------------- ! - IF(ITHTB .LT. 1)THEN + IF(ITHTB < 1)THEN ITHTB = 1 PP = D00 ENDIF - IF(ITHTB .GE. JTB)THEN + IF(ITHTB >= JTB)THEN ITHTB = JTB-1 PP = D00 ENDIF @@ -213,7 +213,7 @@ SUBROUTINE OTLFT(PBND,TBND,QBND,SLINDX) ! !--------------PARCEL TEMPERATURE AT 500MB---------------------------- ! - IF(TPSP .GE. H5E4)THEN + IF(TPSP >= H5E4)THEN PARTMP=(T00+(T10-T00)*PP+(T01-T00)*QQ & +(T00-T10-T01+T11)*PP*QQ) ELSE diff --git a/sorc/ncep_post.fd/OTLIFT.f b/sorc/ncep_post.fd/OTLIFT.f index 271537aeb..21acf7cf6 100644 --- a/sorc/ncep_post.fd/OTLIFT.f +++ b/sorc/ncep_post.fd/OTLIFT.f @@ -93,11 +93,11 @@ SUBROUTINE OTLIFT(SLINDX) TQQ = TTH-AINT(TTH) ITTB = INT(TTH)+1 !--------------KEEPING INDICES WITHIN THE TABLE------------------------- - IF(ITTB .LT. 1)THEN + IF(ITTB < 1)THEN ITTB = 1 TQQ = D00 ENDIF - IF(ITTB .GE. JTB)THEN + IF(ITTB >= JTB)THEN ITTB = JTB-1 TQQ = D00 ENDIF @@ -114,11 +114,11 @@ SUBROUTINE OTLIFT(SLINDX) PPQ = TQ-AINT(TQ) IQTB = INT(TQ)+1 !--------------KEEPING INDICES WITHIN THE TABLE------------------------- - IF(IQTB .LT. 1)THEN + IF(IQTB < 1)THEN IQTB = 1 PPQ = D00 ENDIF - IF(IQTB .GE. ITB)THEN + IF(IQTB >= ITB)THEN IQTB = ITB-1 PPQ = D00 ENDIF @@ -132,7 +132,7 @@ SUBROUTINE OTLIFT(SLINDX) !--------------SATURATION POINT VARIABLES AT THE BOTTOM----------------- TPSP = P00+(P10-P00)*PPQ+(P01-P00)*TQQ & +(P00-P10-P01+P11)*PPQ*TQQ - IF(TPSP .LE. D00) TPSP = H10E5 + IF(TPSP <= D00) TPSP = H10E5 APESP = (H10E5/TPSP)**CAPA THESP = TTHBT*EXP(ELOCP*QBT*APESP/TTHBT) !--------------SCALING PRESSURE & TT TABLE INDEX------------------------ @@ -140,11 +140,11 @@ SUBROUTINE OTLIFT(SLINDX) QQ = TP-AINT(TP) IPTB = INT(TP)+1 !--------------KEEPING INDICES WITHIN THE TABLE------------------------- - IF(IPTB .LT. 1)THEN + IF(IPTB < 1)THEN IPTB = 1 QQ = D00 ENDIF - IF(IPTB .GE. ITB)THEN + IF(IPTB >= ITB)THEN IPTB = ITB-1 QQ = D00 ENDIF @@ -161,11 +161,11 @@ SUBROUTINE OTLIFT(SLINDX) PP = TTH-AINT(TTH) ITHTB = INT(TTH)+1 !--------------KEEPING INDICES WITHIN THE TABLE------------------------- - IF(ITHTB .LT. 1)THEN + IF(ITHTB < 1)THEN ITHTB = 1 PP = D00 ENDIF - IF(ITHTB .GE. JTB)THEN + IF(ITHTB >= JTB)THEN ITHTB = JTB-1 PP = D00 ENDIF @@ -177,7 +177,7 @@ SUBROUTINE OTLIFT(SLINDX) T01=TTBL(ITH,IP+1) T11=TTBL(ITH+1,IP+1) !--------------PARCEL TEMPERATURE AT 500MB---------------------------- - IF(TPSP .GE. H5E4)THEN + IF(TPSP >= H5E4)THEN PARTMP=(T00+(T10-T00)*PP+(T01-T00)*QQ & +(T00-T10-T01+T11)*PP*QQ) ELSE diff --git a/sorc/ncep_post.fd/PMICRPH.f b/sorc/ncep_post.fd/PMICRPH.f index 0b48f4862..47feb1a8c 100644 --- a/sorc/ncep_post.fd/PMICRPH.f +++ b/sorc/ncep_post.fd/PMICRPH.f @@ -2,11 +2,12 @@ module PMICRPH_mod ! ----- Constants related to microphysics ! -- computed in paramr.f -! ! REAL ABER1(31),ABER2(31) ! LOOKUP TABLE FOR A1 AND A2 IN BERGERON PROCESS + implicit none + REAL PI,RON,SON,GON,BR,BS,BG,DRAIN,DSNOW, & DGRAUPEL,RON2,DIACE_min, & drain2,dsnow2, & diff --git a/sorc/ncep_post.fd/READCNTRL.F b/sorc/ncep_post.fd/READCNTRL.F index fcce9fc26..7aff2edbf 100644 --- a/sorc/ncep_post.fd/READCNTRL.F +++ b/sorc/ncep_post.fd/READCNTRL.F @@ -77,7 +77,7 @@ SUBROUTINE READCNTRL(kth,IEOF) LCNTRL=14 LUNOUT=60 - IF(ME.EQ.0)THEN + IF(ME==0)THEN WRITE(6,*)'READCNTRL: POSTING FCST HR ',IFHR,' FROM ', & IHRST,'UTC ',SDAT(1),'-',SDAT(2),'-',SDAT(3),' RUN' ENDIF @@ -91,7 +91,7 @@ SUBROUTINE READCNTRL(kth,IEOF) IGET(IFLD)=-1 100 CONTINUE ! - if(me.eq.0)print*,'start reading control file' + if(me==0)print*,'start reading control file' ! READ(LCNTRL,1000,ERR=990,END=999) KGTYPE READ(LCNTRL,1000,ERR=990,END=999) IMDLTY @@ -105,7 +105,7 @@ SUBROUTINE READCNTRL(kth,IEOF) ! ! ECHO HEADER INFO TO 6. ! - IF(ME.EQ.0)THEN + IF(ME==0)THEN WRITE(6,*)'READCNTRL: HEADER INFORMATION' WRITE(6,*)' KGTYPE : ',KGTYPE WRITE(6,*)' IMDLTY : ',IMDLTY @@ -121,8 +121,8 @@ SUBROUTINE READCNTRL(kth,IEOF) IFLD = 0 10 CONTINUE READ(LCNTRL,1060,ERR=996) LINE - IF (INDEX(LINE,'DONE').NE.0) GOTO 40 - IF (INDEX(LINE,'SCAL=').EQ.0) GOTO 10 + IF (INDEX(LINE,'DONE')/=0) GOTO 40 + IF (INDEX(LINE,'SCAL=')==0) GOTO 10 IFLD = IFLD+1 FIELD(IFLD) = LINE(3:22) READ(LINE,1061) DEC(IFLD) @@ -146,7 +146,7 @@ SUBROUTINE READCNTRL(kth,IEOF) DO 15 L = 1,MXLVL ISUM = ISUM + LVLS(L,IFLD) 15 CONTINUE - IF (ISUM.LT.1) THEN + IF (ISUM<1) THEN IFLD = IFLD - 1 GOTO 10 ENDIF @@ -156,9 +156,9 @@ SUBROUTINE READCNTRL(kth,IEOF) ! COUNTER BY ONE. THEN READ NEXT REQUESTED FIELD. ! DO 20 IAVBL = 1,MXFLD - IF (INDEX(FIELD(IFLD),AVBL(IAVBL)).NE.0)GO TO 30 + IF (INDEX(FIELD(IFLD),AVBL(IAVBL))/=0)GO TO 30 20 CONTINUE - IF(ME.EQ.0)THEN + IF(ME==0)THEN WRITE(6,*)'FIELD ',FIELD(IFLD),' NOT AVAILABLE' ENDIF IFLD = IFLD-1 @@ -185,12 +185,12 @@ SUBROUTINE READCNTRL(kth,IEOF) ! ! ECHO OUTPUT FIELDS/LEVELS TO 6. ! - IF(ME.EQ.0)THEN + IF(ME==0)THEN WRITE(6,*)'BELOW ARE FIELD/LEVEL/SMOOTHING ', & 'SPECIFICATIONS.,NFLD=',NFLD,'MXLVL=',MXLVL ENDIF DO 50 IFLD = 1,NFLD - IF(ME.EQ.0)THEN + IF(ME==0)THEN WRITE(6,2060) FIELD(IFLD) WRITE(6,2070) (LVLS(L,IFLD),L=1,MXLVL) 2060 FORMAT('(',A20,')') @@ -208,14 +208,14 @@ SUBROUTINE READCNTRL(kth,IEOF) ! OUT AND CARRY ON. ! 990 CONTINUE - IF(ME.EQ.0)THEN + IF(ME==0)THEN WRITE(6,*)' READCNTRL: ERROR READING CNTRL HEADER INFO' WRITE(6,*)' BELOW IS CNTRL GRID INFO' WRITE(6,*)' KGTYPE,DATSET: ',KGTYPE,' ',DATSET ENDIF GOTO 999 996 CONTINUE - IF(ME.EQ.0)THEN + IF(ME==0)THEN WRITE(6,*)' READCNTRL: ERROR READING CNTRL FLD/LVL INFO' ENDIF ! @@ -228,7 +228,7 @@ SUBROUTINE READCNTRL(kth,IEOF) 999 CONTINUE IEOF=1 CLOSE(LUNOUT) - IF(ME.EQ.0)THEN + IF(ME==0)THEN WRITE(6,*)' READCNTRL: ALL GRIDS PROCESSED. ', & 'CLOSED ',LUNOUT ENDIF diff --git a/sorc/ncep_post.fd/SCLFLD.f b/sorc/ncep_post.fd/SCLFLD.f index ead18843f..fc4087ea8 100644 --- a/sorc/ncep_post.fd/SCLFLD.f +++ b/sorc/ncep_post.fd/SCLFLD.f @@ -62,7 +62,7 @@ SUBROUTINE SCLFLD(FLD,SCALE,IMO,JMO) !$omp parallel do DO J=JSTA,JEND DO I=1,IMO - IF(ABS(FLD(I,J)-SPVAL).GT.SMALL) FLD(I,J)=SCALE*FLD(I,J) + IF(ABS(FLD(I,J)-SPVAL)>SMALL) FLD(I,J)=SCALE*FLD(I,J) ENDDO ENDDO ! diff --git a/sorc/ncep_post.fd/SELECT_CHANNELS.f b/sorc/ncep_post.fd/SELECT_CHANNELS.f index 657c0679a..f78828044 100644 --- a/sorc/ncep_post.fd/SELECT_CHANNELS.f +++ b/sorc/ncep_post.fd/SELECT_CHANNELS.f @@ -80,17 +80,17 @@ subroutine SELECT_CHANNELS_L(channelinfo,nchannels,channels,L,igot) write(6,*) ' in SELECT_CHANNELS at index ',i stop 19 endif - if(L(i).eq.1)then + if(L(i)==1)then k=k+1 temp(k)=channelinfo%Channel_Index(channels(i)) endif - if(L(i).eq.0)then + if(L(i)==0)then channelinfo%Process_Channel(channels(i))=.FALSE. ! turn off channel processing endif enddo ! if no channels were selected, then set igot=0 - if(k.eq.0)then + if(k==0)then igot=0 return ! else diff --git a/sorc/ncep_post.fd/SETUP_SERVERS.f b/sorc/ncep_post.fd/SETUP_SERVERS.f index 6a516ae7a..9f2a2b084 100644 --- a/sorc/ncep_post.fd/SETUP_SERVERS.f +++ b/sorc/ncep_post.fd/SETUP_SERVERS.f @@ -99,7 +99,7 @@ SUBROUTINE SETUP_SERVERS(MYPE, & ! FIRST, HOWEVER, WE NEED TO MAKE SURE THAT A SUFFICIENT NUMBER ! OF MPI TASKS HAVE BEEN INITIATED. IF NOT, WE WILL STOP. ! - IF ( NPES .LT. NPES_MOD ) THEN + IF ( NPES < NPES_MOD ) THEN PRINT *, ' ***********************************************' PRINT *, ' ***********************************************' PRINT *, ' *************MAJOR PROBLEM*********************' @@ -143,7 +143,7 @@ SUBROUTINE SETUP_SERVERS(MYPE, & print *, ' ***** WE ARE CONTINUING .... ' iquilt_group = 100 end if - if ( mype .eq. 0 ) then + if ( mype == 0 ) then print *, ' we will try to run with ',iquilt_group,' server groups' end if ! @@ -285,7 +285,7 @@ SUBROUTINE SETUP_SERVERS(MYPE, & NPES = NPES - IQSERVER print *,'mype=',mype,'npes_new=',npes ! - IF(MYPE.EQ.0) THEN + IF(MYPE==0) THEN print *, ' The Posting is using ',npes,' MPI task' print *, ' There are ',iqserver,' I/O servers' END IF diff --git a/sorc/ncep_post.fd/SET_OUTFLDS.f b/sorc/ncep_post.fd/SET_OUTFLDS.f index f0cfb394d..a12d60106 100644 --- a/sorc/ncep_post.fd/SET_OUTFLDS.f +++ b/sorc/ncep_post.fd/SET_OUTFLDS.f @@ -66,7 +66,7 @@ SUBROUTINE SET_OUTFLDS(kth,th,kpv,pv) !****************************************************************************** ! START READCNTRL_XML HERE. ! -! IF(ME.EQ.0)THEN +! IF(ME==0)THEN ! WRITE(6,*)'READCNTRL_XML: POSTING FCST HR ',IFHR,' FROM ', & ! IHRST,'UTC ',SDAT(1),'-',SDAT(2),'-',SDAT(3),' RUN' ! ENDIF @@ -178,12 +178,12 @@ SUBROUTINE SET_OUTFLDS(kth,th,kpv,pv) ! ! ECHO OUTPUT FIELDS/LEVELS TO 6. ! -! IF(ME.EQ.0)THEN +! IF(ME==0)THEN ! WRITE(6,*)'BELOW ARE FIELD/LEVEL/SMOOTHING ', & ! 'SPECIFICATIONS.,NFLD=',NFLD,'MXLVL=',MXLVL,'nrecout=',nrecout ! ENDIF ! DO 50 IFLD = 1,NFLD -! IF(ME.EQ.0)THEN +! IF(ME==0)THEN ! i=IAVBLFLD(IFLD) ! write(0,*)'readxml,ifld=',ifld,'iget(',IDENT(ifld),')=',iget(ident(ifld)),'iavbl=',IAVBLFLD(iget(ident(ifld))),'postvar=',trim(pset%param(i)%pname), & ! trim(pset%param(i)%fixed_sfc1_type),'lvls=',LVLS(:,ifld) diff --git a/sorc/ncep_post.fd/SLP_NMM.f b/sorc/ncep_post.fd/SLP_NMM.f index 19cf5429f..10adb00f3 100644 --- a/sorc/ncep_post.fd/SLP_NMM.f +++ b/sorc/ncep_post.fd/SLP_NMM.f @@ -92,7 +92,7 @@ SUBROUTINE MEMSLP_NMM(TPRES,QPRES,FIPRES) DO I=1,IM LLMH=NINT(LMH(I,J)) PSLP(I,J)=PINT(I,J,LLMH+1) - if(i.eq.ii.and.j.eq.jj)print*,'Debug: FIS,IC for PSLP=' & + if(i==ii.and.j==jj)print*,'Debug: FIS,IC for PSLP=' & ,FIS(i,j),PSLP(I,J) TTV(I,J)=0. LMHO(I,J)=0 @@ -116,27 +116,27 @@ SUBROUTINE MEMSLP_NMM(TPRES,QPRES,FIPRES) DO I=1,IM PSFC=PSLP(I,J) PCHK=PSFC - IF(NFILL.GT.0)THEN + IF(NFILL>0)THEN PCHK=PINT(I,J,NINT(LMH(I,J))+1-NFILL) ENDIF -! IF(SM(I,J).GT.0.5.AND.FIS(I,J).LT.1.)PCHK=PSLP(I,J) - IF(FIS(I,J).LT.1.)PCHK=PSLP(I,J) +! IF(SM(I,J)>0.5.AND.FIS(I,J)<1.)PCHK=PSLP(I,J) + IF(FIS(I,J)<1.)PCHK=PSLP(I,J) ! -! IF(SPLL.LT.PSFC)THEN - IF(SPLL.LT.PCHK)THEN +! IF(SPLL1.AND.HTMO(I,J,L-1)>0.5)LMHO(I,J)=L-1 ENDIF ! - IF(L.EQ.LSM.AND.HTMO(I,J,L).GT.0.5)LMHO(I,J)=LSM - if(i.eq.ii.and.j.eq.jj)print*,'Debug: HTMO= ',HTMO(I,J,L) + IF(L==LSM.AND.HTMO(I,J,L)>0.5)LMHO(I,J)=LSM + if(i==ii.and.j==jj)print*,'Debug: HTMO= ',HTMO(I,J,L) ENDDO ENDDO ! 100 CONTINUE -! if(jj.ge.jsta.and.jj.le.jend) +! if(jj>=jsta.and.jj<=jend) ! +print*,'Debug: LMHO=',LMHO(ii,jj) !-------------------------------------------------------------------- !*** @@ -148,7 +148,7 @@ SUBROUTINE MEMSLP_NMM(TPRES,QPRES,FIPRES) ! DO J=JSTA,JEND DO I=1,IM - IF(HTMO(I,J,L).LT.0.5) cycle loop210 + IF(HTMO(I,J,L)<0.5) cycle loop210 ENDDO ENDDO ! @@ -157,13 +157,13 @@ SUBROUTINE MEMSLP_NMM(TPRES,QPRES,FIPRES) enddo loop210 print*,'Debug in SLP: LHMNT=',LHMNT - if ( num_procs .gt. 1 ) then + if ( num_procs > 1 ) then CALL MPI_ALLREDUCE & (LHMNT,LXXX,1,MPI_INTEGER,MPI_MIN,MPI_COMM_COMP,IERR) LHMNT = LXXX end if - IF(LHMNT.EQ.LSMP1)THEN + IF(LHMNT==LSMP1)THEN GO TO 325 ENDIF print*,'Debug in SLP: LHMNT A ALLREDUCE=',LHMNT @@ -181,7 +181,7 @@ SUBROUTINE MEMSLP_NMM(TPRES,QPRES,FIPRES) KOUNT=KOUNT+1 IMNT(KOUNT,L)=0 JMNT(KOUNT,L)=0 - IF(HTMO(I,J,L).GT.0.5) CYCLE + IF(HTMO(I,J,L)>0.5) CYCLE KMN=KMN+1 IMNT(KMN,L)=I JMNT(KMN,L)=J @@ -193,7 +193,7 @@ SUBROUTINE MEMSLP_NMM(TPRES,QPRES,FIPRES) !*** CREATE A TEMPORARY TV ARRAY, AND FOLLOW BY SEQUENTIAL !*** OVERRELAXATION, DOING NRLX PASSES. ! -! IF(NTSD.EQ.1)THEN +! IF(NTSD==1)THEN NRLX=NRLX1 ! ELSE ! NRLX=NRLX2 @@ -205,7 +205,7 @@ SUBROUTINE MEMSLP_NMM(TPRES,QPRES,FIPRES) DO 270 J=JSTA,JEND DO 270 I=1,IM TTV(I,J)=TPRES(I,J,L) - IF(TTV(I,J).lt.150. .and. TTV(I,J).gt.325.0)print* & + IF(TTV(I,J)<150. .and. TTV(I,J)>325.0)print* & ,'abnormal IC for T relaxation',i,j,TTV(I,J) HTM2D(I,J)=HTMO(I,J,L) 270 CONTINUE @@ -216,20 +216,20 @@ SUBROUTINE MEMSLP_NMM(TPRES,QPRES,FIPRES) CALL EXCH2(HTM2D(1,JSTA_2L)) !NEED TO EXCHANGE TWO ROW FOR E GRID DO J=JSTA_M2,JEND_M2 DO I=2,IM-1 - IF(HTM2D(I,J).GT.0.5.AND.HTM2D(I+IHW(J),J-1)*HTM2D(I+IHE(J),J-1) & + IF(HTM2D(I,J)>0.5.AND.HTM2D(I+IHW(J),J-1)*HTM2D(I+IHE(J),J-1) & *HTM2D(I+IHW(J),J+1)*HTM2D(I+IHE(J),J+1) & *HTM2D(I-1 ,J )*HTM2D(I+1 ,J ) & - *HTM2D(I ,J-2)*HTM2D(I ,J+2).LT.0.5)THEN + *HTM2D(I ,J-2)*HTM2D(I ,J+2)<0.5)THEN !HC MODIFICATION FOR C AND A GRIDS -!HC IF(HTM2D(I,J).GT.0.5.AND. +!HC IF(HTM2D(I,J)>0.5.AND. !HC 1 HTM2D(I-1,J)*HTM2D(I+1,J) !HC 2 *HTM2D(I,J-1)*HTM2D(I,J+1) !HC 3 *HTM2D(I-1,J-1)*HTM2D(I+1,J-1) -!HC 4 *HTM2D(I-1,J+1)*HTM2D(I+1,J+1).LT.0.5)THEN +!HC 4 *HTM2D(I-1,J+1)*HTM2D(I+1,J+1)<0.5)THEN ! TTV(I,J)=TPRES(I,J,L)*(1.+0.608*QPRES(I,J,L)) ENDIF -! if(i.eq.ii.and.j.eq.jj)print*,'Debug:L,TTV B SMOO= ',l,TTV(I,J) +! if(i==ii.and.j==jj)print*,'Debug:L,TTV B SMOO= ',l,TTV(I,J) ENDDO ENDDO ! @@ -255,7 +255,7 @@ SUBROUTINE MEMSLP_NMM(TPRES,QPRES,FIPRES) !HC 3 +TTV(I-1,J+1)+TTV(I+1,J+1)) !HC 4 -CFT0*TTV(I,J) ! -! if(i.eq.ii.and.j.eq.jj)print*,'Debug: L,TTV A S' +! if(i==ii.and.j==jj)print*,'Debug: L,TTV A S' ! 1,l,TTV(I,J),N ! 1,l,TNEW(I,J),N 280 CONTINUE @@ -290,19 +290,19 @@ SUBROUTINE MEMSLP_NMM(TPRES,QPRES,FIPRES) DO I=1,IM ! P1(I,J)=SPL(NINT(LMH(I,J))) ! DONE(I,J)=.FALSE. - IF(abs(FIS(I,J)).LT.1.)THEN + IF(abs(FIS(I,J))<1.)THEN PSLP(I,J)=PINT(I,J,NINT(LMH(I,J))+1) DONE(I,J)=.TRUE. KOUNT=KOUNT+1 - if(i.eq.ii.and.j.eq.jj)print*,'Debug:DONE,PSLP A S1=' & + if(i==ii.and.j==jj)print*,'Debug:DONE,PSLP A S1=' & ,done(i,j),PSLP(I,J) - ELSE IF(FIS(I,J).LT.-1.0) THEN + ELSE IF(FIS(I,J)<-1.0) THEN DO L=LM,1,-1 - IF(ZINT(I,J,L).GT.0.)THEN + IF(ZINT(I,J,L)>0.)THEN PSLP(I,J)=PINT(I,J,L)/EXP(-ZINT(I,J,L)*G & /(RD*T(I,J,L)*(Q(I,J,L)*D608+1.0))) DONE(I,J)=.TRUE. - if(i.eq.ii.and.j.eq.jj)print* & + if(i==ii.and.j==jj)print* & ,'Debug:DONE,PINT,PSLP A S1=' & ,done(i,j),PINT(I,J,L),PSLP(I,J) EXIT @@ -329,10 +329,10 @@ SUBROUTINE MEMSLP_NMM(TPRES,QPRES,FIPRES) TLYR=0.5*(TPRES(I,J,L)+TPRES(I,J,L-1)) GZ2=GZ1+RD*TLYR*ALOG(P1(I,J)/P2) FIPRES(I,J,L)=GZ2 -! if(i.eq.ii.and.j.eq.jj)print*,'Debug:L,FI A S2=',L,GZ2 - IF(GZ2.LE.0.)THEN +! if(i==ii.and.j==jj)print*,'Debug:L,FI A S2=',L,GZ2 + IF(GZ2<=0.)THEN PSLP(I,J)=P1(I,J)/EXP(-GZ1/(RD*TPRES(I,J,L-1))) -! if(i.eq.ii.and.j.eq.jj)print*,'Debug:PSLP A S2=',PSLP(I,J) +! if(i==ii.and.j==jj)print*,'Debug:PSLP A S2=',PSLP(I,J) DONE(I,J)=.TRUE. KOUNT=KOUNT+1 CYCLE LOOP320 @@ -346,7 +346,7 @@ SUBROUTINE MEMSLP_NMM(TPRES,QPRES,FIPRES) TLYR=TPRES(I,J,LP)-0.5*FIPRES(I,J,LP)*SLOPE PSLP(I,J)=spl(lp)/EXP(-FIPRES(I,J,LP)/(RD*TLYR)) DONE(I,J)=.TRUE. -! if(i.eq.ii.and.j.eq.jj)print*,'Debug:spl,FI,TLYR,PSLPA3=' & +! if(i==ii.and.j==jj)print*,'Debug:spl,FI,TLYR,PSLPA3=' & ! ,spl(lp),FIPRES(I,J,LP),TLYR,PSLP(I,J) !HC EXPERIMENT ENDDO LOOP320 @@ -361,7 +361,7 @@ SUBROUTINE MEMSLP_NMM(TPRES,QPRES,FIPRES) ! TOTAL=(IM-2)*(JM-4) ! !HC DO 340 LP=LSM,1,-1 -! IF(KOUNT.EQ.TOTAL)GO TO 350 +! IF(KOUNT==TOTAL)GO TO 350 !HC MODIFICATION FOR SMALL HILL HIGH PRESSURE SITUATION !HC IF SURFACE PRESSURE IS CLOSER TO SEA LEVEL THAN LWOEST !HC OUTPUT PRESSURE LEVEL, USE SURFACE PRESSURE TO DO EXTRAPOLATION @@ -369,34 +369,34 @@ SUBROUTINE MEMSLP_NMM(TPRES,QPRES,FIPRES) LP=LSM DO 330 J=JSTA,JEND DO 330 I=1,IM - if(i.eq.ii.and.j.eq.jj)print*,'Debug: with 330 loop' + if(i==ii.and.j==jj)print*,'Debug: with 330 loop' IF(DONE(I,J)) cycle - if(i.eq.ii.and.j.eq.jj)print*,'Debug: still within 330 loop' + if(i==ii.and.j==jj)print*,'Debug: still within 330 loop' !HC Comment out the following line for situation with terrain !HC at boundary (ie FIPRES<0) !HC because they were not counted as undergound point for 8 pt !HC relaxation -!HC IF(FIPRES(I,J,LP).LT.0.)GO TO 330 -! IF(FIPRES(I,J,LP).LT.0.)THEN +!HC IF(FIPRES(I,J,LP)<0.)GO TO 330 +! IF(FIPRES(I,J,LP)<0.)THEN ! DO LP=LSM,1,-1 -! IF (FIPRES(I,J) .LE. 0) +! IF (FIPRES(I,J) <= 0) -! IF(FIPRES(I,J,LP).LT.0..OR.DONE(I,J))GO TO 330 +! IF(FIPRES(I,J,LP)<0..OR.DONE(I,J))GO TO 330 ! SLOPE=(TPRES(I,J,LP)-TPRES(I,J,LP-1)) ! & /(FIPRES(I,J,LP)-FIPRES(I,J,LP-1)) SLOPE=-6.6E-4 - IF(PINT(I,J,NINT(LMH(I,J))+1).GT.SPL(LP))THEN + IF(PINT(I,J,NINT(LMH(I,J))+1)>SPL(LP))THEN LLMH=NINT(LMH(I,J)) TVRT=T(I,J,LLMH)*(H1+D608*Q(I,J,LLMH)) DIS=ZINT(I,J,LLMH+1)-ZINT(I,J,LLMH)+0.5*ZINT(I,J,LLMH+1) TLYR=TVRT-DIS*G*SLOPE PSLP(I,J)=PINT(I,J,LLMH+1)*EXP(ZINT(I,J,LLMH+1)*G/(RD*TLYR)) -! if(i.eq.ii.and.j.eq.jj)print*,'Debug:PSFC,zsfc,TLYR,PSLPA3=' +! if(i==ii.and.j==jj)print*,'Debug:PSFC,zsfc,TLYR,PSLPA3=' ! 1,PINT(I,J,LLMH+1),ZINT(I,J,LLMH+1),TLYR,PSLP(I,J) ELSE TLYR=TPRES(I,J,LP)-0.5*FIPRES(I,J,LP)*SLOPE PSLP(I,J)=spl(lp)/EXP(-FIPRES(I,J,LP)/(RD*TLYR)) - if(i.eq.ii.and.j.eq.jj)print*,'Debug:spl,FI,TLYR,PSLPA3=' & + if(i==ii.and.j==jj)print*,'Debug:spl,FI,TLYR,PSLPA3=' & ,spl(lp),FIPRES(I,J,LP),TLYR,PSLP(I,J) END IF DONE(I,J)=.TRUE. diff --git a/sorc/ncep_post.fd/SLP_new.f b/sorc/ncep_post.fd/SLP_new.f index b2f83b55f..5e571ab6c 100644 --- a/sorc/ncep_post.fd/SLP_new.f +++ b/sorc/ncep_post.fd/SLP_new.f @@ -141,7 +141,7 @@ SUBROUTINE MEMSLP(TPRES,QPRES,FIPRES) IF(L == LSM .AND. HTMO(I,J,L) > 0.5) LMHO(I,J) = LSM ! ! test new idea of filtering above-ground pressure levels for Gibsing -! IF(L.EQ.LSM.AND.HTMO(I,J,L).GT.0.5)THEN +! IF(L==LSM.AND.HTMO(I,J,L)>0.5)THEN ! IF(FIS(I,J)>0.)THEN ! LMHO(I,J)=LSM ! ELSE @@ -150,12 +150,12 @@ SUBROUTINE MEMSLP(TPRES,QPRES,FIPRES) ! HTMO(I,J,LSM-1)=0. ! END IF ! END IF -! if(i.eq.ii.and.j.eq.jj)print*,'Debug: HTMO= ',HTMO(I,J,L) +! if(i==ii.and.j==jj)print*,'Debug: HTMO= ',HTMO(I,J,L) ENDDO ENDDO ! ENDDO -! if(jj.ge.jsta.and.jj.le.jend) print*,'Debug: LMHO=',LMHO(ii,jj) +! if(jj>=jsta.and.jj<=jend) print*,'Debug: LMHO=',LMHO(ii,jj) !-------------------------------------------------------------------- !*** !*** WE REACH THIS LINE IF WE WANT THE MESINGER ETA SLP REDUCTION @@ -214,7 +214,7 @@ SUBROUTINE MEMSLP(TPRES,QPRES,FIPRES) !*** CREATE A TEMPORARY TV ARRAY, AND FOLLOW BY SEQUENTIAL !*** OVERRELAXATION, DOING NRLX PASSES. ! -! IF(NTSD.EQ.1)THEN +! IF(NTSD==1)THEN NRLX = NRLX2 ! ELSE ! NRLX=NRLX2 @@ -227,11 +227,11 @@ SUBROUTINE MEMSLP(TPRES,QPRES,FIPRES) DO J=JSTA,JEND DO I=1,IM ! dong -! if (QPRES(I,J,LSM) .lt. spval) then +! if (QPRES(I,J,LSM) < spval) then TTV(I,J) = TPRES(I,J,L) HTM2D(I,J) = HTMO(I,J,L) ! end if ! spval if -! IF(TTV(I,J).lt.150. .and. TTV(I,J).gt.325.0)print* & +! IF(TTV(I,J)<150. .and. TTV(I,J)>325.0)print* & ! ,'abnormal IC for T relaxation',i,j,TTV(I,J) enddo enddo @@ -245,13 +245,13 @@ SUBROUTINE MEMSLP(TPRES,QPRES,FIPRES) DO J=JSTA_M,JEND_M DO I=2,IM-1 ! dong - if (QPRES(I,J,LSM) .lt. spval) then + if (QPRES(I,J,LSM) < spval) then -!HC IF(HTM2D(I,J,L).GT.0.5.AND. +!HC IF(HTM2D(I,J,L)>0.5.AND. !HC 1 HTM2D(I+IHW(J),J-1,L)*HTM2D(I+IHE(J),J-1,L) !HC 2 *HTM2D(I+IHW(J),J+1,L)*HTM2D(I+IHE(J),J+1,L) !HC 3 *HTM2D(I-1 ,J ,L)*HTM2D(I+1 ,J ,L) -!HC 4 *HTM2D(I ,J-2,L)*HTM2D(I ,J+2,L).LT.0.5)THEN +!HC 4 *HTM2D(I ,J-2,L)*HTM2D(I ,J+2,L)<0.5)THEN !HC MODIFICATION FOR C AND A GRIDS tem = HTM2D(I-1,J)*HTM2D(I+1,J)*HTM2D(I,J-1)*HTM2D(I,J+1) & @@ -259,7 +259,7 @@ SUBROUTINE MEMSLP(TPRES,QPRES,FIPRES) IF(HTM2D(I,J) > 0.5 .AND. tem < 0.5) then TTV(I,J) = TPRES(I,J,L)*(1.+0.608*QPRES(I,J,L)) ENDIF -! if(i.eq.ii.and.j.eq.jj)print*,'Debug:L,TTV B SMOO= ',l,TTV(I,J) +! if(i==ii.and.j==jj)print*,'Debug:L,TTV B SMOO= ',l,TTV(I,J) end if ! spval ENDDO ENDDO @@ -275,7 +275,7 @@ SUBROUTINE MEMSLP(TPRES,QPRES,FIPRES) I = IMNT(KM,L) J = JMNT(KM,L) ! dong -! if (QPRES(I,J,LSM) .lt. spval) then +! if (QPRES(I,J,LSM) < spval) then !HC TTV(I,J)=AD05*(4.*(TTV(I+IHW(J),J-1)+TTV(I+IHE(J),J-1) @@ -299,23 +299,23 @@ SUBROUTINE MEMSLP(TPRES,QPRES,FIPRES) a6=TTV(I+1,J-1) a7=TTV(I-1,J+1) a8=TTV(I+1,J+1) -! if ((a1-spval) .le. 1e-10) a1=TTV(I,J) -! if ((a2-spval) .le. 1e-10) a2=TTV(I,J) -! if ((a3-spval) .le. 1e-10) a3=TTV(I,J) -! if ((a4-spval) .le. 1e-10) a4=TTV(I,J) -! if ((a5-spval) .le. 1e-10) a5=TTV(I,J) -! if ((a6-spval) .le. 1e-10) a6=TTV(I,J) -! if ((a7-spval) .le. 1e-10) a7=TTV(I,J) -! if ((a8-spval) .le. 1e-10) a8=TTV(I,J) - - if ((a1 .lt. spval) .and. & - (a2 .lt. spval) .and. & - (a3 .lt. spval) .and. & - (a4 .lt. spval) .and. & - (a5 .lt. spval) .and. & - (a6 .lt. spval) .and. & - (a7 .lt. spval) .and. & - (a8 .lt. spval) .and. (TTV(I,J) .lt. spval)) then +! if ((a1-spval) <= 1e-10) a1=TTV(I,J) +! if ((a2-spval) <= 1e-10) a2=TTV(I,J) +! if ((a3-spval) <= 1e-10) a3=TTV(I,J) +! if ((a4-spval) <= 1e-10) a4=TTV(I,J) +! if ((a5-spval) <= 1e-10) a5=TTV(I,J) +! if ((a6-spval) <= 1e-10) a6=TTV(I,J) +! if ((a7-spval) <= 1e-10) a7=TTV(I,J) +! if ((a8-spval) <= 1e-10) a8=TTV(I,J) + + if ((a1 < spval) .and. & + (a2 < spval) .and. & + (a3 < spval) .and. & + (a4 < spval) .and. & + (a5 < spval) .and. & + (a6 < spval) .and. & + (a7 < spval) .and. & + (a8 < spval) .and. (TTV(I,J) < spval)) then ! TNEW(I,J) = AD05*(4.*(a1 +a2 +a3 & ! +a4) +a5 +a6 & @@ -335,7 +335,7 @@ SUBROUTINE MEMSLP(TPRES,QPRES,FIPRES) ! TTV(I,J)=TTV(I,J)+1.0*((TTV(I-1,J)+TTV(I+1,J) ! 1 +TTV(I,J-1)+TTV(I,J+1)-4.0*TTV(I,J))/4.0) ! -! if(i.eq.ii.and.j.eq.jj)print*,'Debug: L,TTV A S' +! if(i==ii.and.j==jj)print*,'Debug: L,TTV A S' ! 1,l,TTV(I,J),N ! 1,l,TNEW(I,J),N ! end if ! spval @@ -347,7 +347,7 @@ SUBROUTINE MEMSLP(TPRES,QPRES,FIPRES) I = IMNT(KM,L) J = JMNT(KM,L) ! dong - if (QPRES(I,J,LSM) .lt. spval) then + if (QPRES(I,J,LSM) < spval) then TTV(I,J) = TNEW(I,J) end if ! spval END DO @@ -359,7 +359,7 @@ SUBROUTINE MEMSLP(TPRES,QPRES,FIPRES) J = JMNT(KM,L) ! dong - if (QPRES(I,J,LSM) .lt. spval) then + if (QPRES(I,J,LSM) < spval) then ! dong try to fix missing value for hgtprs at 1000 mb TPRES(I,J,L) = TTV(I,J) @@ -390,7 +390,7 @@ SUBROUTINE MEMSLP(TPRES,QPRES,FIPRES) DO I=1,IM ! dong -! if (QPRES(I,J,LSM) .lt. spval) then +! if (QPRES(I,J,LSM) < spval) then ! P1(I,J)=SPL(NINT(LMH(I,J))) ! DONE(I,J)=.FALSE. @@ -399,7 +399,7 @@ SUBROUTINE MEMSLP(TPRES,QPRES,FIPRES) PSLP(I,J) = PINT(I,J,NINT(LMH(I,J))+1) DONE(I,J) = .TRUE. KOUNT = KOUNT + 1 -! if(i.eq.ii.and.j.eq.jj)print*,'Debug:DONE,PSLP A S1=' & +! if(i==ii.and.j==jj)print*,'Debug:DONE,PSLP A S1=' & ! ,done(i,j),PSLP(I,J) ELSE IF(FIS(I,J) < -1.0) THEN DO L=LM,1,-1 @@ -410,7 +410,7 @@ SUBROUTINE MEMSLP(TPRES,QPRES,FIPRES) tem = 0.5*(T(I,J,L)+T(I,J,L-1))*(1.0+0.5*D608*(Q(I,J,L)+Q(I,J,L-1))) PSLP(I,J) = PINT(I,J,L-1)/EXP(-ZINT(I,J,L-1)*G/(rd*tem)) DONE(I,J) = .TRUE. -! if(i.eq.ii.and.j.eq.jj)print* & +! if(i==ii.and.j==jj)print* & ! ,'Debug:DONE,PINT,PSLP A S1=' & ! ,done(i,j),PINT(I,J,L),PSLP(I,J) exit @@ -429,7 +429,7 @@ SUBROUTINE MEMSLP(TPRES,QPRES,FIPRES) I = IMNT(KM,LSM) J = JMNT(KM,LSM) ! dong -! if (QPRES(I,J,LSM) .lt. spval) then +! if (QPRES(I,J,LSM) < spval) then IF(DONE(I,J)) cycle LMHIJ = LMHO(I,J) @@ -442,10 +442,10 @@ SUBROUTINE MEMSLP(TPRES,QPRES,FIPRES) TLYR = 0.5*(TPRES(I,J,L)+TPRES(I,J,L-1)) GZ2 = GZ1 + RD*TLYR*LOG(P1(I,J)/P2) FIPRES(I,J,L) = GZ2 -! if(i.eq.ii.and.j.eq.jj)print*,'Debug:L,FI A S2=',L,GZ2 +! if(i==ii.and.j==jj)print*,'Debug:L,FI A S2=',L,GZ2 IF(GZ2 <= 0.)THEN PSLP(I,J) = P1(I,J)/EXP(-GZ1/(RD*TPRES(I,J,L-1))) -! if(i.eq.ii.and.j.eq.jj)print*,'Debug:PSLP A S2=',PSLP(I,J) +! if(i==ii.and.j==jj)print*,'Debug:PSLP A S2=',PSLP(I,J) DONE(I,J) = .TRUE. KOUNT = KOUNT + 1 CYCLE LOOP320 @@ -459,7 +459,7 @@ SUBROUTINE MEMSLP(TPRES,QPRES,FIPRES) TLYR = TPRES(I,J,LP)-0.5*FIPRES(I,J,LP)*SLOPE PSLP(I,J) = spl(lp)/EXP(-FIPRES(I,J,LP)/(RD*TLYR)) DONE(I,J) = .TRUE. -! if(i.eq.ii.and.j.eq.jj)print*,'Debug:spl,FI,TLYR,PSLPA3=' & +! if(i==ii.and.j==jj)print*,'Debug:spl,FI,TLYR,PSLPA3=' & ! ,spl(lp),FIPRES(I,J,LP),TLYR,PSLP(I,J) !HC EXPERIMENT ! end if ! spval @@ -477,7 +477,7 @@ SUBROUTINE MEMSLP(TPRES,QPRES,FIPRES) ! TOTAL=(IM-2)*(JM-4) ! !HC DO 340 LP=LSM,1,-1 -! IF(KOUNT.EQ.TOTAL)GO TO 350 +! IF(KOUNT==TOTAL)GO TO 350 !HC MODIFICATION FOR SMALL HILL HIGH PRESSURE SITUATION !HC IF SURFACE PRESSURE IS CLOSER TO SEA LEVEL THAN LWOEST !HC OUTPUT PRESSURE LEVEL, USE SURFACE PRESSURE TO DO EXTRAPOLATION @@ -488,22 +488,22 @@ SUBROUTINE MEMSLP(TPRES,QPRES,FIPRES) DO I=1,IM ! dong -! if (QPRES(I,J,LSM) .lt. spval) then +! if (QPRES(I,J,LSM) < spval) then -! if(i.eq.ii.and.j.eq.jj)print*,'Debug: with 330 loop' +! if(i==ii.and.j==jj)print*,'Debug: with 330 loop' IF(DONE(I,J)) cycle -! if(i.eq.ii.and.j.eq.jj)print*,'Debug: still within 330 loop' +! if(i==ii.and.j==jj)print*,'Debug: still within 330 loop' !HC Comment out the following line for situation with terrain !HC at boundary (ie FIPRES<0) !HC because they were not counted as undergound point for 8 pt !HC relaxation -!HC IF(FIPRES(I,J,LP).LT.0.)GO TO 330 -! IF(FIPRES(I,J,LP).LT.0.)THEN +!HC IF(FIPRES(I,J,LP)<0.)GO TO 330 +! IF(FIPRES(I,J,LP)<0.)THEN ! DO LP=LSM,1,-1 -! IF (FIPRES(I,J) .LE. 0) +! IF (FIPRES(I,J) <= 0) -! IF(FIPRES(I,J,LP).LT.0..OR.DONE(I,J))GO TO 330 +! IF(FIPRES(I,J,LP)<0..OR.DONE(I,J))GO TO 330 ! SLOPE=(TPRES(I,J,LP)-TPRES(I,J,LP-1)) ! & /(FIPRES(I,J,LP)-FIPRES(I,J,LP-1)) @@ -515,12 +515,12 @@ SUBROUTINE MEMSLP(TPRES,QPRES,FIPRES) TLYR = TVRT-DIS*G*SLOPE PSLP(I,J) = PINT(I,J,LLMH+1)*EXP(ZINT(I,J,LLMH+1)*G & /(RD*TLYR)) -! if(i.eq.ii.and.j.eq.jj)print*,'Debug:PSFC,zsfc,TLYR,PSLPA3=' +! if(i==ii.and.j==jj)print*,'Debug:PSFC,zsfc,TLYR,PSLPA3=' ! 1,PINT(I,J,LLMH+1),ZINT(I,J,LLMH+1),TLYR,PSLP(I,J) ELSE TLYR=TPRES(I,J,LP)-0.5*FIPRES(I,J,LP)*SLOPE PSLP(I,J)=spl(lp)/EXP(-FIPRES(I,J,LP)/(RD*TLYR)) -! if(i.eq.ii.and.j.eq.jj)print*,'Debug:spl,FI,TLYR,PSLPA3=' & +! if(i==ii.and.j==jj)print*,'Debug:spl,FI,TLYR,PSLPA3=' & ! ,spl(lp),FIPRES(I,J,LP),TLYR,PSLP(I,J) END IF DONE(I,J) = .TRUE. diff --git a/sorc/ncep_post.fd/SNFRAC.f b/sorc/ncep_post.fd/SNFRAC.f index 740474874..e8a1a8fbb 100644 --- a/sorc/ncep_post.fd/SNFRAC.f +++ b/sorc/ncep_post.fd/SNFRAC.f @@ -31,11 +31,11 @@ SUBROUTINE SNFRAC (SNEQV,IVEGx,SNCOVR) ! ---------------------------------------------------------------------- !jjt IVEG = IVEGx - IF ( IVEG .gt. 20 .or. IVEG .lt. 1 ) then + IF ( IVEG > 20 .or. IVEG < 1 ) then ! print *, ' PROBLEM in SNFRAC, IVEG = ',iveg IVEG = 1 END IF - IF (SNEQV .LT. SNUP(IVEG)) THEN + IF (SNEQV < SNUP(IVEG)) THEN RSNOW = SNEQV/SNUP(IVEG) SNCOVR = 1. - (EXP(-SALP*RSNOW) - RSNOW*EXP(-SALP)) ELSE diff --git a/sorc/ncep_post.fd/SNFRAC_GFS.f b/sorc/ncep_post.fd/SNFRAC_GFS.f index 8bb1859cf..1230b9df0 100644 --- a/sorc/ncep_post.fd/SNFRAC_GFS.f +++ b/sorc/ncep_post.fd/SNFRAC_GFS.f @@ -27,7 +27,7 @@ SUBROUTINE SNFRAC_GFS(SNEQV,IVEG,SNCOVR) ! ---------------------------------------------------------------------- ! SNUP IS VEG-CLASS DEPENDENT SNOWDEPTH THRESHHOLD ABOVE WHICH SNOCVR=1. ! ---------------------------------------------------------------------- - IF (SNEQV .LT. SNUP(IVEG)) THEN + IF (SNEQV < SNUP(IVEG)) THEN RSNOW = SNEQV/SNUP(IVEG) SNCOVR = 1. - (EXP(-SALP*RSNOW) - RSNOW*EXP(-SALP)) ELSE diff --git a/sorc/ncep_post.fd/SPLINE.f b/sorc/ncep_post.fd/SPLINE.f index fe2e6e970..1371a7ecc 100644 --- a/sorc/ncep_post.fd/SPLINE.f +++ b/sorc/ncep_post.fd/SPLINE.f @@ -49,7 +49,7 @@ SUBROUTINE SPLINE(JTB,NOLD,XOLD,YOLD,Y2,NNEW,XNEW,YNEW,P,Q) P(1)= RTDXC*(6.*(DYDXR-DYDXL)-DXL*Y2(1)) Q(1)=-RTDXC*DXR ! - IF(NOLD.EQ.3) GO TO 700 + IF(NOLD==3) GO TO 700 !----------------------------------------------------------------------- K=3 ! @@ -64,29 +64,29 @@ SUBROUTINE SPLINE(JTB,NOLD,XOLD,YOLD,Y2,NNEW,XNEW,YNEW,P,Q) Q(K-1)=-DEN*DXR ! K=K+1 - IF(K.LT.NOLD) GO TO 100 + IF(K1) GO TO 200 !----------------------------------------------------------------------- K1=1 ! 300 XK=XNEW(K1) ! DO 400 K2=2,NOLD - IF(XOLD(K2).LE.XK) GO TO 400 + IF(XOLD(K2)<=XK) GO TO 400 KOLD=K2-1 GO TO 450 400 CONTINUE YNEW(K1)=YOLD(NOLD) GO TO 600 ! - 450 IF(K1.EQ.1) GO TO 500 - IF(K.EQ.KOLD) GO TO 550 + 450 IF(K1==1) GO TO 500 + IF(K==KOLD) GO TO 550 ! 500 K=KOLD ! @@ -110,7 +110,7 @@ SUBROUTINE SPLINE(JTB,NOLD,XOLD,YOLD,Y2,NNEW,XNEW,YNEW,P,Q) YNEW(K1)=AK*XSQ*X+BK*XSQ+CK*X+YOLD(K) ! 600 K1=K1+1 - IF(K1.LE.NNEW) GO TO 300 + IF(K1<=NNEW) GO TO 300 !----------------------------------------------------------------------- RETURN END diff --git a/sorc/ncep_post.fd/SURFCE.f b/sorc/ncep_post.fd/SURFCE.f index 82fc60dd9..e3d40f9d9 100644 --- a/sorc/ncep_post.fd/SURFCE.f +++ b/sorc/ncep_post.fd/SURFCE.f @@ -158,11 +158,11 @@ SUBROUTINE SURFCE ! IF ANY OF THE FOLLOWING "SURFACE" FIELDS ARE REQUESTED, ! WE NEED TO COMPUTE THE FIELDS FIRST. ! - IF ( (IGET(024).GT.0).OR.(IGET(025).GT.0).OR. & - (IGET(026).GT.0).OR.(IGET(027).GT.0).OR. & - (IGET(028).GT.0).OR.(IGET(029).GT.0).OR. & - (IGET(154).GT.0).OR. & - (IGET(034).GT.0).OR.(IGET(076).GT.0) ) THEN + IF ( (IGET(024)>0).OR.(IGET(025)>0).OR. & + (IGET(026)>0).OR.(IGET(027)>0).OR. & + (IGET(028)>0).OR.(IGET(029)>0).OR. & + (IGET(154)>0).OR. & + (IGET(034)>0).OR.(IGET(076)>0) ) THEN ! allocate(zsfc(im,jsta:jend), psfc(im,jsta:jend), tsfc(im,jsta:jend)& ,rhsfc(im,jsta:jend), thsfc(im,jsta:jend), qsfc(im,jsta:jend)) @@ -212,8 +212,8 @@ SUBROUTINE SURFCE END IF ! !mp ACCUMULATED NON-CONVECTIVE PRECIP. -!mp IF(IGET(034).GT.0)THEN -!mp IF(LVLS(1,IGET(034)).GT.0)THEN +!mp IF(IGET(034)>0)THEN +!mp IF(LVLS(1,IGET(034))>0)THEN ! ACCUMULATED PRECIP (convective + non-convective) ! IF(IGET(087) > 0)THEN @@ -230,7 +230,7 @@ SUBROUTINE SURFCE ! INTERPOLATE/OUTPUT REQUESTED SURFACE FIELDS. ! ! SURFACE PRESSURE. - IF (IGET(024).GT.0) THEN + IF (IGET(024)>0) THEN if(grib == 'grib2') then cfld = cfld+1 fld_info(cfld)%ifld = IAVBLFLD(IGET(024)) @@ -245,7 +245,7 @@ SUBROUTINE SURFCE ENDIF ! ! SURFACE HEIGHT. - IF (IGET(025).GT.0) THEN + IF (IGET(025)>0) THEN !! CALL BOUND(GRID1,D00,H99999) if(grib == 'grib2') then cfld=cfld+1 @@ -263,7 +263,7 @@ SUBROUTINE SURFCE if (allocated(psfc)) deallocate(psfc) ! ! SURFACE (SKIN) TEMPERATURE. - IF (IGET(026).GT.0) THEN + IF (IGET(026)>0) THEN if(grib == 'grib2') then cfld = cfld+1 fld_info(cfld)%ifld = IAVBLFLD(IGET(026)) @@ -279,7 +279,7 @@ SUBROUTINE SURFCE if (allocated(tsfc)) deallocate(tsfc) ! ! SURFACE (SKIN) POTENTIAL TEMPERATURE. - IF (IGET(027).GT.0) THEN + IF (IGET(027)>0) THEN if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(027)) @@ -295,7 +295,7 @@ SUBROUTINE SURFCE if (allocated(thsfc)) deallocate(thsfc) ! ! SURFACE SPECIFIC HUMIDITY. - IF (IGET(028).GT.0) THEN + IF (IGET(028)>0) THEN CALL BOUND(GRID1,H1M12,H99999) if(grib=='grib2') then cfld=cfld+1 @@ -312,7 +312,7 @@ SUBROUTINE SURFCE if (allocated(qsfc)) deallocate(qsfc) ! ! SURFACE DEWPOINT TEMPERATURE. - IF (IGET(029).GT.0) THEN + IF (IGET(029)>0) THEN allocate(dwpsfc(im,jsta:jend)) CALL DEWPOINT(EVP,DWPSFC) if(grib=='grib2') then @@ -330,7 +330,7 @@ SUBROUTINE SURFCE ENDIF ! ! SURFACE RELATIVE HUMIDITY. - IF (IGET(076).GT.0) THEN + IF (IGET(076)>0) THEN CALL BOUND(RHSFC,H1,H100) if(grib=='grib2') then cfld=cfld+1 @@ -351,7 +351,7 @@ SUBROUTINE SURFCE ! ADDITIONAL SURFACE-SOIL LEVEL FIELDS. ! ! SURFACE MIXING RATIO - IF (IGET(762).GT.0) THEN + IF (IGET(762)>0) THEN if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(762)) @@ -367,7 +367,7 @@ SUBROUTINE SURFCE ! ! SHELTER MIXING RATIO - IF (IGET(760).GT.0) THEN + IF (IGET(760)>0) THEN if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(760)) @@ -382,7 +382,7 @@ SUBROUTINE SURFCE ENDIF ! SNOW TEMERATURE - IF (IGET(761).GT.0) THEN + IF (IGET(761)>0) THEN if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(761)) @@ -397,7 +397,7 @@ SUBROUTINE SURFCE ENDIF ! DENSITY OF SNOWFALL - IF (IGET(724).GT.0) THEN + IF (IGET(724)>0) THEN if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(724)) @@ -412,28 +412,28 @@ SUBROUTINE SURFCE ENDIF ! ACCUMULATED DEPTH OF SNOWFALL - IF (IGET(725).GT.0) THEN + IF (IGET(725)>0) THEN ID(1:25) = 0 ITPREC = NINT(TPREC) !mp - IF(ITPREC .NE. 0) THEN + IF(ITPREC /= 0) THEN IFINCR = MOD(IFHR,ITPREC) - IF(IFMIN .GE. 1)IFINCR = MOD(IFHR*60+IFMIN,ITPREC*60) + IF(IFMIN >= 1)IFINCR = MOD(IFHR*60+IFMIN,ITPREC*60) ELSE IFINCR = 0 ENDIF !mp ID(18) = 0 ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 4 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITPREC ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(725)) @@ -458,8 +458,8 @@ SUBROUTINE SURFCE DO L=1,NSOIL ! SOIL TEMPERATURE. - IF (IGET(116).GT.0) THEN - IF (LVLS(L,IGET(116)).GT.0) THEN + IF (IGET(116)>0) THEN + IF (LVLS(L,IGET(116))>0) THEN IF(iSF_SURFACE_PHYSICS==3)THEN if(grib=='grib2') then cfld=cfld+1 @@ -499,8 +499,8 @@ SUBROUTINE SURFCE ENDIF ! ! SOIL MOISTURE. - IF (IGET(117).GT.0) THEN - IF (LVLS(L,IGET(117)).GT.0) THEN + IF (IGET(117)>0) THEN + IF (LVLS(L,IGET(117))>0) THEN IF(iSF_SURFACE_PHYSICS==3)THEN if(grib=='grib2') then cfld=cfld+1 @@ -536,8 +536,8 @@ SUBROUTINE SURFCE ENDIF ENDIF ! ADD LIQUID SOIL MOISTURE - IF (IGET(225).GT.0) THEN - IF (LVLS(L,IGET(225)).GT.0) THEN + IF (IGET(225)>0) THEN + IF (LVLS(L,IGET(225))>0) THEN IF(iSF_SURFACE_PHYSICS==3)THEN if(grib=='grib2') then cfld=cfld+1 @@ -576,7 +576,7 @@ SUBROUTINE SURFCE ! ----------------- ! ! BOTTOM SOIL TEMPERATURE. - IF (IGET(115).GT.0.or.IGET(571)>0) THEN + IF (IGET(115)>0.or.IGET(571)>0) THEN if(iget(115)>0) then if(grib=='grib2') then cfld=cfld+1 @@ -604,7 +604,7 @@ SUBROUTINE SURFCE ENDIF ! ! SOIL MOISTURE AVAILABILITY - IF (IGET(171).GT.0) THEN + IF (IGET(171)>0) THEN !!$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -629,7 +629,7 @@ SUBROUTINE SURFCE ENDIF ! ! TOTAL SOIL MOISTURE - IF (IGET(036).GT.0) THEN + IF (IGET(036)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -658,7 +658,7 @@ SUBROUTINE SURFCE ENDIF ! ! PLANT CANOPY SURFACE WATER. - IF ( IGET(118).GT.0 ) THEN + IF ( IGET(118)>0 ) THEN IF(MODELNAME == 'RAPR') THEN !$omp parallel do private(i,j) DO J=JSTA,JEND @@ -696,7 +696,7 @@ SUBROUTINE SURFCE ENDIF ! ! SNOW WATER EQUIVALENT. - IF ( IGET(119).GT.0 ) THEN + IF ( IGET(119)>0 ) THEN ! GRID1 = SPVAL if(grib=='grib2') then cfld=cfld+1 @@ -712,7 +712,7 @@ SUBROUTINE SURFCE ENDIF ! ! Time averaged percent SNOW COVER (for AQ) - IF ( IGET(500).GT.0 ) THEN + IF ( IGET(500)>0 ) THEN ! GRID1=SPVAL !$omp parallel do private(i,j) DO J=JSTA,JEND @@ -725,22 +725,22 @@ SUBROUTINE SURFCE CALL BOUND(GRID1,D00,H100) ID(1:25) = 0 ITSRFC = NINT(TSRFC) - IF(ITSRFC .ne. 0) then + IF(ITSRFC /= 0) then IFINCR = MOD(IFHR,ITSRFC) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITSRFC*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITSRFC*60) ELSE IFINCR = 0 endif ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITSRFC ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(500)) @@ -763,11 +763,11 @@ SUBROUTINE SURFCE ENDIF ! Time averaged surface pressure (for AQ) - IF ( IGET(501).GT.0 ) THEN + IF ( IGET(501)>0 ) THEN ! GRID1 = SPVAL ID(1:25) = 0 ID(19) = IFHR - IF (IFHR.EQ.0) THEN + IF (IFHR==0) THEN ID(18) = 0 ELSE ID(18) = IFHR - 1 @@ -789,11 +789,11 @@ SUBROUTINE SURFCE ENDIF ! Time averaged 10 m temperature (for AQ) - IF ( IGET(502).GT.0 ) THEN + IF ( IGET(502)>0 ) THEN ! GRID1 = SPVAL ID(1:25) = 0 ID(19) = IFHR - IF (IFHR.EQ.0) THEN + IF (IFHR==0) THEN ID(18) = 0 ELSE ID(18) = IFHR - 1 @@ -818,7 +818,7 @@ SUBROUTINE SURFCE ENDIF ! ! ACM GRID SCALE SNOW AND ICE - IF ( IGET(244).GT.0 ) THEN + IF ( IGET(244)>0 ) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -828,24 +828,24 @@ SUBROUTINE SURFCE ID(1:25) = 0 ITPREC = NINT(TPREC) !mp - if (ITPREC .ne. 0) then + if (ITPREC /= 0) then IFINCR = MOD(IFHR,ITPREC) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITPREC*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITPREC*60) else IFINCR = 0 endif !mp ID(18) = 0 ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 4 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITPREC ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 if(grib=='grib2') then cfld=cfld+1 @@ -855,7 +855,7 @@ SUBROUTINE SURFCE ENDIF ! ! PERCENT SNOW COVER. - IF ( IGET(120).GT.0 ) THEN + IF ( IGET(120)>0 ) THEN GRID1=SPVAL DO J=JSTA,JEND DO I=1,IM @@ -863,7 +863,7 @@ SUBROUTINE SURFCE IF ( SNO(I,J) /= SPVAL ) THEN SNEQV = SNO(I,J) IVEG = IVGTYP(I,J) - IF(IVEG.EQ.0)IVEG=7 + IF(IVEG==0)IVEG=7 CALL SNFRAC (SNEQV,IVEG,SNCOVR) GRID1(I,J) = SNCOVR*100. ENDIF @@ -883,7 +883,7 @@ SUBROUTINE SURFCE endif ENDIF ! ADD SNOW DEPTH - IF ( IGET(224).GT.0 ) THEN + IF ( IGET(224)>0 ) THEN ii = im/2 jj = (jsta+jend)/2 ! GRID1=SPVAL @@ -908,7 +908,7 @@ SUBROUTINE SURFCE endif ENDIF ! ADD POTENTIAL EVAPORATION - IF ( IGET(242).GT.0 ) THEN + IF ( IGET(242)>0 ) THEN if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(242)) @@ -922,7 +922,7 @@ SUBROUTINE SURFCE endif ENDIF ! ADD ICE THICKNESS - IF ( IGET(349).GT.0 ) THEN + IF ( IGET(349)>0 ) THEN if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(349)) @@ -948,20 +948,20 @@ SUBROUTINE SURFCE ! minval(vegfrc(1:im,jsta:jend)), 'sh2o=',maxval(sh2o(1:im,jsta:jend,1)), & ! minval(sh2o(1:im,jsta:jend,1)),'cmc=',maxval(cmc(1:im,jsta:jend)), & ! minval(cmc(1:im,jsta:jend)) - IF ( IGET(228).GT.0 .OR. IGET(229).GT.0 & - .OR.IGET(230).GT.0 .OR. IGET(231).GT.0 & - .OR.IGET(232).GT.0 .OR. IGET(233).GT.0) THEN + IF ( IGET(228)>0 .OR. IGET(229)>0 & + .OR.IGET(230)>0 .OR. IGET(231)>0 & + .OR.IGET(232)>0 .OR. IGET(233)>0) THEN allocate(smcdry(im,jsta:jend), & smcmax(im,jsta:jend)) DO J=JSTA,JEND DO I=1,IM ! ---------------------------------------------------------------------- -! IF(QWBS(I,J).gt.0.001)print*,'NONZERO QWBS',i,j,QWBS(I,J) -! IF(abs(SM(I,J)-0.).lt.1.0E-5)THEN +! IF(QWBS(I,J)>0.001)print*,'NONZERO QWBS',i,j,QWBS(I,J) +! IF(abs(SM(I,J)-0.)<1.0E-5)THEN ! WRF ARW has no POTEVP field. So has to block out RAPR - IF( (MODELNAME.NE.'RAPR') .AND. (abs(SM(I,J)-0.) .lt. 1.0E-5) .AND. & - & (abs(SICE(I,J)-0.) .lt. 1.0E-5) ) THEN + IF( (MODELNAME/='RAPR') .AND. (abs(SM(I,J)-0.) < 1.0E-5) .AND. & + & (abs(SICE(I,J)-0.) < 1.0E-5) ) THEN CALL ETCALC(QWBS(I,J),POTEVP(I,J),SNO(I,J),VEGFRC(I,J) & & , ISLTYP(I,J),SH2O(I,J,1:1),CMC(I,J) & & , ECAN(I,J),EDIR(I,J),ETRANS(I,J),ESNOW(I,J) & @@ -977,7 +977,7 @@ SUBROUTINE SURFCE ENDDO ENDDO - IF ( IGET(228).GT.0 )THEN + IF ( IGET(228)>0 )THEN if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(228)) @@ -991,7 +991,7 @@ SUBROUTINE SURFCE endiF ENDIF - IF ( IGET(229).GT.0 )THEN + IF ( IGET(229)>0 )THEN if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(229)) @@ -1005,7 +1005,7 @@ SUBROUTINE SURFCE endif ENDIF - IF ( IGET(230).GT.0 )THEN + IF ( IGET(230)>0 )THEN if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(230)) @@ -1013,7 +1013,7 @@ SUBROUTINE SURFCE endif ENDIF - IF ( IGET(231).GT.0 )THEN + IF ( IGET(231)>0 )THEN if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(231)) @@ -1021,7 +1021,7 @@ SUBROUTINE SURFCE endif ENDIF - IF ( IGET(232).GT.0 )THEN + IF ( IGET(232)>0 )THEN if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(232)) @@ -1035,7 +1035,7 @@ SUBROUTINE SURFCE endif ENDIF - IF ( IGET(233).GT.0 )THEN + IF ( IGET(233)>0 )THEN if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(233)) @@ -1059,7 +1059,7 @@ SUBROUTINE SURFCE END IF ! endif for ncar and nmm options - IF ( IGET(512).GT.0 )THEN + IF ( IGET(512)>0 )THEN if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(512)) @@ -1073,25 +1073,25 @@ SUBROUTINE SURFCE endiF ENDIF - IF ( IGET(513).GT.0 )THEN + IF ( IGET(513)>0 )THEN ID(1:25) = 0 ITSRFC = NINT(TSRFC) - IF(ITSRFC .ne. 0) then + IF(ITSRFC /= 0) then IFINCR = MOD(IFHR,ITSRFC) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITSRFC*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITSRFC*60) ELSE IFINCR = 0 endif ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITSRFC ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(513)) @@ -1111,25 +1111,25 @@ SUBROUTINE SURFCE endiF ENDIF - IF ( IGET(514).GT.0 )THEN + IF ( IGET(514)>0 )THEN ID(1:25) = 0 ITSRFC = NINT(TSRFC) - IF(ITSRFC .ne. 0) then + IF(ITSRFC /= 0) then IFINCR = MOD(IFHR,ITSRFC) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITSRFC*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITSRFC*60) ELSE IFINCR = 0 endif ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITSRFC ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(514)) @@ -1149,25 +1149,25 @@ SUBROUTINE SURFCE endif ENDIF - IF ( IGET(515).GT.0 )THEN + IF ( IGET(515)>0 )THEN ID(1:25) = 0 ITSRFC = NINT(TSRFC) - IF(ITSRFC .ne. 0) then + IF(ITSRFC /= 0) then IFINCR = MOD(IFHR,ITSRFC) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITSRFC*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITSRFC*60) ELSE IFINCR = 0 endif ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITSRFC ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(515)) @@ -1181,25 +1181,25 @@ SUBROUTINE SURFCE endif ENDIF - IF ( IGET(516).GT.0 )THEN + IF ( IGET(516)>0 )THEN ID(1:25) = 0 ITSRFC = NINT(TSRFC) - IF(ITSRFC .ne. 0) then + IF(ITSRFC /= 0) then IFINCR = MOD(IFHR,ITSRFC) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITSRFC*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITSRFC*60) ELSE IFINCR = 0 endif ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITSRFC ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(516)) @@ -1220,17 +1220,17 @@ SUBROUTINE SURFCE ! ! COMPUTE/POST SHELTER LEVEL FIELDS. ! - IF ( (IGET(106).GT.0).OR.(IGET(112).GT.0).OR. & - (IGET(113).GT.0).OR.(IGET(114).GT.0).OR. & - (IGET(138).GT.0).OR.(IGET(414).GT.0).OR. & - (IGET(546).GT.0).OR.(IGET(547).GT.0).OR. & - (IGET(548).GT.0).OR.(IGET(739).GT.0).OR. & - (IGET(771).GT.0)) THEN + IF ( (IGET(106)>0).OR.(IGET(112)>0).OR. & + (IGET(113)>0).OR.(IGET(114)>0).OR. & + (IGET(138)>0).OR.(IGET(414)>0).OR. & + (IGET(546)>0).OR.(IGET(547)>0).OR. & + (IGET(548)>0).OR.(IGET(739)>0).OR. & + (IGET(771)>0)) THEN if (.not. allocated(psfc)) allocate(psfc(im,jsta:jend)) ! !HC COMPUTE SHELTER PRESSURE BECAUSE IT WAS NOT OUTPUT FROM WRF - IF(MODELNAME .EQ. 'NCAR' .OR. MODELNAME.EQ.'RSM'.OR. MODELNAME.EQ.'RAPR')THEN + IF(MODELNAME == 'NCAR' .OR. MODELNAME=='RSM'.OR. MODELNAME=='RAPR')THEN DO J=JSTA,JEND DO I=1,IM TLOW = T(I,J,NINT(LMH(I,J))) @@ -1246,14 +1246,14 @@ SUBROUTINE SURFCE ! 'th10=',th10(1:3,jsta:jsta+2),'thz0=',thz0(1:3,jsta:jsta+2) ! ! SHELTER LEVEL TEMPERATURE - IF (IGET(106).GT.0) THEN + IF (IGET(106)>0) THEN ! GRID1=spval DO J=JSTA,JEND DO I=1,IM ! GRID1(I,J)=TSHLTR(I,J) !HC CONVERT FROM THETA TO T if(tshltr(i,j)/=spval)GRID1(I,J)=TSHLTR(I,J)*(PSHLTR(I,J)*1.E-5)**CAPA - IF(GRID1(I,J).LT.200)PRINT*,'ABNORMAL 2MT ',i,j, & + IF(GRID1(I,J)<200)PRINT*,'ABNORMAL 2MT ',i,j, & TSHLTR(I,J),PSHLTR(I,J) ! TSHLTR(I,J)=GRID1(I,J) ENDDO @@ -1268,7 +1268,7 @@ SUBROUTINE SURFCE ENDIF ! ! SHELTER LEVEL POT TEMP - IF (IGET(546).GT.0) THEN + IF (IGET(546)>0) THEN ! GRID1=spval ! DO J=JSTA,JEND ! DO I=1,IM @@ -1283,7 +1283,7 @@ SUBROUTINE SURFCE ENDIF ! ! SHELTER LEVEL SPECIFIC HUMIDITY. - IF (IGET(112).GT.0) THEN + IF (IGET(112)>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J) = QSHLTR(I,J) @@ -1298,7 +1298,7 @@ SUBROUTINE SURFCE ENDIF ! ! SHELTER MIXING RATIO. - IF (IGET(414).GT.0) THEN + IF (IGET(414)>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J) = MRSHLTR(I,J) @@ -1313,7 +1313,7 @@ SUBROUTINE SURFCE ! ! SHELTER LEVEL DEWPOINT, DEWPOINT DEPRESSION AND SFC EQUIV POT TEMP. allocate(p1d(im,jsta:jend), t1d(im,jsta:jend)) - IF ((IGET(113).GT.0) .OR.(IGET(547).GT.0).OR.(IGET(548).GT.0)) THEN + IF ((IGET(113)>0) .OR.(IGET(547)>0).OR.(IGET(548)>0)) THEN DO J=JSTA,JEND DO I=1,IM @@ -1324,8 +1324,8 @@ SUBROUTINE SURFCE e = PSHLTR(I,J)/100.*qv/(0.62197+qv) DWPT = (243.5*LOG(E)-440.8)/(19.48-LOG(E))+273.15 -! if(i.eq.335.and.j.eq.295)print*,'Debug: RUC-type DEWPT,i,j' & -! if(i.eq.ii.and.j.eq.jj)print*,'Debug: RUC-type DEWPT,i,j' +! if(i==335.and.j==295)print*,'Debug: RUC-type DEWPT,i,j' & +! if(i==ii.and.j==jj)print*,'Debug: RUC-type DEWPT,i,j' ! , DWPT,i,j,qv,pshltr(i,j),qshltr(i,j) ! EGRID1(I,J) = DWPT @@ -1337,9 +1337,9 @@ SUBROUTINE SURFCE CALL DEWPOINT(EVP,EGRID1(1,jsta)) ! print *,' MAX DEWPOINT',maxval(egrid1) ! DEWPOINT - IF (IGET(113).GT.0) THEN + IF (IGET(113)>0) THEN GRID1=spval - if(MODELNAME.EQ.'RAPR')THEN + if(MODELNAME=='RAPR')THEN DO J=JSTA,JEND DO I=1,IM ! DEWPOINT can't be higher than T2 @@ -1364,7 +1364,7 @@ SUBROUTINE SURFCE !------------------------------------------------------------------------- ! DEWPOINT at level 1 ------ p1d and t1d are undefined !! -- Moorthi - IF (IGET(771).GT.0) THEN + IF (IGET(771)>0) THEN DO J=JSTA,JEND DO I=1,IM EVP(I,J)=P1D(I,J)*QVl1(I,J)/(EPS+ONEPS*QVl1(I,J)) @@ -1389,7 +1389,7 @@ SUBROUTINE SURFCE !------------------------------------------------------------------------- ! - IF ((IGET(547).GT.0).OR.(IGET(548).GT.0)) THEN + IF ((IGET(547)>0).OR.(IGET(548)>0)) THEN DO J=JSTA,JEND DO I=1,IM ! DEWPOINT DEPRESSION in GRID1 @@ -1405,7 +1405,7 @@ SUBROUTINE SURFCE print *,' MAX/MIN --> SFC EQUIV POT TEMP',maxval(grid2(1:im,jsta:jend)),& minval(grid2(1:im,jsta:jend)) - IF (IGET(547).GT.0) THEN + IF (IGET(547)>0) THEN if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(547)) @@ -1413,7 +1413,7 @@ SUBROUTINE SURFCE endif ENDIF - IF (IGET(548).GT.0) THEN + IF (IGET(548)>0) THEN if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(548)) @@ -1431,7 +1431,7 @@ SUBROUTINE SURFCE !$omp parallel do private(i,j,llmh) DO J=JSTA,JEND DO I=1,IM - IF(MODELNAME.EQ.'RAPR')THEN + IF(MODELNAME=='RAPR')THEN LLMH = NINT(LMH(I,J)) ! P1D(I,J)=PINT(I,J,LLMH+1) P1D(I,J) = PMID(I,J,LLMH) @@ -1531,7 +1531,7 @@ SUBROUTINE SURFCE if (allocated(t1d)) deallocate (t1d) ! ! SHELTER LEVEL PRESSURE. - IF (IGET(138).GT.0) THEN + IF (IGET(138)>0) THEN ! DO J=JSTA,JEND ! DO I=1,IM ! GRID1(I,J)=PSHLTR(I,J) @@ -1553,7 +1553,7 @@ SUBROUTINE SURFCE ENDIF ! ! SHELTER LEVEL MAX TEMPERATURE. - IF (IGET(345).GT.0) THEN + IF (IGET(345)>0) THEN ! DO J=JSTA,JEND ! DO I=1,IM ! GRID1(I,J)=MAXTSHLTR(I,J) @@ -1563,22 +1563,22 @@ SUBROUTINE SURFCE TMAXMIN = MAX(TMAXMIN,1.) !mp ITMAXMIN = INT(TMAXMIN) - IF(ITMAXMIN .ne. 0) then + IF(ITMAXMIN /= 0) then IFINCR = MOD(IFHR,ITMAXMIN) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITMAXMIN*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITMAXMIN*60) ELSE IFINCR = 0 endif ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 2 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITMAXMIN ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(345)) @@ -1600,7 +1600,7 @@ SUBROUTINE SURFCE ENDIF ! ! SHELTER LEVEL MIN TEMPERATURE. - IF (IGET(346).GT.0) THEN + IF (IGET(346)>0) THEN !!$omp parallel do private(i,j) ! DO J=JSTA,JEND ! DO I=1,IM @@ -1609,22 +1609,22 @@ SUBROUTINE SURFCE ! ENDDO ID(1:25) = 0 ITMAXMIN = INT(TMAXMIN) - IF(ITMAXMIN .ne. 0) then + IF(ITMAXMIN /= 0) then IFINCR = MOD(IFHR,ITMAXMIN) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITMAXMIN*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITMAXMIN*60) ELSE IFINCR = 0 endif ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 2 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITMAXMIN ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(346)) @@ -1646,7 +1646,7 @@ SUBROUTINE SURFCE ENDIF ! ! SHELTER LEVEL MAX RH. - IF (IGET(347).GT.0) THEN + IF (IGET(347)>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=MAXRHSHLTR(I,J)*100. @@ -1655,22 +1655,22 @@ SUBROUTINE SURFCE ID(1:25) = 0 ID(02)=129 ITMAXMIN = INT(TMAXMIN) - IF(ITMAXMIN .ne. 0) then + IF(ITMAXMIN /= 0) then IFINCR = MOD(IFHR,ITMAXMIN) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITMAXMIN*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITMAXMIN*60) ELSE IFINCR = 0 endif ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 2 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITMAXMIN ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(347)) @@ -1697,7 +1697,7 @@ SUBROUTINE SURFCE ENDIF ! ! SHELTER LEVEL MIN RH. - IF (IGET(348).GT.0) THEN + IF (IGET(348)>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=MINRHSHLTR(I,J)*100. @@ -1706,22 +1706,22 @@ SUBROUTINE SURFCE ID(1:25) = 0 ID(02)=129 ITMAXMIN = INT(TMAXMIN) - IF(ITMAXMIN .ne. 0) then + IF(ITMAXMIN /= 0) then IFINCR = MOD(IFHR,ITMAXMIN) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITMAXMIN*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITMAXMIN*60) ELSE IFINCR = 0 endif ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 2 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITMAXMIN ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(348)) @@ -1747,25 +1747,25 @@ SUBROUTINE SURFCE ! ! SHELTER LEVEL MAX SPFH - IF (IGET(510).GT.0) THEN + IF (IGET(510)>0) THEN ID(1:25) = 0 ITMAXMIN = INT(TMAXMIN) - IF(ITMAXMIN .ne. 0) then + IF(ITMAXMIN /= 0) then IFINCR = MOD(IFHR,ITMAXMIN) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITMAXMIN*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITMAXMIN*60) ELSE IFINCR = 0 endif ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 2 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITMAXMIN ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(510)) @@ -1786,25 +1786,25 @@ SUBROUTINE SURFCE ENDIF ! ! SHELTER LEVEL MIN SPFH - IF (IGET(511).GT.0) THEN + IF (IGET(511)>0) THEN ID(1:25) = 0 ITMAXMIN = INT(TMAXMIN) - IF(ITMAXMIN .ne. 0) then + IF(ITMAXMIN /= 0) then IFINCR = MOD(IFHR,ITMAXMIN) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITMAXMIN*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITMAXMIN*60) ELSE IFINCR = 0 endif ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 2 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITMAXMIN ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(511)) @@ -1826,7 +1826,7 @@ SUBROUTINE SURFCE ! ! E. James - 12 Sep 2018: SMOKE from WRF-CHEM on lowest model level ! - IF (IGET(739).GT.0) THEN + IF (IGET(739)>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J) = (1./RD)*(PMID(I,J,LM)/T(I,J,LM))*SMOKE(I,J,LM,1) @@ -1841,11 +1841,11 @@ SUBROUTINE SURFCE ! ! BLOCK 3. ANEMOMETER LEVEL (10M) WINDS, THETA, AND Q. ! - IF ( (IGET(064).GT.0).OR.(IGET(065).GT.0).OR. & - (IGET(506).GT.0).OR.(IGET(507).GT.0) ) THEN + IF ( (IGET(064)>0).OR.(IGET(065)>0).OR. & + (IGET(506)>0).OR.(IGET(507)>0) ) THEN ! ! ANEMOMETER LEVEL U WIND AND/OR V WIND. - IF ((IGET(064).GT.0).OR.(IGET(065).GT.0)) THEN + IF ((IGET(064)>0).OR.(IGET(065)>0)) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -1875,7 +1875,7 @@ SUBROUTINE SURFCE endif ENDIF ! GSD - Time-averaged wind speed (forecast time labels will all be in minutes) - IF (IGET(730).GT.0) THEN + IF (IGET(730)>0) THEN IFINCR = 5 DO J=JSTA,JEND DO I=1,IM @@ -1886,8 +1886,8 @@ SUBROUTINE SURFCE print*,'Outputting time-averaged winds' cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(730)) - if(fld_info(cfld)%ntrange.eq.0) then - if (ifhr.eq.0 .and. ifmin.eq.0) then + if(fld_info(cfld)%ntrange==0) then + if (ifhr==0 .and. ifmin==0) then fld_info(cfld)%tinvstat=0 else fld_info(cfld)%tinvstat=IFINCR @@ -1899,7 +1899,7 @@ SUBROUTINE SURFCE ENDIF !--- ! GSD - Time-averaged U wind speed (forecast time labels will all be in minutes) - IF (IGET(731).GT.0) THEN + IF (IGET(731)>0) THEN IFINCR = 5 DO J=JSTA,JEND DO I=1,IM @@ -1909,8 +1909,8 @@ SUBROUTINE SURFCE if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(731)) - if(fld_info(cfld)%ntrange.eq.0) then - if (ifhr.eq.0 .and. ifmin.eq.0) then + if(fld_info(cfld)%ntrange==0) then + if (ifhr==0 .and. ifmin==0) then fld_info(cfld)%tinvstat=0 else fld_info(cfld)%tinvstat=IFINCR @@ -1921,7 +1921,7 @@ SUBROUTINE SURFCE endif ENDIF ! GSD - Time-averaged V wind speed (forecast time labels will all be in minutes) - IF (IGET(732).GT.0) THEN + IF (IGET(732)>0) THEN IFINCR = 5 DO J=JSTA,JEND DO I=1,IM @@ -1931,8 +1931,8 @@ SUBROUTINE SURFCE if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(732)) - if(fld_info(cfld)%ntrange.eq.0) then - if (ifhr.eq.0 .and. ifmin.eq.0) then + if(fld_info(cfld)%ntrange==0) then + if (ifhr==0 .and. ifmin==0) then fld_info(cfld)%tinvstat=0 else fld_info(cfld)%tinvstat=IFINCR @@ -1943,7 +1943,7 @@ SUBROUTINE SURFCE endif ENDIF ! Time-averaged SWDOWN (forecast time labels will all be in minutes) - IF (IGET(733).GT.0 )THEN + IF (IGET(733)>0 )THEN IFINCR = 15 DO J=JSTA,JEND DO I=1,IM @@ -1953,8 +1953,8 @@ SUBROUTINE SURFCE if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(733)) - if(fld_info(cfld)%ntrange.eq.0) then - if (ifhr.eq.0 .and. ifmin.eq.0) then + if(fld_info(cfld)%ntrange==0) then + if (ifhr==0 .and. ifmin==0) then fld_info(cfld)%tinvstat=0 else fld_info(cfld)%tinvstat=IFINCR @@ -1965,7 +1965,7 @@ SUBROUTINE SURFCE endif ENDIF ! Time-averaged SWNORM (forecast time labels will all be in minutes) - IF (IGET(734).GT.0 )THEN + IF (IGET(734)>0 )THEN IFINCR = 15 DO J=JSTA,JEND DO I=1,IM @@ -1975,8 +1975,8 @@ SUBROUTINE SURFCE if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(734)) - if(fld_info(cfld)%ntrange.eq.0) then - if (ifhr.eq.0 .and. ifmin.eq.0) then + if(fld_info(cfld)%ntrange==0) then + if (ifhr==0 .and. ifmin==0) then fld_info(cfld)%tinvstat=0 else fld_info(cfld)%tinvstat=IFINCR @@ -1987,11 +1987,11 @@ SUBROUTINE SURFCE endif ENDIF ! - IF ((IGET(506).GT.0).OR.(IGET(507).GT.0)) THEN + IF ((IGET(506)>0).OR.(IGET(507)>0)) THEN ID(02)=129 ID(20) = 2 ID(19) = IFHR - IF (IFHR.EQ.0) THEN + IF (IFHR==0) THEN ID(18) = 0 ELSE ID(18) = IFHR - 1 @@ -2033,7 +2033,7 @@ SUBROUTINE SURFCE ! ! ANEMOMETER LEVEL (10 M) POTENTIAL TEMPERATURE. ! NOT A OUTPUT FROM WRF - IF (IGET(158).GT.0) THEN + IF (IGET(158)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -2055,7 +2055,7 @@ SUBROUTINE SURFCE ! ANEMOMETER LEVEL (10 M) SENSIBLE TEMPERATURE. ! NOT A OUTPUT FROM WRF - IF (IGET(505).GT.0) THEN + IF (IGET(505)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -2077,7 +2077,7 @@ SUBROUTINE SURFCE ! ! ANEMOMETER LEVEL (10 M) SPECIFIC HUMIDITY. ! - IF (IGET(159).GT.0) THEN + IF (IGET(159)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -2101,7 +2101,7 @@ SUBROUTINE SURFCE ! ! ANEMOMETER LEVEL (10 M) MAX WIND SPEED. ! - IF (IGET(422).GT.0) THEN + IF (IGET(422)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -2111,7 +2111,7 @@ SUBROUTINE SURFCE if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(422)) - if (ifhr.eq.0) then + if (ifhr==0) then fld_info(cfld)%tinvstat=0 else fld_info(cfld)%tinvstat=1 @@ -2129,7 +2129,7 @@ SUBROUTINE SURFCE ! ANEMOMETER LEVEL (10 M) MAX WIND SPEED U COMPONENT. ! - IF (IGET(783).GT.0) THEN + IF (IGET(783)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -2139,7 +2139,7 @@ SUBROUTINE SURFCE if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(783)) - if (ifhr.eq.0) then + if (ifhr==0) then fld_info(cfld)%tinvstat=0 else fld_info(cfld)%tinvstat=1 @@ -2157,7 +2157,7 @@ SUBROUTINE SURFCE ! ANEMOMETER LEVEL (10 M) MAX WIND SPEED V COMPONENT. ! - IF (IGET(784).GT.0) THEN + IF (IGET(784)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -2167,7 +2167,7 @@ SUBROUTINE SURFCE if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(784)) - if (ifhr.eq.0) then + if (ifhr==0) then fld_info(cfld)%tinvstat=0 else fld_info(cfld)%tinvstat=1 @@ -2189,7 +2189,7 @@ SUBROUTINE SURFCE ! Ice Growth Rate ! - IF (IGET(588).GT.0) THEN + IF (IGET(588)>0) THEN CALL CALVESSEL(ICEG(1,jsta)) @@ -2202,7 +2202,7 @@ SUBROUTINE SURFCE if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(588)) - if (ifhr.eq.0) then + if (ifhr==0) then fld_info(cfld)%tinvstat=0 else fld_info(cfld)%tinvstat=1 @@ -2236,11 +2236,11 @@ SUBROUTINE SURFCE ! SNOW FRACTION FROM EXPLICIT CLOUD SCHEME. LABELLED AS ! 'PROB OF FROZEN PRECIP' IN GRIB, ! DIDN'T KNOW WHAT ELSE TO CALL IT - IF (IGET(172).GT.0) THEN + IF (IGET(172)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM - IF (PREC(I,J) .LE. PTHRESH .OR. SR(I,J)==spval) THEN + IF (PREC(I,J) <= PTHRESH .OR. SR(I,J)==spval) THEN GRID1(I,J) = -50. ELSE GRID1(I,J) = SR(I,J)*100. @@ -2262,7 +2262,7 @@ SUBROUTINE SURFCE ! ! INSTANTANEOUS CONVECTIVE PRECIPITATION RATE. ! SUBSTITUTE WITH CUPPT IN WRF FOR NOW - IF (IGET(249).GT.0) THEN + IF (IGET(249)>0) THEN RDTPHS=1000./DTQ2 !--- 1000 kg/m**3, density of liquid water ! RDTPHS=1000./(TRDLW*3600.) !$omp parallel do private(i,j) @@ -2286,7 +2286,7 @@ SUBROUTINE SURFCE ENDIF ! ! INSTANTANEOUS PRECIPITATION RATE. - IF (IGET(167).GT.0) THEN + IF (IGET(167)>0) THEN !MEB need to get physics DT RDTPHS=1./(DTQ2) !MEB need to get physics DT @@ -2314,7 +2314,7 @@ SUBROUTINE SURFCE ENDIF ! ! MAXIMUM INSTANTANEOUS PRECIPITATION RATE. - IF (IGET(508).GT.0) THEN + IF (IGET(508)>0) THEN !-- PRATE_MAX in units of mm/h from NMMB history files DO J=JSTA,JEND DO I=1,IM @@ -2326,7 +2326,7 @@ SUBROUTINE SURFCE fld_info(cfld)%ifld=IAVBLFLD(IGET(508)) fld_info(cfld)%lvl=LVLSXML(1,IGET(508)) fld_info(cfld)%tinvstat=1 - if (IFHR .gt. 0) then + if (IFHR > 0) then fld_info(cfld)%ntrange=1 else fld_info(cfld)%ntrange=0 @@ -2342,7 +2342,7 @@ SUBROUTINE SURFCE ENDIF ! ! MAXIMUM INSTANTANEOUS *FROZEN* PRECIPITATION RATE. - IF (IGET(509).GT.0) THEN + IF (IGET(509)>0) THEN !-- FPRATE_MAX in units of mm/h from NMMB history files DO J=JSTA,JEND DO I=1,IM @@ -2354,7 +2354,7 @@ SUBROUTINE SURFCE fld_info(cfld)%ifld=IAVBLFLD(IGET(509)) fld_info(cfld)%lvl=LVLSXML(1,IGET(509)) fld_info(cfld)%tinvstat=1 - if (IFHR .gt. 0) then + if (IFHR > 0) then fld_info(cfld)%ntrange=1 else fld_info(cfld)%ntrange=0 @@ -2370,29 +2370,29 @@ SUBROUTINE SURFCE ENDIF ! ! TIME-AVERAGED CONVECTIVE PRECIPITATION RATE. - IF (IGET(272).GT.0) THEN + IF (IGET(272)>0) THEN RDTPHS=1000./DTQ2 !--- 1000 kg/m**3, density of liquid water ID(1:25) = 0 ITPREC = NINT(TPREC) !mp - if (ITPREC .ne. 0) then + if (ITPREC /= 0) then IFINCR = MOD(IFHR,ITPREC) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITPREC*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITPREC*60) else IFINCR = 0 endif !mp ID(18) = 0 ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITPREC ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 grid1=spval !$omp parallel do private(i,j) DO J=JSTA,JEND @@ -2426,30 +2426,30 @@ SUBROUTINE SURFCE ENDIF ! ! TIME-AVERAGED PRECIPITATION RATE. - IF (IGET(271).GT.0) THEN + IF (IGET(271)>0) THEN RDTPHS=1000./DTQ2 !--- 1000 kg/m**3, density of liquid water ! RDTPHS=1000./(TRDLW*3600.) ID(1:25) = 0 ITPREC = NINT(TPREC) !mp - if (ITPREC .ne. 0) then + if (ITPREC /= 0) then IFINCR = MOD(IFHR,ITPREC) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITPREC*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITPREC*60) else IFINCR = 0 endif !mp ID(18) = 0 ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITPREC ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 grid1=spval !$omp parallel do private(i,j) DO J=JSTA,JEND @@ -2480,26 +2480,26 @@ SUBROUTINE SURFCE ENDIF ! ! ACCUMULATED TOTAL PRECIPITATION. - IF (IGET(087).GT.0) THEN + IF (IGET(087)>0) THEN ID(1:25) = 0 ITPREC = NINT(TPREC) !mp - if (ITPREC .ne. 0) then + if (ITPREC /= 0) then IFINCR = MOD(IFHR,ITPREC) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITPREC*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITPREC*60) else IFINCR = 0 endif !mp ID(18) = 0 ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 4 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITPREC ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF IF(MODELNAME == 'GFS' .OR. MODELNAME == 'FV3R') THEN !$omp parallel do private(i,j) @@ -2530,12 +2530,12 @@ SUBROUTINE SURFCE ENDDO ENDDO END IF -! IF(IFMIN .GE. 1 .AND. ID(19) .GT. 256)THEN -! IF(ITPREC.EQ.3)ID(17)=10 -! IF(ITPREC.EQ.6)ID(17)=11 -! IF(ITPREC.EQ.12)ID(17)=12 +! IF(IFMIN >= 1 .AND. ID(19) > 256)THEN +! IF(ITPREC==3)ID(17)=10 +! IF(ITPREC==6)ID(17)=11 +! IF(ITPREC==12)ID(17)=12 ! END IF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 ! write(6,*) 'call gribit...total precip' if(grib=='grib2') then cfld=cfld+1 @@ -2569,26 +2569,26 @@ SUBROUTINE SURFCE ! ! CONTINOUS ACCUMULATED TOTAL PRECIPITATION. - IF (IGET(417).GT.0) THEN + IF (IGET(417)>0) THEN ID(1:25) = 0 ITPREC = NINT(TPREC) !mp - if (ITPREC .ne. 0) then + if (ITPREC /= 0) then IFINCR = MOD(IFHR,ITPREC) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITPREC*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITPREC*60) else IFINCR = 0 endif !mp ID(18) = 0 ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 4 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITPREC ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF IF(MODELNAME == 'GFS' .OR. MODELNAME == 'FV3R') THEN ! Chuang 3/29/2018: add continuous bucket @@ -2603,7 +2603,7 @@ SUBROUTINE SURFCE ENDDO ENDDO ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 if(grib=='grib2') then ! add continuous bucket if(MODELNAME == 'GFS' .OR. MODELNAME == 'FV3R') then @@ -2624,28 +2624,28 @@ SUBROUTINE SURFCE ENDIF ! ! ACCUMULATED CONVECTIVE PRECIPITATION. - IF (IGET(033).GT.0) THEN + IF (IGET(033)>0) THEN ID(1:25) = 0 ITPREC = NINT(TPREC) !mp - if (ITPREC .ne. 0) then + if (ITPREC /= 0) then IFINCR = MOD(IFHR,ITPREC) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITPREC*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITPREC*60) else IFINCR = 0 endif !mp ID(18) = 0 ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 4 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITPREC ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 IF(MODELNAME == 'GFS' .OR. MODELNAME == 'FV3R') THEN !$omp parallel do private(i,j) DO J=JSTA,JEND @@ -2706,28 +2706,28 @@ SUBROUTINE SURFCE ENDIF ! CONTINOUS ACCUMULATED CONVECTIVE PRECIPITATION. - IF (IGET(418).GT.0) THEN + IF (IGET(418)>0) THEN ID(1:25) = 0 ITPREC = NINT(TPREC) !mp - if (ITPREC .ne. 0) then + if (ITPREC /= 0) then IFINCR = MOD(IFHR,ITPREC) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITPREC*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITPREC*60) else IFINCR = 0 endif !mp ID(18) = 0 ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 4 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITPREC ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 IF(MODELNAME == 'GFS' .OR. MODELNAME == 'FV3R') THEN ! Chuang 3/29/2018: add continuous bucket !$omp parallel do private(i,j) @@ -2761,29 +2761,29 @@ SUBROUTINE SURFCE ENDIF ! ! ACCUMULATED GRID-SCALE PRECIPITATION. - IF (IGET(034).GT.0) THEN + IF (IGET(034)>0) THEN ID(1:25) = 0 ITPREC = NINT(TPREC) !mp - if (ITPREC .ne. 0) then + if (ITPREC /= 0) then IFINCR = MOD(IFHR,ITPREC) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITPREC*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITPREC*60) else IFINCR = 0 endif !mp ID(18) = 0 ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 4 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITPREC ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 IF(MODELNAME == 'GFS' .OR. MODELNAME == 'FV3R') THEN !$omp parallel do private(i,j) DO J=JSTA,JEND @@ -2845,28 +2845,28 @@ SUBROUTINE SURFCE ENDIF ! CONTINOUS ACCUMULATED GRID-SCALE PRECIPITATION. - IF (IGET(419).GT.0) THEN + IF (IGET(419)>0) THEN ID(1:25) = 0 ITPREC = NINT(TPREC) !mp - if (ITPREC .ne. 0) then + if (ITPREC /= 0) then IFINCR = MOD(IFHR,ITPREC) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITPREC*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITPREC*60) else IFINCR = 0 endif !mp ID(18) = 0 ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 4 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITPREC ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 IF(MODELNAME == 'GFS' .OR. MODELNAME == 'FV3R') THEN ! Chuang 3/29/2018: add continuous bucket !$omp parallel do private(i,j) @@ -2901,7 +2901,7 @@ SUBROUTINE SURFCE ENDIF ! ! ACCUMULATED LAND SURFACE PRECIPITATION. - IF (IGET(256).GT.0) THEN + IF (IGET(256)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -2915,24 +2915,24 @@ SUBROUTINE SURFCE ID(1:25) = 0 ITPREC = NINT(TPREC) !mp - if (ITPREC .ne. 0) then + if (ITPREC /= 0) then IFINCR = MOD(IFHR,ITPREC) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITPREC*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITPREC*60) else IFINCR = 0 endif !mp ID(18) = 0 ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 4 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITPREC ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 ID(02)= 130 if(grib=='grib2') then cfld=cfld+1 @@ -2950,7 +2950,7 @@ SUBROUTINE SURFCE ENDIF ! ! ACCUMULATED SNOWFALL. - IF (IGET(035).GT.0) THEN + IF (IGET(035)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -2961,24 +2961,24 @@ SUBROUTINE SURFCE ID(1:25) = 0 ITPREC = NINT(TPREC) !mp - if (ITPREC .ne. 0) then + if (ITPREC /= 0) then IFINCR = MOD(IFHR,ITPREC) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITPREC*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITPREC*60) else IFINCR = 0 endif !mp ID(18) = 0 ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 4 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITPREC ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(035)) @@ -2995,7 +2995,7 @@ SUBROUTINE SURFCE ENDIF ! ! ACCUMULATED GRAUPEL. - IF (IGET(746).GT.0) THEN + IF (IGET(746)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -3005,24 +3005,24 @@ SUBROUTINE SURFCE ID(1:25) = 0 ITPREC = NINT(TPREC) !mp - if (ITPREC .ne. 0) then + if (ITPREC /= 0) then IFINCR = MOD(IFHR,ITPREC) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITPREC*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITPREC*60) else IFINCR = 0 endif !mp ID(18) = 0 ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 4 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITPREC ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(746)) @@ -3039,7 +3039,7 @@ SUBROUTINE SURFCE ENDIF ! ! ACCUMULATED FREEZING RAIN. - IF (IGET(782).GT.0) THEN + IF (IGET(782)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -3049,24 +3049,24 @@ SUBROUTINE SURFCE ID(1:25) = 0 ITPREC = NINT(TPREC) !mp - if (ITPREC .ne. 0) then + if (ITPREC /= 0) then IFINCR = MOD(IFHR,ITPREC) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITPREC*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITPREC*60) else IFINCR = 0 endif !mp ID(18) = 0 ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 4 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITPREC ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(782)) @@ -3083,7 +3083,7 @@ SUBROUTINE SURFCE ENDIF ! ! ACCUMULATED SNOW MELT. - IF (IGET(121).GT.0) THEN + IF (IGET(121)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -3094,24 +3094,24 @@ SUBROUTINE SURFCE ID(1:25) = 0 ITPREC = NINT(TPREC) !mp - if (ITPREC .ne. 0) then + if (ITPREC /= 0) then IFINCR = MOD(IFHR,ITPREC) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITPREC*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITPREC*60) else IFINCR = 0 endif !mp ID(18) = 0 ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 4 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITPREC ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(121)) @@ -3128,7 +3128,7 @@ SUBROUTINE SURFCE ENDIF ! ! ACCUMULATED SNOWFALL RATE - IF (IGET(405).GT.0) THEN + IF (IGET(405)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -3138,24 +3138,24 @@ SUBROUTINE SURFCE ID(1:25) = 0 ITPREC = NINT(TPREC) !mp - if (ITPREC .ne. 0) then + if (ITPREC /= 0) then IFINCR = MOD(IFHR,ITPREC) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITPREC*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITPREC*60) else IFINCR = 0 endif !mp ID(18) = 0 ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 4 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITPREC ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 IF(ITPREC < 0)ID(1:25)=0 if(grib=='grib2') then cfld=cfld+1 @@ -3173,7 +3173,7 @@ SUBROUTINE SURFCE ENDIF ! ! ACCUMULATED STORM SURFACE RUNOFF. - IF (IGET(122).GT.0) THEN + IF (IGET(122)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -3184,27 +3184,27 @@ SUBROUTINE SURFCE ID(1:25) = 0 ITPREC = NINT(TPREC) !mp - if (ITPREC .ne. 0) then + if (ITPREC /= 0) then IFINCR = MOD(IFHR,ITPREC) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITPREC*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITPREC*60) else IFINCR = 0 endif !mp ID(18) = 0 ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 4 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITPREC ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 ! 1-HR RUNOFF ACCUMULATIONS IN RR - IF (MODELNAME.EQ.'RAPR') THEN - IF (IFHR .GT. 0) THEN + IF (MODELNAME=='RAPR') THEN + IF (IFHR > 0) THEN ID(18)=IFHR-1 ELSE ID(18)=0 @@ -3226,7 +3226,7 @@ SUBROUTINE SURFCE ENDIF ! ! ACCUMULATED BASEFLOW-GROUNDWATER RUNOFF. - IF (IGET(123).GT.0) THEN + IF (IGET(123)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -3237,27 +3237,27 @@ SUBROUTINE SURFCE ID(1:25) = 0 ITPREC = NINT(TPREC) !mp - if (ITPREC .ne. 0) then + if (ITPREC /= 0) then IFINCR = MOD(IFHR,ITPREC) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITPREC*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITPREC*60) else IFINCR = 0 endif !mp ID(18) = IFHR - 1 ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 4 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITPREC ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 ! 1-HR RUNOFF ACCUMULATIONS IN RR - IF (MODELNAME.EQ.'RAPR') THEN - IF (IFHR .GT. 0) THEN + IF (MODELNAME=='RAPR') THEN + IF (IFHR > 0) THEN ID(18)=IFHR-1 ELSE ID(18)=0 @@ -3279,7 +3279,7 @@ SUBROUTINE SURFCE ENDIF ! ! ACCUMULATED WATER RUNOFF. - IF (IGET(343).GT.0) THEN + IF (IGET(343)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -3292,24 +3292,24 @@ SUBROUTINE SURFCE ! so have to change water runoff to use different bucket if(MODELNAME == 'GFS')ITPREC=NINT(tmaxmin) !mp - if (ITPREC .ne. 0) then + if (ITPREC /= 0) then IFINCR = MOD(IFHR,ITPREC) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITPREC*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITPREC*60) else IFINCR = 0 endif !mp ID(18) = 0 ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 4 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITPREC ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(343)) @@ -3327,11 +3327,11 @@ SUBROUTINE SURFCE ! PRECIPITATION BUCKETS - accumulated between output times ! 'BUCKET TOTAL PRECIP ' - IF (IGET(434).GT.0.) THEN + IF (IGET(434)>0.) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM - IF (IFHR .EQ. 0) THEN + IF (IFHR == 0) THEN GRID1(I,J) = 0.0 ELSE GRID1(I,J) = PCP_BUCKET(I,J) @@ -3341,25 +3341,25 @@ SUBROUTINE SURFCE ID(1:25) = 0 ITPREC = NINT(TPREC) !mp - if (ITPREC .ne. 0) then + if (ITPREC /= 0) then IFINCR = MOD(IFHR,ITPREC) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITPREC*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITPREC*60) else IFINCR = 0 endif !mp - if(MODELNAME.EQ.'NCAR' .OR. MODELNAME.EQ.'RAPR') IFINCR = NINT(PREC_ACC_DT)/60 + if(MODELNAME=='NCAR' .OR. MODELNAME=='RAPR') IFINCR = NINT(PREC_ACC_DT)/60 ID(18) = 0 ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 4 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITPREC ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(434)) @@ -3369,8 +3369,8 @@ SUBROUTINE SURFCE fld_info(cfld)%ntrange=0 endif fld_info(cfld)%tinvstat=ITPREC - if(fld_info(cfld)%ntrange.eq.0) then - if (ifhr.eq.0) then + if(fld_info(cfld)%ntrange==0) then + if (ifhr==0) then fld_info(cfld)%tinvstat=0 else fld_info(cfld)%tinvstat=1 @@ -3389,11 +3389,11 @@ SUBROUTINE SURFCE ! PRECIPITATION BUCKETS - accumulated between output times ! 'BUCKET CONV PRECIP ' - IF (IGET(435).GT.0.) THEN + IF (IGET(435)>0.) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM - IF (IFHR .EQ. 0) THEN + IF (IFHR == 0) THEN GRID1(I,J) = 0.0 ELSE GRID1(I,J) = RAINC_BUCKET(I,J) @@ -3403,26 +3403,26 @@ SUBROUTINE SURFCE ID(1:25) = 0 ITPREC = NINT(TPREC) !mp - if (ITPREC .ne. 0) then + if (ITPREC /= 0) then IFINCR = MOD(IFHR,ITPREC) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITPREC*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITPREC*60) else IFINCR = 0 endif - if(MODELNAME.EQ.'NCAR' .OR. MODELNAME.EQ.'RAPR') IFINCR = NINT(PREC_ACC_DT)/60 + if(MODELNAME=='NCAR' .OR. MODELNAME=='RAPR') IFINCR = NINT(PREC_ACC_DT)/60 !mp ID(18) = 0 ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 4 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITPREC ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 ! print *,'IFMIN,IFHR,ITPREC',IFMIN,IFHR,ITPREC if(me==0)print *,'PREC_ACC_DT,ID(18),ID(19)',PREC_ACC_DT,ID(18),ID(19) @@ -3436,8 +3436,8 @@ SUBROUTINE SURFCE fld_info(cfld)%ntrange=0 endif fld_info(cfld)%tinvstat=ITPREC - if(fld_info(cfld)%ntrange.eq.0) then - if (ifhr.eq.0) then + if(fld_info(cfld)%ntrange==0) then + if (ifhr==0) then fld_info(cfld)%tinvstat=0 else fld_info(cfld)%tinvstat=1 @@ -3455,11 +3455,11 @@ SUBROUTINE SURFCE ENDIF ! PRECIPITATION BUCKETS - accumulated between output times ! 'BUCKET GRDSCALE PRCP' - IF (IGET(436).GT.0.) THEN + IF (IGET(436)>0.) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM - IF (IFHR .EQ. 0) THEN + IF (IFHR == 0) THEN GRID1(I,J) = 0.0 ELSE GRID1(I,J) = RAINNC_BUCKET(I,J) @@ -3469,25 +3469,25 @@ SUBROUTINE SURFCE ID(1:25) = 0 ITPREC = NINT(TPREC) !mp - if (ITPREC .ne. 0) then + if (ITPREC /= 0) then IFINCR = MOD(IFHR,ITPREC) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITPREC*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITPREC*60) else IFINCR = 0 endif !mp - if(MODELNAME.EQ.'NCAR' .OR. MODELNAME.EQ.'RAPR') IFINCR = NINT(PREC_ACC_DT)/60 + if(MODELNAME=='NCAR' .OR. MODELNAME=='RAPR') IFINCR = NINT(PREC_ACC_DT)/60 ID(18) = 0 ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 4 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITPREC ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(436)) @@ -3497,8 +3497,8 @@ SUBROUTINE SURFCE fld_info(cfld)%ntrange=0 endif fld_info(cfld)%tinvstat=ITPREC - if(fld_info(cfld)%ntrange.eq.0) then - if (ifhr.eq.0) then + if(fld_info(cfld)%ntrange==0) then + if (ifhr==0) then fld_info(cfld)%tinvstat=0 else fld_info(cfld)%tinvstat=1 @@ -3516,7 +3516,7 @@ SUBROUTINE SURFCE ENDIF ! PRECIPITATION BUCKETS - accumulated between output times ! 'BUCKET SNOW PRECIP ' - IF (IGET(437).GT.0.) THEN + IF (IGET(437)>0.) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -3526,25 +3526,25 @@ SUBROUTINE SURFCE ID(1:25) = 0 ITPREC = NINT(TPREC) !mp - if (ITPREC .ne. 0) then + if (ITPREC /= 0) then IFINCR = MOD(IFHR,ITPREC) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITPREC*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITPREC*60) else IFINCR = 0 endif !mp - if(MODELNAME.EQ.'NCAR' .OR. MODELNAME.EQ.'RAPR') IFINCR = NINT(PREC_ACC_DT)/60 + if(MODELNAME=='NCAR' .OR. MODELNAME=='RAPR') IFINCR = NINT(PREC_ACC_DT)/60 ID(18) = 0 ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 4 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITPREC ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 if(me==0)print*,'maxval BUCKET SNOWFALL: ', maxval(GRID1) if(grib=='grib2') then cfld=cfld+1 @@ -3555,8 +3555,8 @@ SUBROUTINE SURFCE fld_info(cfld)%ntrange=0 endif fld_info(cfld)%tinvstat=ITPREC - if(fld_info(cfld)%ntrange.eq.0) then - if (ifhr.eq.0) then + if(fld_info(cfld)%ntrange==0) then + if (ifhr==0) then fld_info(cfld)%tinvstat=0 else fld_info(cfld)%tinvstat=1 @@ -3574,7 +3574,7 @@ SUBROUTINE SURFCE ENDIF ! PRECIPITATION BUCKETS - accumulated between output times ! 'BUCKET GRAUPEL PRECIP ' - IF (IGET(775).GT.0.) THEN + IF (IGET(775)>0.) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -3584,25 +3584,25 @@ SUBROUTINE SURFCE ID(1:25) = 0 ITPREC = NINT(TPREC) !mp - if (ITPREC .ne. 0) then + if (ITPREC /= 0) then IFINCR = MOD(IFHR,ITPREC) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITPREC*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITPREC*60) else IFINCR = 0 endif !mp - if(MODELNAME.EQ.'NCAR' .OR. MODELNAME.EQ.'RAPR') IFINCR = NINT(PREC_ACC_DT)/60 + if(MODELNAME=='NCAR' .OR. MODELNAME=='RAPR') IFINCR = NINT(PREC_ACC_DT)/60 ID(18) = 0 ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 4 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITPREC ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 print*,'maxval BUCKET GRAUPEL: ', maxval(GRID1) if(grib=='grib2') then cfld=cfld+1 @@ -3613,8 +3613,8 @@ SUBROUTINE SURFCE fld_info(cfld)%ntrange=0 endif fld_info(cfld)%tinvstat=ITPREC - if(fld_info(cfld)%ntrange.eq.0) then - if (ifhr.eq.0) then + if(fld_info(cfld)%ntrange==0) then + if (ifhr==0) then fld_info(cfld)%tinvstat=0 else fld_info(cfld)%tinvstat=1 @@ -3634,11 +3634,11 @@ SUBROUTINE SURFCE ! ERIC JAMES: 10 APR 2019 -- adding 15min precip output for RAP/HRRR ! PRECIPITATION BUCKETS - accumulated between output times ! 'BUCKET1 TOTAL PRECIP ' - IF (IGET(526).GT.0.) THEN + IF (IGET(526)>0.) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM - IF (IFHR .EQ. 0 .AND. IFMIN .EQ. 0) THEN + IF (IFHR == 0 .AND. IFMIN == 0) THEN GRID1(I,J) = 0.0 ELSE GRID1(I,J) = PCP_BUCKET1(I,J) @@ -3649,8 +3649,8 @@ SUBROUTINE SURFCE if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(518)) - if(fld_info(cfld)%ntrange.eq.0) then - if (ifhr.eq.0 .and. ifmin.eq.0) then + if(fld_info(cfld)%ntrange==0) then + if (ifhr==0 .and. ifmin==0) then fld_info(cfld)%tinvstat=0 else fld_info(cfld)%tinvstat=IFINCR @@ -3667,11 +3667,11 @@ SUBROUTINE SURFCE endif ENDIF ! 'BUCKET1 CONV PRECIP ' - IF (IGET(527).GT.0.) THEN + IF (IGET(527)>0.) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM - IF (IFHR .EQ. 0 .AND. IFMIN .EQ. 0) THEN + IF (IFHR == 0 .AND. IFMIN == 0) THEN GRID1(I,J) = 0.0 ELSE GRID1(I,J) = RAINC_BUCKET1(I,J) @@ -3682,8 +3682,8 @@ SUBROUTINE SURFCE if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(519)) - if(fld_info(cfld)%ntrange.eq.0) then - if (ifhr.eq.0 .and. ifmin.eq.0) then + if(fld_info(cfld)%ntrange==0) then + if (ifhr==0 .and. ifmin==0) then fld_info(cfld)%tinvstat=0 else fld_info(cfld)%tinvstat=IFINCR @@ -3700,11 +3700,11 @@ SUBROUTINE SURFCE endif ENDIF ! 'BUCKET1 GRDSCALE PRCP' - IF (IGET(528).GT.0.) THEN + IF (IGET(528)>0.) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM - IF (IFHR .EQ. 0 .AND. IFMIN .EQ. 0) THEN + IF (IFHR == 0 .AND. IFMIN == 0) THEN GRID1(I,J) = 0.0 ELSE GRID1(I,J) = RAINNC_BUCKET1(I,J) @@ -3715,8 +3715,8 @@ SUBROUTINE SURFCE if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(520)) - if(fld_info(cfld)%ntrange.eq.0) then - if (ifhr.eq.0 .and. ifmin.eq.0) then + if(fld_info(cfld)%ntrange==0) then + if (ifhr==0 .and. ifmin==0) then fld_info(cfld)%tinvstat=0 else fld_info(cfld)%tinvstat=IFINCR @@ -3733,11 +3733,11 @@ SUBROUTINE SURFCE endif ENDIF ! 'BUCKET1 SNOW PRECIP ' - IF (IGET(529).GT.0.) THEN + IF (IGET(529)>0.) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM - IF (IFHR .EQ. 0 .AND. IFMIN .EQ. 0) THEN + IF (IFHR == 0 .AND. IFMIN == 0) THEN GRID1(I,J) = 0.0 ELSE GRID1(I,J) = SNOW_BUCKET1(I,J) @@ -3749,8 +3749,8 @@ SUBROUTINE SURFCE if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(521)) - if(fld_info(cfld)%ntrange.eq.0) then - if (ifhr.eq.0 .and. ifmin.eq.0) then + if(fld_info(cfld)%ntrange==0) then + if (ifhr==0 .and. ifmin==0) then fld_info(cfld)%tinvstat=0 else fld_info(cfld)%tinvstat=IFINCR @@ -3767,11 +3767,11 @@ SUBROUTINE SURFCE endif ENDIF ! 'BUCKET1 GRAUPEL PRECIP ' - IF (IGET(530).GT.0.) THEN + IF (IGET(530)>0.) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM - IF (IFHR .EQ. 0 .AND. IFMIN .EQ. 0) THEN + IF (IFHR == 0 .AND. IFMIN == 0) THEN GRID1(I,J) = 0.0 ELSE GRID1(I,J) = GRAUP_BUCKET1(I,J) @@ -3783,8 +3783,8 @@ SUBROUTINE SURFCE if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(522)) - if(fld_info(cfld)%ntrange.eq.0) then - if (ifhr.eq.0 .and. ifmin.eq.0) then + if(fld_info(cfld)%ntrange==0) then + if (ifhr==0 .and. ifmin==0) then fld_info(cfld)%tinvstat=0 else fld_info(cfld)%tinvstat=IFINCR @@ -3803,7 +3803,7 @@ SUBROUTINE SURFCE ! ! INSTANTANEOUS PRECIPITATION TYPE. ! print *,'in surfce,iget(160)=',iget(160),'iget(247)=',iget(247) - IF (IGET(160).GT.0 .OR.(IGET(247).GT.0)) THEN + IF (IGET(160)>0 .OR.(IGET(247)>0)) THEN allocate(sleet(im,jsta:jend,nalg), rain(im,jsta:jend,nalg), & freezr(im,jsta:jend,nalg), snow(im,jsta:jend,nalg)) @@ -3812,7 +3812,7 @@ SUBROUTINE SURFCE ! write(0,*)' after first CALWXT_POST' - IF (IGET(160).GT.0) THEN + IF (IGET(160)>0) THEN !$omp parallel do private(i,j,iwx) DO J=JSTA,JEND DO I=1,IM @@ -3826,7 +3826,7 @@ SUBROUTINE SURFCE ENDIF ! ! LOWEST WET BULB ZERO HEIGHT - IF (IGET(247).GT.0) THEN + IF (IGET(247)>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J) = ZWET(I,J) @@ -3850,7 +3850,7 @@ SUBROUTINE SURFCE !GSM WILL BE CALLED. THE TALLIES ARE THEN SUMMED IN !GSM CALWXT_DOMINANT - IF (IGET(160).GT.0) THEN + IF (IGET(160)>0) THEN ! RAMER ALGORITHM CALL CALWXT_RAMER_POST(T,Q,PMID,PINT,LMH,PREC,IWX1) ! print *,'in SURFCE,me=',me,'IWX1=',IWX1(1:30,JSTA) @@ -3937,7 +3937,7 @@ SUBROUTINE SURFCE domzr(im,jsta:jend), domip(im,jsta:jend)) CALL CALWXT_DOMINANT_POST(PREC(1,jsta_2l),RAIN,FREEZR,SLEET,SNOW, & DOMR,DOMZR,DOMIP,DOMS) -! if ( me.eq.0) print *,'after CALWXT_DOMINANT, no avrg' +! if ( me==0) print *,'after CALWXT_DOMINANT, no avrg' ! SNOW. grid1 = spval !$omp parallel do private(i,j) @@ -3981,7 +3981,7 @@ SUBROUTINE SURFCE !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM -! if (DOMZR(I,J) .EQ. 1) THEN +! if (DOMZR(I,J) == 1) THEN ! PSFC(I,J)=PINT(I,J,NINT(LMH(I,J))+1) ! print *, 'aha ', I, J, PSFC(I,J) ! print *, FREEZR(I,J,1), FREEZR(I,J,2), @@ -4024,7 +4024,7 @@ SUBROUTINE SURFCE ENDIF ! ! TIME AVERAGED PRECIPITATION TYPE. - IF (IGET(317).GT.0) THEN + IF (IGET(317)>0) THEN if (.not. allocated(sleet)) allocate(sleet(im,jsta:jend,nalg)) if (.not. allocated(rain)) allocate(rain(im,jsta:jend,nalg)) @@ -4152,22 +4152,22 @@ SUBROUTINE SURFCE ID(1:25) = 0 ITPREC = NINT(TPREC) !mp - if (ITPREC .ne. 0) then + if (ITPREC /= 0) then IFINCR = MOD(IFHR,ITPREC) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITPREC*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITPREC*60) else IFINCR = 0 endif !mp ID(18) = 0 ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITPREC ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF ! TPREC,'IFHR=',IFHR,'IFMIN=',IFMIN,'IFINCR=',IFINCR,'ID=',ID @@ -4204,22 +4204,22 @@ SUBROUTINE SURFCE ID(8) = 142 ITPREC = NINT(TPREC) !mp - if (ITPREC .ne. 0) then + if (ITPREC /= 0) then IFINCR = MOD(IFHR,ITPREC) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITPREC*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITPREC*60) else IFINCR = 0 endif !mp ID(18) = 0 ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITPREC ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF grid1=spval !$omp parallel do private(i,j) @@ -4251,28 +4251,28 @@ SUBROUTINE SURFCE ITPREC = NINT(TPREC) !mp - if (ITPREC .ne. 0) then + if (ITPREC /= 0) then IFINCR = MOD(IFHR,ITPREC) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITPREC*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITPREC*60) else IFINCR = 0 endif !mp ID(18) = 0 ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITPREC ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF grid1=spval !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM -! if (DOMZR(I,J) .EQ. 1) THEN +! if (DOMZR(I,J) == 1) THEN ! PSFC(I,J)=PINT(I,J,NINT(LMH(I,J))+1) ! print *, 'aha ', I, J, PSFC(I,J) ! print *, FREEZR(I,J,1), FREEZR(I,J,2), @@ -4304,9 +4304,9 @@ SUBROUTINE SURFCE ITPREC = NINT(TPREC) !mp - if (ITPREC .ne. 0) then + if (ITPREC /= 0) then IFINCR = MOD(IFHR,ITPREC) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITPREC*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITPREC*60) else IFINCR = 0 endif @@ -4314,13 +4314,13 @@ SUBROUTINE SURFCE ID(18) = 0 ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITPREC ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF grid1=spval !$omp parallel do private(i,j) @@ -4356,8 +4356,8 @@ SUBROUTINE SURFCE if (allocated(freezr)) deallocate(freezr) ! GSD PRECIPITATION TYPE - IF (IGET(407).GT.0 .or. IGET(559).GT.0 .or. & - IGET(560).GT.0 .or. IGET(561).GT.0) THEN + IF (IGET(407)>0 .or. IGET(559)>0 .or. & + IGET(560)>0 .or. IGET(561)>0) THEN if (.not. allocated(domr)) allocate(domr(im,jsta:jend)) if (.not. allocated(doms)) allocate(doms(im,jsta:jend)) @@ -4406,11 +4406,11 @@ SUBROUTINE SURFCE !-- SNOW is time step non-convective snow [m] ! -- based on either instantaneous snowfall or 1h snowfall and ! snowratio - if( (SNOWNC(i,j)/DT .gt. 0.2e-9 .and. snowratio.ge.0.25) & + if( (SNOWNC(i,j)/DT > 0.2e-9 .and. snowratio>=0.25) & .or. & - (totprcp.gt.0.00001.and.snowratio.ge.0.25)) then + (totprcp>0.00001.and.snowratio>=0.25)) then DOMS(i,j) = 1. - if (t2.ge.276.15) then + if (t2>=276.15) then ! switch snow to rain if 2m temp > 3 deg DOMR(I,J) = 1. DOMS(I,J) = 0. @@ -4424,13 +4424,13 @@ SUBROUTINE SURFCE rainl = (1. - SR(i,j))*prec(i,j)/DT !-- in RUC RAIN is in cm/h and the limit is 1.e-3, !-- converted to m/s will be 2.8e-9 - if((rainl .gt. 2.8e-9 .and. snowratio.lt.0.60) .or. & - (totprcp.gt.0.00001 .and. snowratio.lt.0.60)) then + if((rainl > 2.8e-9 .and. snowratio<0.60) .or. & + (totprcp>0.00001 .and. snowratio<0.60)) then - if (t2.ge.273.15) then + if (t2>=273.15) then !--rain DOMR(I,J) = 1. -! else if (tmax(i,j).gt.273.15) then +! else if (tmax(i,j)>273.15) then !14aug15 - stan else !-- freezing rain @@ -4442,15 +4442,15 @@ SUBROUTINE SURFCE !-- graupel/ice pellets vs. snow or rain ! --------------------------------------------------------------- !-- GRAUPEL is time step non-convective graupel in [m] - if(GRAUPELNC(i,j)/DT .gt. 1.e-9) then - if (t2.le.276.15) then + if(GRAUPELNC(i,j)/DT > 1.e-9) then + if (t2<=276.15) then ! This T2m test excludes convectively based hail ! from cold-season ice pellets. ! check for max rain mixing ratio ! if it's > 0.05 g/kg, => ice pellets - if (qrmax(i,j).gt.0.000005) then - if(GRAUPELNC(i,j) .gt. 0.5*SNOWNC(i,j)) then + if (qrmax(i,j)>0.000005) then + if(GRAUPELNC(i,j) > 0.5*SNOWNC(i,j)) then ! if (instantaneous graupel fall rate > 0.5* ! instantaneous snow fall rate, .... !-- diagnose ice pellets @@ -4458,15 +4458,15 @@ SUBROUTINE SURFCE ! -- If graupel is greater than rain, ! report graupel only -! in RUC --> if (3.6E5*gex2(i,j,8).gt. gex2(i,j,6)) then - if ((GRAUPELNC(i,j)/DT) .gt. rainl) then +! in RUC --> if (3.6E5*gex2(i,j,8)> gex2(i,j,6)) then + if ((GRAUPELNC(i,j)/DT) > rainl) then DOMIP(I,J) = 1. DOMZR(I,J) = 0. DOMR(I,J) = 0. ! -- If rain is greater than 4x graupel, ! report rain only -! in RUC --> else if (gex2(i,j,6).gt.4.*3.6E5*gex2(i,j,8)) then - else if (rainl .gt. (4.*GRAUPELNC(i,j)/DT)) then +! in RUC --> else if (gex2(i,j,6)>4.*3.6E5*gex2(i,j,8)) then + else if (rainl > (4.*GRAUPELNC(i,j)/DT)) then DOMIP(I,J) = 0. end if @@ -4498,8 +4498,8 @@ SUBROUTINE SURFCE DO J=JSTA,JEND DO I=1,IM do icat=1,10 - if (snow_bucket(i,j)*0.1.lt.0.1*float(icat).and. & - snow_bucket(i,j)*0.1.gt.0.1*float(icat-1)) then + if (snow_bucket(i,j)*0.1<0.1*float(icat).and. & + snow_bucket(i,j)*0.1>0.1*float(icat-1)) then cnt_snowratio(icat)=cnt_snowratio(icat)+1 end if end do @@ -4514,7 +4514,7 @@ SUBROUTINE SURFCE icnt_snow_rain_mixed = 0 DO J=JSTA,JEND DO I=1,IM - if (DOMR(i,j).eq.1 .and. DOMS(i,j).eq.1) then + if (DOMR(i,j)==1 .and. DOMS(i,j)==1) then icnt_snow_rain_mixed = icnt_snow_rain_mixed + 1 endif end do @@ -4547,7 +4547,7 @@ SUBROUTINE SURFCE DO J=JSTA,JEND DO I=1,IM GRID1(I,J) = DOMIP(I,J) -! if (DOMIP(I,J) .EQ. 1) THEN +! if (DOMIP(I,J) == 1) THEN ! print *, 'ICE PELLETS at I,J ', I, J ! endif ENDDO @@ -4567,7 +4567,7 @@ SUBROUTINE SURFCE !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM -! if (DOMZR(I,J) .EQ. 1) THEN +! if (DOMZR(I,J) == 1) THEN ! PSFC(I,J)=PINT(I,J,NINT(LMH(I,J))+1) ! print *, 'FREEZING RAIN AT I,J ', I, J, PSFC(I,J) ! endif @@ -4616,13 +4616,13 @@ SUBROUTINE SURFCE !*** BLOCK 5. SURFACE EXCHANGE FIELDS. ! ! TIME AVERAGED SURFACE LATENT HEAT FLUX. - IF (IGET(042).GT.0) THEN - IF(MODELNAME .EQ. 'NCAR'.OR.MODELNAME.EQ.'RSM' .OR. & - MODELNAME.EQ.'RAPR')THEN + IF (IGET(042)>0) THEN + IF(MODELNAME == 'NCAR'.OR.MODELNAME=='RSM' .OR. & + MODELNAME=='RAPR')THEN GRID1=SPVAL ID(1:25)=0 ELSE - IF(ASRFC.GT.0.)THEN + IF(ASRFC>0.)THEN RRNUM=1./ASRFC ELSE RRNUM=0. @@ -4638,22 +4638,22 @@ SUBROUTINE SURFCE ENDDO ID(1:25) = 0 ITSRFC = NINT(TSRFC) - IF(ITSRFC .ne. 0) then + IF(ITSRFC /= 0) then IFINCR = MOD(IFHR,ITSRFC) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITSRFC*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITSRFC*60) ELSE IFINCR = 0 endif ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITSRFC ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(042)) @@ -4669,13 +4669,13 @@ SUBROUTINE SURFCE ENDIF ! ! TIME AVERAGED SURFACE SENSIBLE HEAT FLUX. - IF (IGET(043).GT.0) THEN - IF(MODELNAME .EQ. 'NCAR'.OR.MODELNAME.EQ.'RSM' .OR. & - MODELNAME.EQ.'RAPR')THEN + IF (IGET(043)>0) THEN + IF(MODELNAME == 'NCAR'.OR.MODELNAME=='RSM' .OR. & + MODELNAME=='RAPR')THEN GRID1=SPVAL ID(1:25)=0 ELSE - IF(ASRFC.GT.0.)THEN + IF(ASRFC>0.)THEN RRNUM=1./ASRFC ELSE RRNUM=0. @@ -4691,22 +4691,22 @@ SUBROUTINE SURFCE ENDDO ID(1:25) = 0 ITSRFC = NINT(TSRFC) - IF(ITSRFC .ne. 0) then + IF(ITSRFC /= 0) then IFINCR = MOD(IFHR,ITSRFC) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITSRFC*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITSRFC*60) ELSE IFINCR = 0 endif ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITSRFC ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 END IF if(grib=='grib2') then cfld=cfld+1 @@ -4722,13 +4722,13 @@ SUBROUTINE SURFCE ENDIF ! ! TIME AVERAGED SUB-SURFACE SENSIBLE HEAT FLUX. - IF (IGET(135).GT.0) THEN - IF(MODELNAME .EQ. 'NCAR'.OR.MODELNAME.EQ.'RSM' .OR. & - MODELNAME.EQ.'RAPR')THEN + IF (IGET(135)>0) THEN + IF(MODELNAME == 'NCAR'.OR.MODELNAME=='RSM' .OR. & + MODELNAME=='RAPR')THEN GRID1=SPVAL ID(1:25)=0 ELSE - IF(ASRFC.GT.0.)THEN + IF(ASRFC>0.)THEN RRNUM=1./ASRFC ELSE RRNUM=0. @@ -4740,22 +4740,22 @@ SUBROUTINE SURFCE ENDDO ID(1:25) = 0 ITSRFC = NINT(TSRFC) - IF(ITSRFC .ne. 0) then + IF(ITSRFC /= 0) then IFINCR = MOD(IFHR,ITSRFC) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITSRFC*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITSRFC*60) ELSE IFINCR = 0 endif ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITSRFC ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 END IF if(grib=='grib2') then cfld=cfld+1 @@ -4771,13 +4771,13 @@ SUBROUTINE SURFCE ENDIF ! ! TIME AVERAGED SNOW PHASE CHANGE HEAT FLUX. - IF (IGET(136).GT.0) THEN - IF(MODELNAME .EQ. 'NCAR'.OR.MODELNAME.EQ.'RSM' .OR. & - MODELNAME.EQ.'RAPR')THEN + IF (IGET(136)>0) THEN + IF(MODELNAME == 'NCAR'.OR.MODELNAME=='RSM' .OR. & + MODELNAME=='RAPR')THEN GRID1=SPVAL ID(1:25)=0 ELSE - IF(ASRFC.GT.0.)THEN + IF(ASRFC>0.)THEN RRNUM=1./ASRFC ELSE RRNUM=0. @@ -4789,22 +4789,22 @@ SUBROUTINE SURFCE ENDDO ID(1:25) = 0 ITSRFC = NINT(TSRFC) - IF(ITSRFC .ne. 0) then + IF(ITSRFC /= 0) then IFINCR = MOD(IFHR,ITSRFC) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITSRFC*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITSRFC*60) ELSE IFINCR = 0 endif ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITSRFC ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 END IF if(grib=='grib2') then cfld=cfld+1 @@ -4820,13 +4820,13 @@ SUBROUTINE SURFCE ENDIF ! ! TIME AVERAGED SURFACE MOMENTUM FLUX. - IF (IGET(046).GT.0) THEN - IF(MODELNAME .EQ. 'NCAR'.OR.MODELNAME.EQ.'RSM' .OR. & - MODELNAME.EQ.'RAPR')THEN + IF (IGET(046)>0) THEN + IF(MODELNAME == 'NCAR'.OR.MODELNAME=='RSM' .OR. & + MODELNAME=='RAPR')THEN GRID1=SPVAL ID(1:25)=0 ELSE - IF(ASRFC.GT.0.)THEN + IF(ASRFC>0.)THEN RRNUM=1./ASRFC ELSE RRNUM=0. @@ -4842,22 +4842,22 @@ SUBROUTINE SURFCE ENDDO ID(1:25) = 0 ITSRFC = NINT(TSRFC) - IF(ITSRFC .ne. 0) then + IF(ITSRFC /= 0) then IFINCR = MOD(IFHR,ITSRFC) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITSRFC*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITSRFC*60) ELSE IFINCR = 0 endif ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITSRFC ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 END IF if(grib=='grib2') then cfld=cfld+1 @@ -4873,13 +4873,13 @@ SUBROUTINE SURFCE ENDIF ! ! TIME AVERAGED SURFACE ZONAL MOMENTUM FLUX. - IF (IGET(269).GT.0) THEN - IF(MODELNAME .EQ. 'NCAR'.OR.MODELNAME.EQ.'RSM' .OR. & - MODELNAME.EQ.'RAPR')THEN + IF (IGET(269)>0) THEN + IF(MODELNAME == 'NCAR'.OR.MODELNAME=='RSM' .OR. & + MODELNAME=='RAPR')THEN GRID1=SPVAL ID(1:25)=0 ELSE - IF(ASRFC.GT.0.)THEN + IF(ASRFC>0.)THEN RRNUM=1./ASRFC ELSE RRNUM=0. @@ -4891,22 +4891,22 @@ SUBROUTINE SURFCE ENDDO ID(1:25) = 0 ITSRFC = NINT(TSRFC) - IF(ITSRFC .ne. 0) then + IF(ITSRFC /= 0) then IFINCR = MOD(IFHR,ITSRFC) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITSRFC*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITSRFC*60) ELSE IFINCR = 0 endif ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITSRFC ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 END IF if(grib=='grib2') then cfld=cfld+1 @@ -4922,13 +4922,13 @@ SUBROUTINE SURFCE ENDIF ! ! TIME AVERAGED SURFACE MOMENTUM FLUX. - IF (IGET(270).GT.0) THEN - IF(MODELNAME .EQ. 'NCAR'.OR.MODELNAME.EQ.'RSM' .OR. & - MODELNAME.EQ.'RAPR')THEN + IF (IGET(270)>0) THEN + IF(MODELNAME == 'NCAR'.OR.MODELNAME=='RSM' .OR. & + MODELNAME=='RAPR')THEN GRID1=SPVAL ID(1:25)=0 ELSE - IF(ASRFC.GT.0.)THEN + IF(ASRFC>0.)THEN RRNUM=1./ASRFC ELSE RRNUM=0. @@ -4940,22 +4940,22 @@ SUBROUTINE SURFCE ENDDO ID(1:25) = 0 ITSRFC = NINT(TSRFC) - IF(ITSRFC .ne. 0) then + IF(ITSRFC /= 0) then IFINCR = MOD(IFHR,ITSRFC) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITSRFC*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITSRFC*60) ELSE IFINCR = 0 endif ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITSRFC ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 END IF if(grib=='grib2') then cfld=cfld+1 @@ -4971,7 +4971,7 @@ SUBROUTINE SURFCE ENDIF ! ! ACCUMULATED SURFACE EVAPORATION - IF (IGET(047).GT.0) THEN + IF (IGET(047)>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J) = SFCEVP(I,J)*1000. @@ -4980,24 +4980,24 @@ SUBROUTINE SURFCE ID(1:25) = 0 ITPREC = NINT(TPREC) !mp - if (ITPREC .ne. 0) then + if (ITPREC /= 0) then IFINCR = MOD(IFHR,ITPREC) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITPREC*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITPREC*60) else IFINCR = 0 endif !mp ID(18) = 0 ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 4 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITPREC ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(047)) @@ -5013,7 +5013,7 @@ SUBROUTINE SURFCE ENDIF ! ! ACCUMULATED POTENTIAL EVAPORATION - IF (IGET(137).GT.0) THEN + IF (IGET(137)>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J) = POTEVP(I,J)*1000. @@ -5022,24 +5022,24 @@ SUBROUTINE SURFCE ID(1:25) = 0 ITPREC = NINT(TPREC) !mp - if (ITPREC .ne. 0) then + if (ITPREC /= 0) then IFINCR = MOD(IFHR,ITPREC) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITPREC*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITPREC*60) else IFINCR = 0 endif !mp ID(18) = 0 ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 4 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITPREC ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(137)) @@ -5054,7 +5054,7 @@ SUBROUTINE SURFCE ENDIF ! ! ROUGHNESS LENGTH. - IF (IGET(044).GT.0) THEN + IF (IGET(044)>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J) = Z0(I,J) @@ -5068,7 +5068,7 @@ SUBROUTINE SURFCE ENDIF ! ! FRICTION VELOCITY. - IF (IGET(045).GT.0) THEN + IF (IGET(045)>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J) = USTAR(I,J) @@ -5083,7 +5083,7 @@ SUBROUTINE SURFCE ! ! SURFACE DRAG COEFFICIENT. ! dong add missing value for cd - IF (IGET(132).GT.0) THEN + IF (IGET(132)>0) THEN GRID1=spval CALL CALDRG(EGRID1(1,jsta_2l)) DO J=JSTA,JEND @@ -5124,10 +5124,10 @@ SUBROUTINE SURFCE ENDIF write_ch ! ! MODEL OUTPUT SURFACE U AND/OR V COMPONENT WIND STRESS - IF ( (IGET(900).GT.0) .OR. (IGET(901).GT.0) ) THEN + IF ( (IGET(900)>0) .OR. (IGET(901)>0) ) THEN ! ! MODEL OUTPUT SURFACE U COMPONENT WIND STRESS. - IF (IGET(900).GT.0) THEN + IF (IGET(900)>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=MDLTAUX(I,J) @@ -5142,7 +5142,7 @@ SUBROUTINE SURFCE ENDIF ! ! MODEL OUTPUT SURFACE V COMPONENT WIND STRESS - IF (IGET(901).GT.0) THEN + IF (IGET(901)>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=MDLTAUY(I,J) @@ -5157,14 +5157,14 @@ SUBROUTINE SURFCE ENDIF ! ! SURFACE U AND/OR V COMPONENT WIND STRESS - IF ( (IGET(133).GT.0) .OR. (IGET(134).GT.0) ) THEN + IF ( (IGET(133)>0) .OR. (IGET(134)>0) ) THEN ! dong add missing value GRID1 = spval CALL CALTAU(EGRID1(1,jsta),EGRID2(1,jsta)) ! ! SURFACE U COMPONENT WIND STRESS. ! dong for FV3, directly use model output - IF (IGET(133).GT.0) THEN + IF (IGET(133)>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=EGRID1(I,J) @@ -5182,7 +5182,7 @@ SUBROUTINE SURFCE ENDIF ! ! SURFACE V COMPONENT WIND STRESS - IF (IGET(134).GT.0) THEN + IF (IGET(134)>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=EGRID2(I,J) @@ -5200,10 +5200,10 @@ SUBROUTINE SURFCE ENDIF ! ! GRAVITY U AND/OR V COMPONENT STRESS - IF ( (IGET(315).GT.0) .OR. (IGET(316).GT.0) ) THEN + IF ( (IGET(315)>0) .OR. (IGET(316)>0) ) THEN ! ! GRAVITY U COMPONENT WIND STRESS. - IF (IGET(315).GT.0) THEN + IF (IGET(315)>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J) = GTAUX(I,J) @@ -5211,22 +5211,22 @@ SUBROUTINE SURFCE ENDDO ID(1:25) = 0 ITSRFC = NINT(TSRFC) - IF(ITSRFC .ne. 0) then + IF(ITSRFC /= 0) then IFINCR = MOD(IFHR,ITSRFC) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITSRFC*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITSRFC*60) ELSE IFINCR = 0 endif ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITSRFC ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(315)) @@ -5241,7 +5241,7 @@ SUBROUTINE SURFCE ENDIF ! ! SURFACE V COMPONENT WIND STRESS - IF (IGET(316).GT.0) THEN + IF (IGET(316)>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=GTAUY(I,J) @@ -5249,22 +5249,22 @@ SUBROUTINE SURFCE ENDDO ID(1:25) = 0 ITSRFC = NINT(TSRFC) - IF(ITSRFC .ne. 0) then + IF(ITSRFC /= 0) then IFINCR = MOD(IFHR,ITSRFC) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITSRFC*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITSRFC*60) ELSE IFINCR = 0 endif ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITSRFC ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(316)) @@ -5280,11 +5280,11 @@ SUBROUTINE SURFCE ENDIF ! ! INSTANTANEOUS SENSIBLE HEAT FLUX - IF (IGET(154).GT.0) THEN + IF (IGET(154)>0) THEN ! dong add missing value to shtfl GRID1 = spval - IF(MODELNAME.EQ.'NCAR'.OR.MODELNAME.EQ.'RSM' .OR. & - MODELNAME.EQ.'RAPR')THEN + IF(MODELNAME=='NCAR'.OR.MODELNAME=='RSM' .OR. & + MODELNAME=='RAPR')THEN !4omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -5307,11 +5307,11 @@ SUBROUTINE SURFCE ENDIF ! ! INSTANTANEOUS LATENT HEAT FLUX - IF (IGET(155).GT.0) THEN + IF (IGET(155)>0) THEN ! dong add missing value to lhtfl GRID1 = spval - IF(MODELNAME.EQ.'NCAR'.OR.MODELNAME.EQ.'RSM' .OR. & - MODELNAME.EQ.'RAPR')THEN + IF(MODELNAME=='NCAR'.OR.MODELNAME=='RSM' .OR. & + MODELNAME=='RAPR')THEN !4omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -5334,7 +5334,7 @@ SUBROUTINE SURFCE ENDIF ! ! SURFACE EXCHANGE COEFF - IF (IGET(169).GT.0) THEN + IF (IGET(169)>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=SFCEXC(I,J) @@ -5348,7 +5348,7 @@ SUBROUTINE SURFCE ENDIF ! ! GREEN VEG FRACTION - IF (IGET(170).GT.0) THEN + IF (IGET(170)>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=VEGFRC(I,J)*100. @@ -5363,7 +5363,7 @@ SUBROUTINE SURFCE ! ! MIN GREEN VEG FRACTION - IF (IGET(726).GT.0) THEN + IF (IGET(726)>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=shdmin(I,J)*100. @@ -5377,7 +5377,7 @@ SUBROUTINE SURFCE ENDIF ! ! MAX GREEN VEG FRACTION - IF (IGET(729).GT.0) THEN + IF (IGET(729)>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=shdmax(I,J)*100. @@ -5391,13 +5391,13 @@ SUBROUTINE SURFCE ENDIF ! ! LEAF AREA INDEX - IF (MODELNAME .EQ. 'NCAR'.OR.MODELNAME.EQ.'NMM' .OR. & - MODELNAME .EQ. 'FV3R' .OR. MODELNAME.EQ.'RAPR')THEN - IF (iSF_SURFACE_PHYSICS .EQ. 2 .OR. MODELNAME.EQ.'RAPR') THEN - IF (IGET(254).GT.0) THEN + IF (MODELNAME == 'NCAR'.OR.MODELNAME=='NMM' .OR. & + MODELNAME == 'FV3R' .OR. MODELNAME=='RAPR')THEN + IF (iSF_SURFACE_PHYSICS == 2 .OR. MODELNAME=='RAPR') THEN + IF (IGET(254)>0) THEN DO J=JSTA,JEND DO I=1,IM - IF (MODELNAME.EQ.'RAPR')THEN + IF (MODELNAME=='RAPR')THEN GRID1(I,J)=LAI(I,J) ELSE GRID1(I,J) = XLAI @@ -5414,7 +5414,7 @@ SUBROUTINE SURFCE ENDIF ! ! INSTANTANEOUS GROUND HEAT FLUX - IF (IGET(152).GT.0) THEN + IF (IGET(152)>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=GRNFLX(I,J) @@ -5427,7 +5427,7 @@ SUBROUTINE SURFCE endif ENDIF ! VEGETATION TYPE - IF (IGET(218).GT.0) THEN + IF (IGET(218)>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J) = FLOAT(IVGTYP(I,J)) @@ -5441,7 +5441,7 @@ SUBROUTINE SURFCE ENDIF ! ! SOIL TYPE - IF (IGET(219).GT.0) THEN + IF (IGET(219)>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J) = FLOAT(ISLTYP(I,J)) @@ -5454,7 +5454,7 @@ SUBROUTINE SURFCE endif ENDIF ! SLOPE TYPE - IF (IGET(223).GT.0) THEN + IF (IGET(223)>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J) = FLOAT(ISLOPE(I,J)) @@ -5470,22 +5470,22 @@ SUBROUTINE SURFCE ! ! CANOPY CONDUCTANCE ! ONLY OUTPUT NEW LSM FIELDS FOR NMM AND ARW BECAUSE RSM USES OLD SOIL TYPES - IF (MODELNAME .EQ. 'NCAR'.OR.MODELNAME.EQ.'NMM' .OR. & - MODELNAME .EQ. 'FV3R' .OR. MODELNAME.EQ.'RAPR')THEN - IF (IGET(220).GT.0 .OR. IGET(234).GT.0 & - & .OR. IGET(235).GT.0 .OR. IGET(236).GT.0 & - & .OR. IGET(237).GT.0 .OR. IGET(238).GT.0 & - & .OR. IGET(239).GT.0 .OR. IGET(240).GT.0 & - & .OR. IGET(241).GT.0 ) THEN - IF (iSF_SURFACE_PHYSICS .EQ. 2) THEN !NSOIL == 4 + IF (MODELNAME == 'NCAR'.OR.MODELNAME=='NMM' .OR. & + MODELNAME == 'FV3R' .OR. MODELNAME=='RAPR')THEN + IF (IGET(220)>0 .OR. IGET(234)>0 & + & .OR. IGET(235)>0 .OR. IGET(236)>0 & + & .OR. IGET(237)>0 .OR. IGET(238)>0 & + & .OR. IGET(239)>0 .OR. IGET(240)>0 & + & .OR. IGET(241)>0 ) THEN + IF (iSF_SURFACE_PHYSICS == 2) THEN !NSOIL == 4 if(me==0)print*,'starting computing canopy conductance' allocate(rsmin(im,jsta:jend), smcref(im,jsta:jend), gc(im,jsta:jend), & rcq(im,jsta:jend), rct(im,jsta:jend), rcsoil(im,jsta:jend), rcs(im,jsta:jend)) DO J=JSTA,JEND DO I=1,IM - IF( (abs(SM(I,J)-0.) .lt. 1.0E-5) .AND. & - & (abs(SICE(I,J)-0.) .lt. 1.0E-5) ) THEN - IF(CZMEAN(I,J).GT.1.E-6) THEN + IF( (abs(SM(I,J)-0.) < 1.0E-5) .AND. & + & (abs(SICE(I,J)-0.) < 1.0E-5) ) THEN + IF(CZMEAN(I,J)>1.E-6) THEN FACTRS = CZEN(I,J)/CZMEAN(I,J) ELSE FACTRS = 0.0 @@ -5496,10 +5496,10 @@ SUBROUTINE SURFCE SFCTMP = T(I,J,LLMH) SFCQ = Q(I,J,LLMH) SFCPRS = PINT(I,J,LLMH+1) -! IF(IVGTYP(I,J).EQ.0)PRINT*,'IVGTYP ZERO AT ',I,J +! IF(IVGTYP(I,J)==0)PRINT*,'IVGTYP ZERO AT ',I,J ! & ,SM(I,J) IVG = IVGTYP(I,J) -! IF(IVGTYP(I,J).EQ.0)IVG=7 +! IF(IVGTYP(I,J)==0)IVG=7 ! CALL CANRES(SOLAR,SFCTMP,SFCQ,SFCPRS ! & ,SMC(I,J,1:NSOIL),GC(I,J),RC,IVG,ISLTYP(I,J)) ! @@ -5507,7 +5507,7 @@ SUBROUTINE SURFCE & ,SH2O(I,J,1:NSOIL),GC(I,J),RC,IVG,ISLTYP(I,J) & & ,RSMIN(I,J),NROOTS(I,J),SMCWLT(I,J),SMCREF(I,J) & & ,RCS(I,J),RCQ(I,J),RCT(I,J),RCSOIL(I,J),SLDPTH) - IF(abs(SMCWLT(I,J)-0.5).lt.1.e-5)print*, & + IF(abs(SMCWLT(I,J)-0.5)<1.e-5)print*, & & 'LARGE SMCWLT',i,j,SM(I,J),ISLTYP(I,J),SMCWLT(I,J) ELSE GC(I,J) = 0. @@ -5523,7 +5523,7 @@ SUBROUTINE SURFCE ENDDO ENDDO - IF (IGET(220).GT.0 )THEN + IF (IGET(220)>0 )THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J) = GC(I,J) @@ -5536,7 +5536,7 @@ SUBROUTINE SURFCE endif ENDIF - IF (IGET(234).GT.0 )THEN + IF (IGET(234)>0 )THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J) = RSMIN(I,J) @@ -5549,7 +5549,7 @@ SUBROUTINE SURFCE endif ENDIF - IF (IGET(235).GT.0 )THEN + IF (IGET(235)>0 )THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J) = FLOAT(NROOTS(I,J)) @@ -5562,7 +5562,7 @@ SUBROUTINE SURFCE endif ENDIF - IF (IGET(236).GT.0 )THEN + IF (IGET(236)>0 )THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J) = SMCWLT(I,J) @@ -5575,7 +5575,7 @@ SUBROUTINE SURFCE endif ENDIF - IF (IGET(237).GT.0 )THEN + IF (IGET(237)>0 )THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J) = SMCREF(I,J) @@ -5588,7 +5588,7 @@ SUBROUTINE SURFCE endif ENDIF - IF (IGET(238).GT.0 )THEN + IF (IGET(238)>0 )THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J) = RCS(I,J) @@ -5601,7 +5601,7 @@ SUBROUTINE SURFCE endif ENDIF - IF (IGET(239).GT.0 )THEN + IF (IGET(239)>0 )THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J) = RCT(I,J) @@ -5614,7 +5614,7 @@ SUBROUTINE SURFCE endif ENDIF - IF (IGET(240).GT.0 )THEN + IF (IGET(240)>0 )THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J) = RCQ(I,J) @@ -5627,7 +5627,7 @@ SUBROUTINE SURFCE endif ENDIF - IF (IGET(241).GT.0 )THEN + IF (IGET(241)>0 )THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J) = RCSOIL(I,J) @@ -5653,9 +5653,9 @@ SUBROUTINE SURFCE END IF !GPL added endif here ENDIF - IF(MODELNAME .EQ. 'GFS')THEN + IF(MODELNAME == 'GFS')THEN ! Outputting wilting point and field capacity for TIGGE - IF(IGET(236).GT.0)THEN + IF(IGET(236)>0)THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -5680,7 +5680,7 @@ SUBROUTINE SURFCE endif ENDIF - IF(IGET(397).GT.0)THEN + IF(IGET(397)>0)THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -5705,7 +5705,7 @@ SUBROUTINE SURFCE endif ENDIF END IF - IF(IGET(396).GT.0)THEN + IF(IGET(396)>0)THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -5714,22 +5714,22 @@ SUBROUTINE SURFCE ENDDO ID(1:25) = 0 ITSRFC = NINT(TSRFC) - IF(ITSRFC .ne. 0) then + IF(ITSRFC /= 0) then IFINCR = MOD(IFHR,ITSRFC) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITSRFC*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITSRFC*60) ELSE IFINCR = 0 endif ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITSRFC ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(396)) @@ -5749,7 +5749,7 @@ SUBROUTINE SURFCE endif ENDIF - IF(IGET(517).GT.0)THEN + IF(IGET(517)>0)THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -5758,22 +5758,22 @@ SUBROUTINE SURFCE ENDDO ID(1:25) = 0 ITSRFC = NINT(TSRFC) - IF(ITSRFC .ne. 0) then + IF(ITSRFC /= 0) then IFINCR = MOD(IFHR,ITSRFC) - IF(IFMIN .GE. 1)IFINCR= MOD(IFHR*60+IFMIN,ITSRFC*60) + IF(IFMIN >= 1)IFINCR= MOD(IFHR*60+IFMIN,ITSRFC*60) ELSE IFINCR = 0 endif ID(19) = IFHR - IF(IFMIN .GE. 1)ID(19)=IFHR*60+IFMIN + IF(IFMIN >= 1)ID(19)=IFHR*60+IFMIN ID(20) = 3 - IF (IFINCR.EQ.0) THEN + IF (IFINCR==0) THEN ID(18) = IFHR-ITSRFC ELSE ID(18) = IFHR-IFINCR - IF(IFMIN .GE. 1)ID(18)=IFHR*60+IFMIN-IFINCR + IF(IFMIN >= 1)ID(18)=IFHR*60+IFMIN-IFINCR ENDIF - IF (ID(18).LT.0) ID(18) = 0 + IF (ID(18)<0) ID(18) = 0 if(grib=='grib2') then cfld=cfld+1 fld_info(cfld)%ifld=IAVBLFLD(IGET(517)) @@ -5796,7 +5796,7 @@ SUBROUTINE SURFCE ! ! ! MODEL TOP REQUESTED BY CMAQ - IF (IGET(282).GT.0) THEN + IF (IGET(282)>0) THEN !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM @@ -5811,7 +5811,7 @@ SUBROUTINE SURFCE ENDIF ! ! PRESSURE THICKNESS REQUESTED BY CMAQ - IF (IGET(283).GT.0) THEN + IF (IGET(283)>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=PDTOP @@ -5820,7 +5820,7 @@ SUBROUTINE SURFCE ID(1:25) = 0 IF(ME == 0)THEN DO L=1,LM - IF(PMID(1,1,L).GE.(PDTOP+PT))EXIT + IF(PMID(1,1,L)>=(PDTOP+PT))EXIT END DO PRINT*,'hybrid boundary ',L END IF @@ -5835,7 +5835,7 @@ SUBROUTINE SURFCE ENDIF ! ! SIGMA PRESSURE THICKNESS REQUESTED BY CMAQ - IF (IGET(273).GT.0) THEN + IF (IGET(273)>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=PD(I,J) @@ -5844,7 +5844,7 @@ SUBROUTINE SURFCE IF(ME == 0)THEN DO L=1,LM ! print*,'Debug CMAQ: ',L,PINT(1,1,LM+1),PD(1,1),PINT(1,1,L) - IF((PINT(1,1,LM+1)-PD(1,1)).LE.(PINT(1,1,L)+1.00))EXIT + IF((PINT(1,1,LM+1)-PD(1,1))<=(PINT(1,1,L)+1.00))EXIT END DO PRINT*,'hybrid boundary ',L END IF @@ -5860,7 +5860,7 @@ SUBROUTINE SURFCE ! TIME-AVERAGED EXCHANGE COEFFICIENTS FOR MASS REQUESTED FOR CMAQ - IF (IGET(503).GT.0) THEN + IF (IGET(503)>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=AKHSAVG(I,J) @@ -5869,7 +5869,7 @@ SUBROUTINE SURFCE ID(1:25) = 0 ID(02)= 133 ID(19) = IFHR - IF (IFHR.EQ.0) THEN + IF (IFHR==0) THEN ID(18) = 0 ELSE ID(18) = IFHR - 1 @@ -5885,7 +5885,7 @@ SUBROUTINE SURFCE ENDIF ! TIME-AVERAGED EXCHANGE COEFFICIENTS FOR WIND REQUESTED FOR CMAQ - IF (IGET(504).GT.0) THEN + IF (IGET(504)>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=AKMSAVG(I,J) @@ -5894,7 +5894,7 @@ SUBROUTINE SURFCE ID(1:25) = 0 ID(02)= 133 ID(19) = IFHR - IF (IFHR.EQ.0) THEN + IF (IFHR==0) THEN ID(18) = 0 ELSE ID(18) = IFHR - 1 @@ -5912,7 +5912,7 @@ SUBROUTINE SURFCE ! TIME-AVERAGED EXCHANGE COEFFICIENTS FOR MASS REQUESTED FOR CMAQ - IF (IGET(503).GT.0) THEN + IF (IGET(503)>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=AKHSAVG(I,J) @@ -5921,7 +5921,7 @@ SUBROUTINE SURFCE ID(1:25) = 0 ID(02)= 133 ID(19) = IFHR - IF (IFHR.EQ.0) THEN + IF (IFHR==0) THEN ID(18) = 0 ELSE ID(18) = IFHR - 1 @@ -5937,7 +5937,7 @@ SUBROUTINE SURFCE ENDIF ! TIME-AVERAGED EXCHANGE COEFFICIENTS FOR WIND REQUESTED FOR CMAQ - IF (IGET(504).GT.0) THEN + IF (IGET(504)>0) THEN DO J=JSTA,JEND DO I=1,IM GRID1(I,J)=AKMSAVG(I,J) @@ -5946,7 +5946,7 @@ SUBROUTINE SURFCE ID(1:25) = 0 ID(02)= 133 ID(19) = IFHR - IF (IFHR.EQ.0) THEN + IF (IFHR==0) THEN ID(18) = 0 ELSE ID(18) = IFHR - 1 diff --git a/sorc/ncep_post.fd/TABLE.f b/sorc/ncep_post.fd/TABLE.f index 420d3f1d8..190b845aa 100644 --- a/sorc/ncep_post.fd/TABLE.f +++ b/sorc/ncep_post.fd/TABLE.f @@ -113,7 +113,7 @@ SUBROUTINE TABLE(PTBL,TTBL,PT & else APE = (100000./P)**(R/CP) DENOM = TH - A4*APE - IF (DENOM .GT. EPS) THEN + IF (DENOM > EPS) THEN QS = PQ0/P*EXP(A2*(TH-A3*APE)/DENOM) ELSE QS = 0. @@ -133,7 +133,7 @@ SUBROUTINE TABLE(PTBL,TTBL,PT & ! DO KTH=2,KTHM1 THEOLD(KTH)=(THEOLD(KTH)-THE0K)/STHEK - IF((THEOLD(KTH)-THEOLD(KTH-1)).LT.EPS) & + IF((THEOLD(KTH)-THEOLD(KTH-1)) 2000.) .AND. & + (DZ2(LL+1) > 2000.)) GO TO 15 DELT2(LL) = T(I,J,LL-2)-T(I,J,L) TLAPSE2(LL) = -DELT2(LL)/DZ2(LL) ! - IF (TLAPSE2(LL) .GT. CRTLAP) THEN + IF (TLAPSE2(LL) > CRTLAP) THEN CYCLE loopL ENDIF ! diff --git a/sorc/ncep_post.fd/TRPAUS_NAM.f b/sorc/ncep_post.fd/TRPAUS_NAM.f index e3ab1fa11..caf8785f4 100644 --- a/sorc/ncep_post.fd/TRPAUS_NAM.f +++ b/sorc/ncep_post.fd/TRPAUS_NAM.f @@ -102,8 +102,8 @@ SUBROUTINE TRPAUS(PTROP,TTROP,ZTROP,UTROP,VTROP,SHTROP) DZ = D50*(ZINT(I,J,L-1)-ZINT(I,J,L+1)) TLAPSE(L) = -DELT/DZ ! - IF ((TLAPSE(L).LT.CRTLAP).AND.(PM.LT.PSTART)) THEN - IF (L .EQ. 2 .AND. TLAPSE(L) .LT. CRTLAP) GOTO15 + IF ((TLAPSE(L) 2000.) .AND. & + (DZ2(LL+1) > 2000.)) GO TO 15 DELT2(LL) = T(I,J,LL-2)-T(I,J,L) TLAPSE2(LL) = -DELT2(LL)/DZ2(LL) ! - IF (TLAPSE2(LL) .GT. CRTLAP) THEN + IF (TLAPSE2(LL) > CRTLAP) THEN CYCLE loopL ENDIF ! diff --git a/sorc/ncep_post.fd/WETBULB.f b/sorc/ncep_post.fd/WETBULB.f index e73793f91..feab60343 100644 --- a/sorc/ncep_post.fd/WETBULB.f +++ b/sorc/ncep_post.fd/WETBULB.f @@ -62,7 +62,7 @@ SUBROUTINE WETBULB(T,Q,PMID,HTM,KARR,TWET) DO 300 L=1,LM DO 125 J=JSTA,JEND DO 125 I=1,IM - IF (HTM(I,J,L).LT.1.0) THEN + IF (HTM(I,J,L)<1.0) THEN THESP(I,J)=273.15 cycle ENDIF @@ -70,19 +70,19 @@ SUBROUTINE WETBULB(T,Q,PMID,HTM,KARR,TWET) QBTK =Q(I,J,L) PRESK =PMID(I,J,L) APEBTK=(H10E5/PRESK)**CAPA - IF(QBTK.LT.EPSQ) QBTK=HTM(I,J,L)*EPSQ + IF(QBTK=JTB) THEN ITTB1 =JTB-1 QQK =D00 ENDIF @@ -99,12 +99,12 @@ SUBROUTINE WETBULB(T,Q,PMID,HTM,KARR,TWET) PPK=TQK-AINT(TQK) IQTBK=INT(TQK)+1 !--------------KEEPING INDICES WITHIN THE TABLE------------------------- - IF(IQTBK.LT.1) THEN + IF(IQTBK<1) THEN IQTBK =1 PPK =D00 ENDIF ! - IF(IQTBK.GE.ITB) THEN + IF(IQTBK>=ITB) THEN IQTBK=ITB-1 PPK =D00 ENDIF @@ -131,10 +131,10 @@ SUBROUTINE WETBULB(T,Q,PMID,HTM,KARR,TWET) KLRES(I,J)=0 KHRES(I,J)=0 ! -! IF(KARR(I,J).GT.0)THEN +! IF(KARR(I,J)>0)THEN PRESK=PMID(I,J,L) ! - IF(PRESK.LT.PLQ)THEN + IF(PRESK0)THEN CALL TTBLEX(TWET(1,jsta_2l,L),TTBL,ITB,JTB,KLRES & ,PMID(1,jsta_2l,L),PL,QQ,PP,RDP,THE0,STHE & ,RDTHE,THESP,IPTB,ITHTB) @@ -154,7 +154,7 @@ SUBROUTINE WETBULB(T,Q,PMID,HTM,KARR,TWET) !*** !*** COMPUTE PARCEL TEMPERATURE ALONG MOIST ADIABAT FOR PRESSURE>PL !** - IF(KNUMH.GT.0)THEN + IF(KNUMH>0)THEN CALL TTBLEX(TWET(1,jsta_2l,L),TTBLQ,ITBQ,JTBQ,KHRES & ,PMID(1,jsta_2l,L),PLQ,QQ,PP,RDPQ,THE0Q,STHEQ & ,RDTHEQ,THESP,IPTB,ITHTB) diff --git a/sorc/ncep_post.fd/WETFRZLVL.f b/sorc/ncep_post.fd/WETFRZLVL.f index 878cc1fa5..d44d7c8dc 100644 --- a/sorc/ncep_post.fd/WETFRZLVL.f +++ b/sorc/ncep_post.fd/WETFRZLVL.f @@ -87,7 +87,7 @@ SUBROUTINE WETFRZLVL(TWET,ZWET) PSFC = PINT(I,J,LLMH+1) TSFC = THSFC*(PSFC/P1000)**CAPA - IF (TSFC.LE.TFRZ) THEN + IF (TSFC<=TFRZ) THEN ! ZWET(I,J) = HTSFC ZWET(I,J) = HTSFC+(TSFC-TFRZ)/D0065 CYCLE @@ -96,8 +96,8 @@ SUBROUTINE WETFRZLVL(TWET,ZWET) ! OTHERWISE, LOCATE THE FREEZING LEVEL ALOFT. ! loopL:DO L = LLMH,1,-1 - IF (TWET(I,J,L).LE.TFRZ) THEN - IF (L.LT.LLMH-1) THEN + IF (TWET(I,J,L)<=TFRZ) THEN + IF (L ZU) THEN ZWET(I,J)=ZU ENDIF - IF ((-1*ZWET(I,J)) .GT. ZU) THEN + IF ((-1*ZWET(I,J)) > ZU) THEN ZWET(I,J)=ZU endif ENDIF diff --git a/sorc/ncep_post.fd/WRFPOST.f b/sorc/ncep_post.fd/WRFPOST.f index 89e88290a..f674a2ba6 100644 --- a/sorc/ncep_post.fd/WRFPOST.f +++ b/sorc/ncep_post.fd/WRFPOST.f @@ -864,7 +864,7 @@ PROGRAM WRFPOST ! ! READ CONTROL FILE DIRECTING WHICH FIELDS ON WHICH ! LEVELS AND TO WHICH GRID TO INTERPOLATE DATA TO. -! VARIABLE IEOF.NE.0 WHEN THERE ARE NO MORE GRIDS TO PROCESS. +! VARIABLE IEOF/=0 WHEN THERE ARE NO MORE GRIDS TO PROCESS. ! ! -------- grib1 processing --------------- ! ------------------ diff --git a/sorc/ncep_post.fd/WRF_STUBS.f b/sorc/ncep_post.fd/WRF_STUBS.f index 6b633ae64..049ee504f 100644 --- a/sorc/ncep_post.fd/WRF_STUBS.f +++ b/sorc/ncep_post.fd/WRF_STUBS.f @@ -1,25 +1,30 @@ integer function wrf_sizeof_integer() + implicit none integer i wrf_sizeof_integer=STORAGE_SIZE(i) end function wrf_sizeof_integer real function wrf_sizeof_real() + implicit none real i wrf_sizeof_real=STORAGE_SIZE(i) end function wrf_sizeof_real subroutine wrf_debug(n,s) + implicit none integer :: n character*(*) :: s if(n<2) print '(A)',trim(s) end subroutine wrf_debug subroutine wrf_message(s) + implicit none character*(*) :: s print '(A)',trim(s) end subroutine wrf_message subroutine wrf_error_fatal(s) + implicit none use mpi character*(*) :: s integer :: i diff --git a/sorc/ncep_post.fd/ZENSUN.f b/sorc/ncep_post.fd/ZENSUN.f index 712ac732e..a0c0412fb 100644 --- a/sorc/ncep_post.fd/ZENSUN.f +++ b/sorc/ncep_post.fd/ZENSUN.f @@ -123,20 +123,20 @@ subroutine zensun(day,time,lat,lon,pi,sun_zenith,sun_azimuth) tt= mod(real((int(day)+time/24.-1.)),365.25) +1. ! fractional day number ! with 12am 1jan = 1. do di = 1, 73 - if ((tt .ge. nday(di)) .and. (tt .le. nday(di+1))) exit + if ((tt >= nday(di)) .and. (tt <= nday(di+1))) exit end do !============== Perform a least squares regression on doy**3 ============== x(1,:) = 1.0 - if ((di .ge. 3) .and. (di .le. 72)) then + if ((di >= 3) .and. (di <= 72)) then y(:) = eqt(di-2:di+2) y2(:) = dec(di-2:di+2) x(2,:) = nday(di-2:di+2)**3 end if - if (di .eq. 2) then + if (di == 2) then y(1) = eqt(73) y(2:5) = eqt(di-1:di+2) y2(1) = dec(73) @@ -145,7 +145,7 @@ subroutine zensun(day,time,lat,lon,pi,sun_zenith,sun_azimuth) x(2,1) = nday(73)**3 x(2,2:5) = (365.+nday(di-1:di+2))**3 end if - if (di .eq. 1) then + if (di == 1) then y(1:2) = eqt(72:73) y(3:5) = eqt(di:di+2) y2(1:2) = dec(72:73) @@ -154,7 +154,7 @@ subroutine zensun(day,time,lat,lon,pi,sun_zenith,sun_azimuth) x(2,1:2) = nday(72:73)**3 x(2,3:5) = (365.+nday(di:di+2))**3 end if - if (di .eq. 73) then + if (di == 73) then y(1:4) = eqt(di-2:di+1) y(5) = eqt(2) y2(1:4) = dec(di-2:di+1) @@ -163,7 +163,7 @@ subroutine zensun(day,time,lat,lon,pi,sun_zenith,sun_azimuth) x(2,1:4) = nday(di-2:di+1)**3 x(2,5) = (365.+nday(2))**3 end if - if (di .eq. 74) then + if (di == 74) then y(1:3) = eqt(di-2:di) y(4:5) = eqt(2:3) y2(1:3) = dec(di-2:di) @@ -210,7 +210,7 @@ subroutine zensun(day,time,lat,lon,pi,sun_zenith,sun_azimuth) !============== finished least squares regression on doy**3 ============== - if ((di .lt. 3) .or. (di .gt. 72)) tt = tt + 365. + if ((di < 3) .or. (di > 72)) tt = tt + 365. eqtime=(beta(1) + beta(2)*tt**3)/60. decang=beta2(1) + beta2(2)*tt**3 diff --git a/sorc/ncep_post.fd/cuparm.f b/sorc/ncep_post.fd/cuparm.f index 2ee0d6a9f..2de97b119 100644 --- a/sorc/ncep_post.fd/cuparm.f +++ b/sorc/ncep_post.fd/cuparm.f @@ -21,7 +21,7 @@ module cuparm_mod ! AUGUST '91: SCHEME HAVING THE OPTION OF USING DIFFERENT FAST AND ! SLOW PROFILES FOR SEA AND FOR LAND POINTS; AND ALSO THE "SEA" AND ! THE "LAND" SCHEME EVERYWHERE. OVER LAND PROFILES DEPART FROM THE -! FAST (DRY) PROFILES ONLY FOR PRECIPITATION/TIME STEP .GT. +! FAST (DRY) PROFILES ONLY FOR PRECIPITATION/TIME STEP > ! A PRESCRIBED VALUE (CURRENTLY, IN THE VERSION #3 DONE WEDNESDAY ! 18 SEPTEMBER, 1/4 INCH/24 H). USE OF VARIOUS SWITCHES AS FOLLOWS. ! diff --git a/sorc/ncep_post.fd/getIVariableN.f b/sorc/ncep_post.fd/getIVariableN.f index 3980fe880..8f1f62cd9 100644 --- a/sorc/ncep_post.fd/getIVariableN.f +++ b/sorc/ncep_post.fd/getIVariableN.f @@ -109,13 +109,13 @@ subroutine getIVariableN(fileName,DateStr,dh,VarName,VarBuff,IM,JSTA_2L,JEND_2U, VarBuff = 0.0 return ENDIF - if (im1.gt.end_index(1)) write(*,*) 'Err:',Varname,' IM1=',im1,& + if (im1>end_index(1)) write(*,*) 'Err:',Varname,' IM1=',im1,& ' but data dim=',end_index(1) - if (je.gt.end_index(2)) write(*,*) 'Err:',Varname,' JE=',je,& + if (je>end_index(2)) write(*,*) 'Err:',Varname,' JE=',je,& ' but data dim=',end_index(2) - if (lm1.gt.end_index(3)) write(*,*) 'Err:',Varname,' LM1=',lm1,& + if (lm1>end_index(3)) write(*,*) 'Err:',Varname,' LM1=',lm1,& ' but data dim=',end_index(3) - if (ndim.gt.3) then + if (ndim>3) then write(*,*) 'Error: ndim = ',ndim endif do l=1,lm1 diff --git a/sorc/ncep_post.fd/getVariable.f b/sorc/ncep_post.fd/getVariable.f index b73c9ccf5..24804549b 100644 --- a/sorc/ncep_post.fd/getVariable.f +++ b/sorc/ncep_post.fd/getVariable.f @@ -99,7 +99,7 @@ subroutine getVariable(fileName,DateStr,dh,VarName,VarBuff,IM,JSTA_2L,JEND_2U,LM ! CHANGE WrfType to WRF_REAL BECAUSE THIS TELLS WRF IO API TO CONVERT TO REAL print *,' GWVX XT_NCD GET FIELD',size(data), size(varbuff),mype idsize=size(data) - if(mype .eq. 0) then + if(mype == 0) then call ext_ncd_read_field(dh,DateStr,TRIM(VarName),data,WrfType,0,0,0,ordering,& staggering, dimnames , & start_index,end_index, & !dom @@ -117,13 +117,13 @@ subroutine getVariable(fileName,DateStr,dh,VarName,VarBuff,IM,JSTA_2L,JEND_2U,LM VarBuff = 0.0 return ENDIF - if (im1.gt.end_index(1)) write(*,*) 'Err:',Varname,' IM1=',im1,& + if (im1>end_index(1)) write(*,*) 'Err:',Varname,' IM1=',im1,& ' but data dim=',end_index(1) - if (je.gt.end_index(2)) write(*,*) 'Err:',Varname,' JE=',je,& + if (je>end_index(2)) write(*,*) 'Err:',Varname,' JE=',je,& ' but data dim=',end_index(2) - if (lm1.gt.end_index(3)) write(*,*) 'Err:',Varname,' LM1=',lm1,& + if (lm1>end_index(3)) write(*,*) 'Err:',Varname,' LM1=',lm1,& ' but data dim=',end_index(3) - if (ndim.gt.3) then + if (ndim>3) then write(*,*) 'Error: ndim = ',ndim endif do l=1,lm1 diff --git a/sorc/ncep_post.fd/get_postfilename.f b/sorc/ncep_post.fd/get_postfilename.f index f75412152..38222918b 100644 --- a/sorc/ncep_post.fd/get_postfilename.f +++ b/sorc/ncep_post.fd/get_postfilename.f @@ -43,11 +43,11 @@ subroutine get_postfilename(fname) CALL GETENV('IPVOUT',IPVOUT) CALL GETENV('D3DOUT',D3DOUT) KDAT = INDEX(DATSET,' ') -1 - IF (KDAT.LE.0) KDAT = LEN(DATSET) + IF (KDAT<=0) KDAT = LEN(DATSET) KENV = INDEX(ENVAR,' ') -1 - IF (KENV.LE.0) KENV = LEN(ENVAR) + IF (KENV<=0) KENV = LEN(ENVAR) KTHR = INDEX(RESTHR,' ') -1 - IF (KTHR.LE.0) KTHR = LEN(RESTHR) + IF (KTHR<=0) KTHR = LEN(RESTHR) if(me==0) print *,'PGBOUT=',trim(PGBOUT) ! if(me==0)print *,'in get postfilename, ritehd=',ritehd,'ifhr=',ifhr,'modelname=',modelname, & @@ -56,29 +56,29 @@ subroutine get_postfilename(fname) ! ! CONSTRUCT FULL PATH-FILENAME FOR OUTPUT FILE IF(MODELNAME=='GFS')THEN - IF(D3DOUT(1:4).NE.BLANK .AND. & - ((IGET(354).GT.0).OR.(IGET(355).GT.0).OR. & - (IGET(356).GT.0).OR.(IGET(357).GT.0).OR. & - (IGET(358).GT.0).OR.(IGET(359).GT.0).OR. & - (IGET(360).GT.0).OR.(IGET(361).GT.0).OR. & - (IGET(362).GT.0).OR.(IGET(363).GT.0).OR. & - (IGET(364).GT.0).OR.(IGET(365).GT.0).OR. & - (IGET(366).GT.0).OR.(IGET(367).GT.0).OR. & - (IGET(368).GT.0).OR.(IGET(369).GT.0).OR. & - (IGET(370).GT.0).OR.(IGET(371).GT.0).OR. & - (IGET(372).GT.0).OR.(IGET(373).GT.0).OR. & - (IGET(374).GT.0).OR.(IGET(375).GT.0)))THEN + IF(D3DOUT(1:4)/=BLANK .AND. & + ((IGET(354)>0).OR.(IGET(355)>0).OR. & + (IGET(356)>0).OR.(IGET(357)>0).OR. & + (IGET(358)>0).OR.(IGET(359)>0).OR. & + (IGET(360)>0).OR.(IGET(361)>0).OR. & + (IGET(362)>0).OR.(IGET(363)>0).OR. & + (IGET(364)>0).OR.(IGET(365)>0).OR. & + (IGET(366)>0).OR.(IGET(367)>0).OR. & + (IGET(368)>0).OR.(IGET(369)>0).OR. & + (IGET(370)>0).OR.(IGET(371)>0).OR. & + (IGET(372)>0).OR.(IGET(373)>0).OR. & + (IGET(374)>0).OR.(IGET(375)>0)))THEN FNAME = D3DOUT if(me==0)PRINT*,' FNAME FROM D3DOUT=',trim(FNAME) - ELSE IF(IPVOUT(1:4).NE.BLANK .AND. & + ELSE IF(IPVOUT(1:4)/=BLANK .AND. & index(DATSET(1:KDAT),"IPV")>0 .AND. & - ((IGET(332).GT.0).OR.(IGET(333).GT.0).OR. & - (IGET(334).GT.0).OR.(IGET(335).GT.0).OR. & - (IGET(351).GT.0).OR.(IGET(352).GT.0).OR. & - (IGET(353).GT.0).OR.(IGET(378).GT.0)))THEN + ((IGET(332)>0).OR.(IGET(333)>0).OR. & + (IGET(334)>0).OR.(IGET(335)>0).OR. & + (IGET(351)>0).OR.(IGET(352)>0).OR. & + (IGET(353)>0).OR.(IGET(378)>0)))THEN FNAME = IPVOUT if(me==0)PRINT*,' FNAME FROM IPVOUT=',trim(FNAME) - ELSE IF(PGBOUT(1:4).NE.BLANK)THEN + ELSE IF(PGBOUT(1:4)/=BLANK)THEN FNAME = PGBOUT if(me==0)PRINT*,' FNAME FROM PGBOUT=',trim(FNAME) ELSE @@ -89,12 +89,12 @@ subroutine get_postfilename(fname) FNAME = DATSET(1:KDAT) //'.GrbF'// CFHOUR if(me==0)print *,' FNAME=',trim(FNAME) END IF -! IF(MODELNAME=='GFS'.AND.PGBOUT(1:4).NE.BLANK)THEN +! IF(MODELNAME=='GFS'.AND.PGBOUT(1:4)/=BLANK)THEN ! FNAME = PGBOUT ! PRINT*,' FNAME FROM PGBOUT=',trim(FNAME) ! - ELSEIF (ENVAR(1:4).EQ.BLANK.AND.RESTHR(1:4).EQ.BLANK) THEN - IF(IFMIN .GE. 1)THEN + ELSEIF (ENVAR(1:4)==BLANK.AND.RESTHR(1:4)==BLANK) THEN + IF(IFMIN >= 1)THEN WRITE(DESCR2,1011) IHR WRITE(DESCR3,1012) IFMIN FNAME = DATSET(1:KDAT) // TRIM(DESCR2) //'.'// DESCR3(1:2) @@ -106,7 +106,7 @@ subroutine get_postfilename(fname) FNAME = DATSET(1:KDAT) //'.GrbF'// CFHOUR if(me==0)print *,' FNAME=',trim(FNAME) ! -! IF(IHR.LT.100)THEN +! IF(IHR<100)THEN ! WRITE(DESCR2,1011) IHR ! ELSE ! WRITE(DESCR2,1013) IHR @@ -116,10 +116,10 @@ subroutine get_postfilename(fname) ! FNAME = DATSET(1:KDAT) // DESCR2 END IF ! - ELSEIF(ENVAR(1:4).EQ.BLANK.AND.RESTHR(1:4).NE.BLANK) THEN - IF(IFMIN .GE. 1)THEN + ELSEIF(ENVAR(1:4)==BLANK.AND.RESTHR(1:4)/=BLANK) THEN + IF(IFMIN >= 1)THEN WRITE(DESCR3,1012) IFMIN - IF (IHR.LT.100) THEN + IF (IHR<100) THEN WRITE(DESCR2,1012) IHR FNAME = DATSET(1:KDAT) // DESCR2(1:2) //'.'// DESCR3(1:2) & //'.'// RESTHR @@ -129,7 +129,7 @@ subroutine get_postfilename(fname) //'.'// RESTHR ENDIF ELSE - IF (IHR.LT.100) THEN + IF (IHR<100) THEN WRITE(DESCR2,1012) IHR FNAME = DATSET(1:KDAT) // DESCR2(1:2) //'.'// RESTHR ELSE @@ -138,9 +138,9 @@ subroutine get_postfilename(fname) ENDIF end if ELSE - IF(IFMIN .GE. 1)THEN + IF(IFMIN >= 1)THEN WRITE(DESCR3,1012) IFMIN - IF (IHR.LT.100) THEN + IF (IHR<100) THEN WRITE(DESCR2,1012) IHR FNAME = ENVAR(1:KENV) // DATSET(1:KDAT) // DESCR2(1:2) & //'.'// DESCR3(1:2) //'.'// RESTHR @@ -150,7 +150,7 @@ subroutine get_postfilename(fname) //'.'// DESCR3(1:2) //'.'// RESTHR ENDIF ELSE - IF (IHR.LT.100) THEN + IF (IHR<100) THEN WRITE(DESCR2,1012) IHR FNAME = ENVAR(1:KENV) // DATSET(1:KDAT) // DESCR2(1:2) & //'.'// RESTHR diff --git a/sorc/ncep_post.fd/grib2_module.f b/sorc/ncep_post.fd/grib2_module.f index 8ba63d8cd..b944d84d8 100644 --- a/sorc/ncep_post.fd/grib2_module.f +++ b/sorc/ncep_post.fd/grib2_module.f @@ -169,7 +169,7 @@ subroutine grib_info_init() if(first_grbtbl) then fl_nametbl='params_grib2_tbl_new' call open_and_read_4dot2( fl_nametbl, ierr ) - if ( ierr .ne. 0 ) then + if ( ierr /= 0 ) then print*, 'Couldnt open table file - return code was ',ierr call mpi_abort() endif @@ -297,7 +297,7 @@ subroutine gribit2(post_fname) nlvl=fld_info(i)%lvl fldlvl1=fld_info(i+snfld_pe(me+1)-1)%lvl1 fldlvl2=fld_info(i+snfld_pe(me+1)-1)%lvl2 - if(trim(pset%param(nprm)%table_info).eq.'NCEP') then + if(trim(pset%param(nprm)%table_info)=='NCEP') then itblinfo=1 else itblinfo=0 @@ -386,7 +386,7 @@ subroutine gribit2(post_fname) fldlvl2=fld_info(i+snfld_pe(me+1)-1)%lvl2 ntrange=fld_info(i+snfld_pe(me+1)-1)%ntrange leng_time_range_stat=fld_info(i+snfld_pe(me+1)-1)%tinvstat - if(trim(pset%param(nprm)%table_info).eq.'NCEP') then + if(trim(pset%param(nprm)%table_info)=='NCEP') then itblinfo=1 else itblinfo=0 @@ -612,9 +612,9 @@ subroutine gengrb2msg(idisc,icatg, iparm,nprm,nlvl,fldlvl1,fldlvl2,ntrange,tinvs if(trim(pset%gen_proc)=='gefs') then listsec1(2)=2 ! Settings below for control (1 or 2) vs perturbed (3 or 4) ensemble forecast - if(e1_type.eq.1.or.e1_type.eq.2) then + if(e1_type==1.or.e1_type==2) then listsec1(13)=3 - elseif(e1_type.eq.3.or.e1_type.eq.4) then + elseif(e1_type==3.or.e1_type==4) then listsec1(13)=4 endif print *, "After g2sec1 call we need to set listsec1(2) = ",listsec1(2) @@ -636,7 +636,7 @@ subroutine gengrb2msg(idisc,icatg, iparm,nprm,nlvl,fldlvl1,fldlvl2,ntrange,tinvs trim(pset%param(nprm)%pname)=='vgrd')) call getgds(ldfgrd,igdsmaxlen,igdtlen,igds,igdstmpl) idefnum=1 - ideflist=0 !Used if igds(3) .ne. 0. Dummy array otherwise + ideflist=0 !Used if igds(3) /= 0. Dummy array otherwise ! call addgrid(cgrib,max_bytes,igds,igdstmpl,igdtlen,ideflist,idefnum,ierr) ! @@ -1117,13 +1117,13 @@ subroutine g2getbits(MXBIT,ibm,scl,len,bmap,g,ibs,ids,nbits) ibs = 0 ids = 0 range = GMAX - GMIN -! IF ( range .le. 0.00 ) THEN - IF ( range .le. 1.e-30 ) THEN +! IF ( range <= 0.00 ) THEN + IF ( range <= 1.e-30 ) THEN nbits = 8 return END IF !* - IF ( scl .eq. 0.0 ) THEN + IF ( scl == 0.0 ) THEN nbits = 8 RETURN ELSE IF ( scl > 0.0 ) THEN @@ -1135,7 +1135,7 @@ subroutine g2getbits(MXBIT,ibm,scl,len,bmap,g,ibs,ids,nbits) return endif - IF ( range .lt. 1.00 ) ipo = ipo - 1 + IF ( range < 1.00 ) ipo = ipo - 1 po = float(ipo) - scl + 1. ids = - INT ( po ) rr = range * 10. ** ( -po ) @@ -1175,7 +1175,7 @@ subroutine g2getbits(MXBIT,ibm,scl,len,bmap,g,ibs,ids,nbits) if (bmap(i1)) exit enddo ! I1=1 - ! DO WHILE(I1.LE.LEN.AND..not.BMAP(I1)) + ! DO WHILE(I1<=LEN.AND..not.BMAP(I1)) ! I1=I1+1 ! ENDDO IF(I1 <= LEN) THEN @@ -1285,7 +1285,7 @@ subroutine getgds(ldfgrd,len3,ifield3len,igds,ifield3) ifield3(18) = 64 ! !** Mercator - ELSE IF(MAPTYPE.EQ.3)THEN !Mercator + ELSE IF(MAPTYPE==3)THEN !Mercator igds(5)=10 ifield3len=22 ifield3=0 diff --git a/sorc/ncep_post.fd/gtg_algo.f90 b/sorc/ncep_post.fd/gtg_algo.f90 index 66c786354..69bbc00e5 100644 --- a/sorc/ncep_post.fd/gtg_algo.f90 +++ b/sorc/ncep_post.fd/gtg_algo.f90 @@ -1,3 +1,4 @@ subroutine gtg_algo() + implicit none print *, "Stub code for GTG protection but to make UPP public to work" end subroutine gtg_algo diff --git a/sorc/ncep_post.fd/gtg_compute.f90 b/sorc/ncep_post.fd/gtg_compute.f90 index 911005141..0bc95b9d0 100644 --- a/sorc/ncep_post.fd/gtg_compute.f90 +++ b/sorc/ncep_post.fd/gtg_compute.f90 @@ -1,3 +1,4 @@ subroutine GTGcompF() + implicit none print *, "Stub code for GTG protection but to make UPP public to work" end subroutine GTGcompF diff --git a/sorc/ncep_post.fd/gtg_config.f90 b/sorc/ncep_post.fd/gtg_config.f90 index 400b7f120..71317e075 100644 --- a/sorc/ncep_post.fd/gtg_config.f90 +++ b/sorc/ncep_post.fd/gtg_config.f90 @@ -1,6 +1,7 @@ module gtg_config contains subroutine read_config() + implicit none print *, "Stub code for GTG protection but to make UPP public to work" end subroutine read_config end module gtg_config diff --git a/sorc/ncep_post.fd/gtg_ctlblk.f90 b/sorc/ncep_post.fd/gtg_ctlblk.f90 index b733594d2..0c5eb445c 100644 --- a/sorc/ncep_post.fd/gtg_ctlblk.f90 +++ b/sorc/ncep_post.fd/gtg_ctlblk.f90 @@ -1,2 +1,3 @@ module gtg_ctlblk + implicit none end module gtg_ctlblk diff --git a/sorc/ncep_post.fd/gtg_filter.f90 b/sorc/ncep_post.fd/gtg_filter.f90 index 7802fe1fd..0af041b1a 100644 --- a/sorc/ncep_post.fd/gtg_filter.f90 +++ b/sorc/ncep_post.fd/gtg_filter.f90 @@ -1,6 +1,7 @@ module gtg_filter contains subroutine filt3d() + implicit none print *, "Stub code for GTG protection but to make UPP public to work" end subroutine filt3d end module gtg_filter diff --git a/sorc/ncep_post.fd/gtg_indices.f90 b/sorc/ncep_post.fd/gtg_indices.f90 index a109d4562..eff35708e 100644 --- a/sorc/ncep_post.fd/gtg_indices.f90 +++ b/sorc/ncep_post.fd/gtg_indices.f90 @@ -1,6 +1,7 @@ module gtg_indices contains subroutine indices_gtg() + implicit none print *, "Stub code for GTG protection but to make UPP public to work" end subroutine indices_gtg end module gtg_indices diff --git a/sorc/ncep_post.fd/map_routines.f90 b/sorc/ncep_post.fd/map_routines.f90 index 955a8e66b..e6e8d261e 100644 --- a/sorc/ncep_post.fd/map_routines.f90 +++ b/sorc/ncep_post.fd/map_routines.f90 @@ -1,4 +1,5 @@ subroutine get_map_factor() + implicit none print *, "Stub code for GTG protection but to make UPP public to work" end subroutine get_map_factor diff --git a/sorc/ncep_post.fd/wrf_io_flags.f b/sorc/ncep_post.fd/wrf_io_flags.f index 89a002e60..fbd773e52 100644 --- a/sorc/ncep_post.fd/wrf_io_flags.f +++ b/sorc/ncep_post.fd/wrf_io_flags.f @@ -1,4 +1,5 @@ module wrf_io_flags_mod + implicit none integer, parameter :: WRF_FILE_NOT_OPENED = 100 integer, parameter :: WRF_FILE_OPENED_NOT_COMMITTED = 101 integer, parameter :: WRF_FILE_OPENED_AND_COMMITTED = 102 diff --git a/sorc/ncep_post.fd/xml_perl_data.f b/sorc/ncep_post.fd/xml_perl_data.f index 1e3dd9f94..a17ac307b 100644 --- a/sorc/ncep_post.fd/xml_perl_data.f +++ b/sorc/ncep_post.fd/xml_perl_data.f @@ -80,6 +80,7 @@ subroutine read_postxconfig() use rqstfld_mod,only: num_post_afld,MXLVL,lvlsxml use CTLBLK_mod, only:tprec,tclod,trdlw,trdsw,tsrfc & ,tmaxmin,td3d,me,filenameflat + implicit none ! Read in the flat file postxconfig-NT.txt ! for current working parameters and param @@ -212,7 +213,7 @@ subroutine read_postxconfig() ! allocate( paramset(i)%param(j)%scale_fact_fixed_sfc1(1)) - if (cc .gt. 0) then + if (cc > 0) then ! deallocate( paramset(i)%param(j)%scale_fact_fixed_sfc1) @@ -228,7 +229,7 @@ subroutine read_postxconfig() read(22,*)level_array_count allocate( paramset(i)%param(j)%level(1)) - if (level_array_count .gt. 0) then + if (level_array_count > 0) then deallocate( paramset(i)%param(j)%level) allocate( paramset(i)%param(j)%level(level_array_count)) read(22,*)paramset(i)%param(j)%level @@ -241,7 +242,7 @@ subroutine read_postxconfig() call filter_char_inp(paramset(i)%param(j)%fixed_sfc2_type) read(22,*)cv allocate( paramset(i)%param(j)%scale_fact_fixed_sfc2(1)) - if (cv .gt. 0) then + if (cv > 0) then deallocate(paramset(i)%param(j)%scale_fact_fixed_sfc2) allocate(paramset(i)%param(j)%scale_fact_fixed_sfc2(cv)) read(22,*)paramset(i)%param(j)%scale_fact_fixed_sfc2 @@ -251,7 +252,7 @@ subroutine read_postxconfig() endif read(22,*)level2_array_count - if (level2_array_count .gt. 0) then + if (level2_array_count > 0) then allocate(paramset(i)%param(j)%level2(level2_array_count)) read(22,*)paramset(i)%param(j)%level2 else @@ -276,7 +277,7 @@ subroutine read_postxconfig() read(22,*)paramset(i)%param(j)%scale_val_2nd_wvlen read(22,*)scale_array_count allocate(paramset(i)%param(j)%scale(1)) - if (scale_array_count .gt. 0) then + if (scale_array_count > 0) then deallocate(paramset(i)%param(j)%scale) allocate(paramset(i)%param(j)%scale(scale_array_count)) read(22,*)paramset(i)%param(j)%scale @@ -308,8 +309,9 @@ end subroutine read_postxconfig subroutine filter_char_inp (inpchar) + implicit none character, intent(inout) :: inpchar - if (inpchar .eq. "?") then + if (inpchar == "?") then inpchar = "" endif end subroutine filter_char_inp