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/BNDLYR.f

@@ -72,7 +72,7 @@ SUBROUTINE BNDLYR(PBND,TBND,QBND,RHBND,UBND,VBND,       &
       use masks,      only: lmh
       use params_mod, only: d00, gi, pq0, a2, a3, a4
       use ctlblk_mod, only: jsta_2l, jend_2u, lm, jsta, jend, modelname,      &
-                            jsta_m, jend_m, im, nbnd
+                            jsta_m, jend_m, im, nbnd, spval
       use physcons_post,   only: con_rd, con_rv, con_eps, con_epsm1
       use gridspec_mod, only: gridtype
       use upp_physics, only: FPVSNEW
@@ -180,6 +180,7 @@ SUBROUTINE BNDLYR(PBND,TBND,QBND,RHBND,UBND,VBND,       &
             DO I=1,IM
 !
               PM = PMID(I,J,L)
+              IF(PM<SPVAL)THEN
               IF((PBINT(I,J,LBND)   >= PM).AND.              & 
                  (PBINT(I,J,LBND+1) <= PM)) THEN
                 DP = PINT(I,J,L+1) - PINT(I,J,L)
@@ -205,6 +206,7 @@ SUBROUTINE BNDLYR(PBND,TBND,QBND,RHBND,UBND,VBND,       &
                 END IF 
                 QSBND(I,J,LBND) = QSBND(I,J,LBND) + QSAT*DP
               ENDIF
+              ENDIF
             ENDDO
           ENDDO
         ENDDO
@@ -333,7 +335,7 @@ SUBROUTINE BNDLYR(PBND,TBND,QBND,RHBND,UBND,VBND,       &
               END IF 
               WBND(I,J,LBND)    = WH(I,J,L)
               QCNVBND(I,J,LBND) = QCNVG(I,J,L)
-              IF(MODELNAME == 'GFS')THEN
+              IF(MODELNAME == 'GFS' .OR. MODELNAME == 'FV3R')THEN
                 ES   = FPVSNEW(T(I,J,L))
                 ES   = MIN(ES,PM)
                 QSAT = CON_EPS*ES/(PM+CON_EPSM1*ES)

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/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)<SPVAL.AND.VWND(I,J-1)<SPVAL.AND.          &
-              UWND(I+1,J)<SPVAL.AND.UWND(I-1,J)<SPVAL) THEN
+           IF(Q1D(I,J+1)<SPVAL.AND.Q1D(I,J-1)<SPVAL.AND.          &
+              Q1D(I+1,J)<SPVAL.AND.Q1D(I-1,J)<SPVAL) THEN
              R2DX   = 1./(2.*DX(I,J))   !MEB DX?
              R2DY   = 1./(2.*DY(I,J))   !MEB DY?  
              QUDX   = (Q1D(I+1,J)*UWND(I+1,J)-Q1D(I-1,J)*UWND(I-1,J))*R2DX

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/CALPBLREGIME.f

@@ -104,6 +104,8 @@ SUBROUTINE CALPBLREGIME(PBLREGIME)
       DO J=JSTA_M,JEND_M
         DO I=2,IM-1
 !
+          IF(PMID(I,J,LM)<SPVAL .AND. QS(I,J)<SPVAL .AND. &
+             SMSTAV(I,J)<SPVAL) THEN 
           APE  = (P1000/PMID(I,J,LM))**CAPA
           THX  = T(I,J,LM)*APE
           THVX = (Q(I,J,LM)*D608+H1)*THX
@@ -158,6 +160,7 @@ SUBROUTINE CALPBLREGIME(PBLREGIME)
 !         jj=(jsta+jend)/2
 !         if(i==ii.and.j==jj)print*,'Debug: CALPBLREGIME ',i,j,br,     &  
 !         PBLREGIME(I,J)
+          END IF !end IF PMID 
 
         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/CALRAD_WCLOUD_newcrtm.f

@@ -10,6 +10,7 @@
 !!            CHANNEL SELECTION USING LVLS FROM WRF_CNTRL.PARM
 !! -  19-04-01 Sharon NEBUDA - Added output option for GOES-16 & GOES-17 ABI IR Channels 7-16
 !! -  20-04-09 Tracy Hertneky - Added Himawari-8 AHI CH7-CH16
+!! -  21-01-10 Web Meng - Added checking points for skiping grids with filling value spval
 !!
 !!   OUTPUT FILES:
 !!     NONE
@@ -52,7 +53,7 @@ SUBROUTINE CALRAD_WCLOUD
   use crtm_cloud_define, only:  water_cloud,ice_cloud,rain_cloud,snow_cloud,graupel_cloud,hail_cloud
   use message_handler, only: success,warning, display_message
 
-  use params_mod, only: pi, rtd, p1000, capa, h1000, h1, g, rd, d608, qconv
+  use params_mod, only: pi, rtd, p1000, capa, h1000, h1, g, rd, d608, qconv, small
   use rqstfld_mod, only: iget, id, lvls, iavblfld
   use ctlblk_mod, only: modelname, ivegsrc, novegtype, imp_physics, lm, spval, icu_physics,&
               grib, cfld, fld_info, datapd, idat, im, jsta, jend, jm, me
@@ -690,7 +691,18 @@ SUBROUTINE CALRAD_WCLOUD
                         (isis=='abi_gr'  .and. post_abigr) )then
 
               do j=jsta,jend
-                 do i=1,im
+                 loopi1:do i=1,im
+
+                    ! Skiping the grids with filling value spval
+                    do k=1,lm
+                      if(abs(pmid(i,j,k)-spval)<=small .or. &
+                         abs(t(i,j,k)-spval)<=small) then
+                         do n=1,channelinfo(sensorindex)%n_channels
+                           tb(i,j,n)=spval
+                         enddo
+                         cycle loopi1
+                      endif
+                    enddo
 
                     !    Load geometry structure
                     !    geometryinfo(1)%sensor_zenith_angle = zasat*rtd  ! local zenith angle ???????
@@ -1104,7 +1116,7 @@ SUBROUTINE CALRAD_WCLOUD
                        !       tb3(i,j)=spval
                        !       tb4(i,j)=spval
                     END IF ! endif block for allowable satellite zenith angle 
-                 end do ! end loop for i
+                 end do loopi1 ! end loop for i
               end do ! end loop for j 
 
               !      error_status = crtm_destroy(channelinfo)
@@ -1233,7 +1245,19 @@ SUBROUTINE CALRAD_WCLOUD
                         iget(461)>0 .or. iget(462)>0 .or. iget(463)>0)))then
 
               do j=jsta,jend
-                 do i=1,im
+                 loopi2:do i=1,im
+
+                    ! Skiping the grids with filling value spval
+                    do k=1,lm
+                      if(abs(pmid(i,j,k)-spval)<=small .or. &
+                         abs(t(i,j,k)-spval)<=small) then
+                         do n=1,channelinfo(sensorindex)%n_channels
+                           tb(i,j,n)=spval
+                         enddo
+                         cycle loopi2
+                      endif
+                    enddo
+
                     !    Load geometry structure
                     !    geometryinfo(1)%sensor_zenith_angle = zasat*rtd  ! local zenith angle ???????
                     ! compute satellite zenith angle
@@ -1665,7 +1689,7 @@ SUBROUTINE CALRAD_WCLOUD
                           tb(i,j,n)=spval
                        end do
                     END IF ! endif block for allowable satellite zenith angle 
-                 end do ! end loop for i
+                 end do loopi2 ! end loop for i
               end do ! end loop for j 
 
                !      error_status = crtm_destroy(channelinfo)

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
@@ -2475,9 +2490,22 @@ SUBROUTINE CLDRAD
           DO I=1,IM
             ITOP=ITOPT(I,J)
             IF (ITOP>0 .AND. ITOP<=NINT(LMH(I,J))) THEN
-              CLDP(I,J) = PMID(I,J,ITOP)
-              CLDZ(I,J) = ZMID(I,J,ITOP)
-              CLDT(I,J) = T(I,J,ITOP)
+              IF(T(I,J,ITOP)<SPVAL .AND. &
+                 PMID(I,J,ITOP)<SPVAL .AND. &
+                 ZMID(I,J,ITOP)<SPVAL) THEN
+                CLDP(I,J) = PMID(I,J,ITOP)
+                CLDZ(I,J) = ZMID(I,J,ITOP)
+                CLDT(I,J) = T(I,J,ITOP)
+              ELSE
+                IF(MODELNAME == 'RAPR') then
+                  CLDP(I,J) = SPVAL
+                  CLDZ(I,J) = SPVAL
+                ELSE
+                  CLDP(I,J) = -50000.
+                  CLDZ(I,J) = -5000.
+                ENDIF
+                CLDT(I,J) = -500. 
+              ENDIF
             ELSE
               IF(MODELNAME == 'RAPR') then
                 CLDP(I,J) = SPVAL