Regional inlinepost

sorc/ncep_post.fd/AllGETHERV_GSD.f

@@ -10,7 +10,7 @@ SUBROUTINE AllGETHERV(GRID1)
 ! PROGRAM HISTORY LOG:
 !
 
-     use ctlblk_mod, only : im,jm,num_procs,me,jsta,jend
+     use ctlblk_mod, only : im,jm,num_procs,me,jsta,jend,mpi_comm_comp
 
      implicit none
 
@@ -28,7 +28,7 @@ SUBROUTINE AllGETHERV(GRID1)
 !     write(*,*) 'check mpi', im,jm,num_procs,me,jsta,jend
      SENDCOUNT=im*(jend-jsta+1)
      call MPI_ALLGATHER(SENDCOUNT, 1, MPI_INTEGER, RECVCOUNTS,1 , &
-                MPI_INTEGER, MPI_COMM_WORLD, ierr)
+                MPI_INTEGER, mpi_comm_comp, ierr)
      DISPLS(1)=0
      do i=2,num_procs
          DISPLS(i)=DISPLS(i-1)+RECVCOUNTS(i-1)
@@ -50,7 +50,7 @@ SUBROUTINE AllGETHERV(GRID1)
      endif
 
      call MPI_ALLGATHERV(ibufsend, ij, MPI_REAL, ibufrecv, RECVCOUNTS,DISPLS, &
-                MPI_REAL, MPI_COMM_WORLD, ierr)
+                MPI_REAL, mpi_comm_comp, ierr)
 
      ij=0
      do j=1,JM

sorc/ncep_post.fd/CALGUST.f

@@ -113,6 +113,8 @@ SUBROUTINE CALGUST(LPBL,ZPBL,GUST)
              IE = I + MOD(J+1,2) 
              IW = I + MOD(J+1,2)-1
 
+           if(U10H(I,J)<spval.and.UH(I,J+1,L)<spval.and.UH(IE,J,L)<spval.and.UH(IW,J,L)<spval.and.UH(I,J-1,L)<spval) then
+
 !        USFC=D25*(U10(I,J-1)+U10(IW,J)+U10(IE,J)+U10(I,J+1)) 
 !        VSFC=D25*(V10(I,J-1)+V10(IW,J)+V10(IE,J)+V10(I,J+1))
              USFC = U10H(I,J)
@@ -121,19 +123,31 @@ SUBROUTINE CALGUST(LPBL,ZPBL,GUST)
              U0   = D25*(UH(I,J-1,L)+UH(IW,J,L)+UH(IE,J,L)+UH(I,J+1,L))
              V0   = D25*(VH(I,J-1,L)+VH(IW,J,L)+VH(IE,J,L)+VH(I,J+1,L))
              WIND = SQRT(U0*U0 + V0*V0)
+
+             else
+             WIND = spval
+             endif
+
            ELSE IF(gridtype == 'B') THEN
              IE = I 
              IW = I-1
 
 !        USFC=D25*(U10(I,J-1)+U10(IW,J)+U10(IE,J)+U10(IW,J-1)) 
 !        VSFC=D25*(V10(I,J-1)+V10(IW,J)+V10(IE,J)+V10(IW,J-1))
+
+             if(U10H(I,J)<spval.and.UH(IW,J-1,L)<spval) then
+
              USFC = U10H(I,J)
              VSFC = V10H(I,J)
              SFCWIND = SQRT(USFC*USFC + VSFC*VSFC)
              U0 = D25*(UH(I,J-1,L)+UH(IW,J,L)+UH(IE,J,L)+UH(IW,J-1,L))
              V0 = D25*(VH(I,J-1,L)+VH(IW,J,L)+VH(IE,J,L)+VH(IW,J-1,L))
              WIND = SQRT(U0*U0 + V0*V0) 
+             else
+             WIND = spval
+             endif
            ELSE IF(gridtype == 'A') THEN
+
              USFC    = U10(I,J)
              VSFC    = V10(I,J)
              if (usfc < spval .and. vsfc < spval) then
@@ -147,18 +161,27 @@ SUBROUTINE CALGUST(LPBL,ZPBL,GUST)
 ! in RUC do 342 k=2,k1-1, where k1 - first level above PBLH
                GUST(I,J) = SFCWIND
                do K=LM-1,L-1,-1
+
+                 if(UH(I,J,L)<spval) then
                  U0   = UH(I,J,K)
                  V0   = VH(I,J,K)
                  WIND = SQRT(U0*U0 + V0*V0)
                  DELWIND = WIND - SFCWIND
                  DZ = ZMID(I,J,K)-ZSFC
                  DELWIND  = DELWIND*(1.0-MIN(0.5,DZ/2000.))
                  GUST(I,J) = MAX(GUST(I,J),SFCWIND+DELWIND)
+               else
+                 GUST(I,J) = spval
+               endif
                enddo
              else
+               if(UH(I,J,L)<spval) then
                U0   = UH(I,J,L)
                V0   = VH(I,J,L)
                WIND = SQRT(U0*U0 + V0*V0 )
+               else
+               WIND = spval
+               endif
              endif ! endif RAPR
 
            ELSE

sorc/ncep_post.fd/CALPBL.f

@@ -76,8 +76,10 @@ SUBROUTINE CALPBL(PBLRI)
       DO L=LM,1,-1
         DO J=JSTA,JEND
           DO I=1,IM
+            if( PMID(I,J,L)<SPVAL) then
             APE        = (H10E5/PMID(I,J,L))**CAPA
             THV(I,J,L) = (Q(I,J,L)*D608+H1)*T(I,J,L)*APE
+            endif
           ENDDO
         ENDDO
       ENDDO
@@ -127,6 +129,8 @@ SUBROUTINE CALPBL(PBLRI)
         DO J=JSTA_M,JEND_M
           DO I=2,IM-1
 !
+            if( PMID(I,J,L)<SPVAL) then
+
             RIF(I,J) = 0.
             IF(IFRSTLEV(I,J) == 0) THEN
               RIBP(I,J) = RIF(I,J)
@@ -211,6 +215,9 @@ SUBROUTINE CALPBL(PBLRI)
             LVLP(I,J) = L-1
 !
  10         CONTINUE
+
+            endif !spval
+
           ENDDO
         ENDDO
       ENDDO

sorc/ncep_post.fd/CALPW.f

@@ -65,7 +65,7 @@ SUBROUTINE CALPW(PW,IDECID)
       use vrbls4d,    only: smoke
       use masks,      only: htm
       use params_mod, only: tfrz, gi
-      use ctlblk_mod, only: lm, jsta, jend, im
+      use ctlblk_mod, only: lm, jsta, jend, im, spval
       use upp_physics, only: FPVSNEW
 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
       implicit none
@@ -290,6 +290,7 @@ SUBROUTINE CALPW(PW,IDECID)
 !$omp  parallel do private(i,j,dp)
         DO J=JSTA,JEND
           DO I=1,IM
+            if(PINT(I,J,L+1) <spval .and. Qdum(I,J) < spval) then
              DP      = PINT(I,J,L+1) - PINT(I,J,L)
              PW(I,J) = PW(I,J) + Qdum(I,J)*DP*GI*HTM(I,J,L)
             IF (IDECID == 17 .or. IDECID == 20 .or. IDECID == 21) THEN
@@ -299,6 +300,10 @@ SUBROUTINE CALPW(PW,IDECID)
              PW(I,J) = PW(I,J) + Qdum(I,J)
             ENDIF
             IF (IDECID == 14) PWS(I,J) = PWS(I,J) + QS(I,J)*DP*GI*HTM(I,J,L)
+            else
+             PW(I,J) = spval
+             PWS(I,J) = spval
+            endif
           ENDDO
         ENDDO
       ENDDO                 ! l loop
@@ -308,7 +313,9 @@ SUBROUTINE CALPW(PW,IDECID)
 !$omp  parallel do private(i,j,dp)
         DO J=JSTA,JEND
           DO I=1,IM
+            if( PW(I,J)<spval) then
             PW(I,J) = max(0.,PW(I,J)/PWS(I,J)*100.) 
+            endif
           ENDDO
         ENDDO
       END IF
@@ -319,7 +326,9 @@ SUBROUTINE CALPW(PW,IDECID)
 !$omp  parallel do private(i,j)
         DO J=JSTA,JEND
           DO I=1,IM
+            if( PW(I,J)<spval) then
             PW(I,J) = PW(I,J) / 2.14e-5
+            endif
           ENDDO
         ENDDO
       endif

sorc/ncep_post.fd/CLDRAD.f

@@ -922,7 +922,11 @@ SUBROUTINE CLDRAD
         DO L=LM,1,-1
           DO J=JSTA,JEND
             DO I=1,IM
+              if(CFR(I,J,L)<spval) then
               FULL_CLD(I,J)=CFR(I,J,L)    !- 3D cloud fraction (from radiation)
+              else
+              FULL_CLD(I,J)=spval
+              endif
             ENDDO
           ENDDO
           CALL AllGETHERV(FULL_CLD)
@@ -932,13 +936,18 @@ SUBROUTINE CLDRAD
               FRAC=0.
               DO JC=max(1,J-numr),min(JM,J+numr)
                 DO IC=max(1,I-numr),min(IM,I+numr)
+!                  if(IC>=1.and.IC<=IM.and.JM>=JSTA.and.JM<=JEND) then
                   IF(FULL_CLD(IC,JC) /= SPVAL) THEN
                     NUMPTS=NUMPTS+1
                     FRAC=FRAC+FULL_CLD(IC,JC)
                   ENDIF
+!                  else
+!                    FRAC=spval
+!                  endif
                 ENDDO
               ENDDO
               IF (NUMPTS>0) FRAC=FRAC/REAL(NUMPTS)
+              if(PMID(I,J,L)<spval) then
               PCLDBASE=PMID(I,J,L)    !-- Using PCLDBASE variable for convenience
               IF (PCLDBASE>=PTOP_LOW) THEN
                 CFRACL(I,J)=MAX(CFRACL(I,J),FRAC)
@@ -948,6 +957,12 @@ SUBROUTINE CLDRAD
                 CFRACH(I,J)=MAX(CFRACH(I,J),FRAC)
               ENDIF
               TCLD(I,J)=MAX(TCLD(I,J),FRAC)
+              else
+              CFRACL(I,J)=spval
+              CFRACM(I,J)=spval
+              CFRACH(I,J)=spval
+              TCLD(I,J)=spval
+              endif
             ENDDO  ! I
           ENDDO    ! J
         ENDDO      ! L

sorc/ncep_post.fd/MAPSSLP.f

@@ -10,7 +10,7 @@ SUBROUTINE MAPSSLP(TPRES)
 !
 !-----------------------------------------------------------------------
       use ctlblk_mod, only: jsta, jend, spl, smflag, lm, im, jsta_2l, jend_2u, &
-                            lsm, jm, grib
+                            lsm, jm, grib, spval
       use gridspec_mod, only: maptype, dxval
       use vrbls3d, only: pmid, t, pint
       use vrbls2d, only: pslp, fis
@@ -43,9 +43,12 @@ SUBROUTINE MAPSSLP(TPRES)
 !$omp parallel do private(i,j)
         DO J=JSTA,JEND
           DO I=1,IM
-            if(SPL(L) == 70000.)THEN
+            if(SPL(L) == 70000. .and. TPRES(I,J,L) <spval)THEN
               T700(i,j)  = TPRES(I,J,L) 
               TH700(I,J) = T700(I,J)*(P1000/70000.)**CAPA
+            else
+              T700(i,j)  = spval
+              TH700(I,J) = spval
             endif
           ENDDO
         ENDDO
@@ -79,6 +82,7 @@ SUBROUTINE MAPSSLP(TPRES)
 
        DO J=JSTA,JEND
          DO I=1,IM
+         if(T700(I,J) <spval) then
          T700(I,J) = TH700(I,J)*(70000./P1000)**CAPA
           IF (T700(I,J)>100.) THEN
            TSFCNEW = T700(I,J)*(PMID(I,J,LM)/70000.)**EXPo
@@ -90,6 +94,11 @@ SUBROUTINE MAPSSLP(TPRES)
               ((TSFCNEW+LAPSES*FIS(I,J)*GI)/TSFCNEW)**EXPINV
 !          print*,'PSLP(I,J),I,J',PSLP(I,J),I,J
            GRID1(I,J)=PSLP(I,J)
+         else
+           PSLP(I,J) = spval
+           grid1(I,J) = spval
+         endif
+
          ENDDO
        ENDDO
 

sorc/ncep_post.fd/MDL2P.f

@@ -3723,6 +3723,8 @@ SUBROUTINE MDL2P(iostatusD3D)
         IF(gridtype == 'A'.OR. gridtype == 'B') then                  
           if(me==0)PRINT*,'CALLING MEMSLP for A or B grid'
           CALL MEMSLP(TPRS,QPRS,FPRS)
+          if(me==0)PRINT*,'aft CALLING MEMSLP for A or B grid,pslp=', &
+            maxval(pslp(1:im,jsta:jend)),minval(pslp(1:im,jsta:jend)),pslp(im/2,(jsta+jend)/2)
         ELSE IF (gridtype == 'E')THEN
           if(me==0)PRINT*,'CALLING MEMSLP_NMM for E grid'
           CALL MEMSLP_NMM(TPRS,QPRS,FPRS)
@@ -3735,6 +3737,8 @@ SUBROUTINE MDL2P(iostatusD3D)
             GRID1(I,J) = PSLP(I,J)
           ENDDO
         ENDDO
+        print *,'inmdl2p,pslp=',maxval(pslp(1:im,jsta:jend)),minval(pslp(1:im,jsta:jend))
+        print *,'inmdl2p,point pslp=',pslp(im/2,(jsta+jend)/2),pslp(1,jsta),'cfld=',cfld
         if(grib == 'grib2')then
           cfld = cfld + 1
           fld_info(cfld)%ifld = IAVBLFLD(IGET(023))

sorc/ncep_post.fd/MDLFLD.f

@@ -3596,6 +3596,9 @@ SUBROUTINE MDLFLD
        DO J=JSTA,JEND
         DO I=1,IM
          LPBL(I,J)=LM
+
+         if(ZINT(I,J,NINT(LMH(I,J))+1) <spval) then
+
          ZSFC=ZINT(I,J,NINT(LMH(I,J))+1)
          loopL:DO L=NINT(LMH(I,J)),1,-1
           IF(MODELNAME=='RAPR') THEN
@@ -3611,6 +3614,10 @@ SUBROUTINE MDLFLD
            EXIT loopL 
           END IF
          ENDDO loopL
+
+         else
+           LPBL(I,J) = LM
+         endif
          if(lpbl(i,j)<1)print*,'zero lpbl',i,j,pblri(i,j),lpbl(i,j)
         ENDDO
        ENDDO

sorc/ncep_post.fd/MISCLN.f

@@ -378,6 +378,8 @@ SUBROUTINE MISCLN
 !$omp parallel do private(i,j)
           DO J=JSTA,JEND
             DO I=1,IM
+
+              if(PMID(I,J,1)<spval) then
 ! INPUT
               CALL TPAUSE(LM,PMID(I,J,1:LM),UH(I,J,1:LM)             & 
 ! INPUT
@@ -386,6 +388,15 @@ SUBROUTINE MISCLN
                          ,P1D(I,J),U1D(I,J),V1D(I,J),T1D(I,J)        &
 ! OUTPUT
                          ,Z1D(I,J),SHR1D(I,J))                       ! OUTPUT
+              else
+                P1D(I,J) = spval
+                U1D(I,J) = spval
+                V1D(I,J) = spval
+                T1D(I,J) = spval
+                Z1D(I,J) = spval
+                SHR1D(I,J) = spval
+              endif
+
             END DO
           END DO
 !

sorc/ncep_post.fd/NGMSLP.f

@@ -93,7 +93,7 @@ SUBROUTINE NGMSLP
       use vrbls2d,    only: slp, fis, z1000
       use masks,      only: lmh
       use params_mod, only: rd, gi, g, h1, d608, gamma, d50, p1000
-      use ctlblk_mod, only: jsta, jend, im, jm
+      use ctlblk_mod, only: jsta, jend, im, jm, spval
 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
        implicit none
 !     
@@ -119,6 +119,9 @@ SUBROUTINE NGMSLP
        DO J=JSTA,JEND
        DO I=1,IM
          LLMH = NINT(LMH(I,J))
+
+         if( PINT(I,J,LLMH+1)<spval) then
+
          ZSFC = ZINT(I,J,LLMH+1)
          PSFC = PINT(I,J,LLMH+1)
          SLP(I,J) = PSFC
@@ -155,6 +158,12 @@ SUBROUTINE NGMSLP
          RHOAVG   = PAVG*GI/TAUAVG
          RRHOG    = H1/(RHOAVG*G)
          Z1000(I,J) = (SLP(I,J)-P1000)*RRHOG
+
+         else
+         SLP(I,J) = spval
+         Z1000(I,J) = spval
+         endif
+
 !     
 !     MOVE TO NEXT HORIZONTAL GRIDPOINT.
       ENDDO

sorc/ncep_post.fd/OTLFT.f

@@ -52,7 +52,7 @@ SUBROUTINE OTLFT(PBND,TBND,QBND,SLINDX)
       use vrbls2d,    only: T500
       use lookup_mod, only: THL, RDTH, JTB, QS0, SQS, RDQ, ITB, PTBL, &
                             PL, RDP, THE0, STHE, RDTHE, TTBL
-      use ctlblk_mod, only: JSTA, JEND, IM
+      use ctlblk_mod, only: JSTA, JEND, IM, spval
       use params_mod, only: D00, H10E5, CAPA, ELOCP, EPS, ONEPS
       use upp_physics, only: FPVSNEW
 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@@ -92,6 +92,9 @@ SUBROUTINE OTLFT(PBND,TBND,QBND,SLINDX)
         DO I=1,IM
           TBT = TBND(I,J) 
           QBT = QBND(I,J)
+!
+          if( TBT < spval ) then
+
           APEBT = (H10E5/PBND(I,J))**CAPA
 !
 !--------------SCALING POTENTIAL TEMPERATURE & TABLE INDEX--------------
@@ -232,6 +235,10 @@ SUBROUTINE OTLFT(PBND,TBND,QBND,SLINDX)
            QSATP=EPS*ESATP/(P500-ESATP*ONEPS)
            TVP=PARTMP*(1+0.608*QSATP)
            SLINDX(I,J)=T500(I,J)-TVP
+
+           else
+             SLINDX(I,J)=spval
+           endif
          END DO
        END DO
 !