Update part of the code based on current EMC develop branch for compa…

…ring the test results with the merged version.(#9)

sorc/ncep_post.fd/CALVIS_GSD.f

@@ -177,11 +177,8 @@ SUBROUTINE CALVIS_GSD(CZEN,VIS)
 
       EXPONFg    =   0.75  
 !     CONST1=-LOG(.02)
-      if(MODELNAME == 'RAPR') then
          CONST1= 3.000
-      else
-         CONST1= 3.912
-      endif
+!         CONST1= 3.912
 
 ! visibility with respect to RH is
 !   calculated from optical depth linearly
@@ -239,11 +236,8 @@ SUBROUTINE CALVIS_GSD(CZEN,VIS)
 
 !tgs 23 feb 2017 - increase of base value to 90 km to reduce attenuation
 !                  from RH for clear-air visibility.  (i.e., increase clear-air vis overall)
-       IF(MODELNAME  == 'RAPR') then
           visrh = 90. * exp(-2.5*qrh)
-       else
-          visrh = 60. * exp(-2.5*qrh)
-       endif
+!          visrh = 60. * exp(-2.5*qrh)
 
 !  -- add term to increase RH vis term for
 !     low-level wind shear increasing from 4 to 6 ms-1

sorc/ncep_post.fd/CLDRAD.f

@@ -167,6 +167,7 @@ SUBROUTINE CLDRAD
               OPDEPTH, TMP,QSAT,RHUM,TCEXT,DELZ,DELY,DY_m
 !
       real    FULL_CLD(IM,JM)   !-- Must be dimensioned for the full domain
+      real, allocatable :: full_ceil(:,:), full_fis(:,:)
 !
       real    dummy(IM,jsta:jend)
       integer idummy(IM,jsta:jend)
@@ -1290,7 +1291,7 @@ SUBROUTINE CLDRAD
 !     TIME AVERAGED TOTAL CLOUD FRACTION.
       IF (IGET(144) > 0) THEN
 !        GRID1=SPVAL
-        IF(MODELNAME == 'GFS')THEN
+        IF(MODELNAME == 'GFS' .OR. MODELNAME == 'FV3R')THEN
 !$omp parallel do private(i,j)
           DO J=JSTA,JEND
             DO I=1,IM
@@ -1320,7 +1321,8 @@ SUBROUTINE CLDRAD
             ENDDO
           ENDDO
         END IF 
-        IF(MODELNAME == 'NMM' .OR. MODELNAME == 'GFS')THEN
+        IF(MODELNAME == 'NMM' .OR. MODELNAME == 'GFS' .OR. &
+           MODELNAME == 'FV3R')THEN
           ID(1:25)= 0
           ITCLOD     = NINT(TCLOD)
           IF(ITCLOD /= 0) then
@@ -2135,13 +2137,22 @@ SUBROUTINE CLDRAD
           ! "spread" onto the ajacent hills/peaks as very low ceilings
           ! (fog). In actuality, these hills/peaks may exist above the cloud
           ! layer.
+          allocate(full_ceil(IM,JM),full_fis(IM,JM))
+          DO J=JSTA,JEND
+            DO I=1,IM
+              full_ceil(i,j)=ceil(i,j)
+              full_fis(i,j)=fis(i,j)
+            ENDDO
+          ENDDO
+          CALL AllGETHERV(full_ceil)
+          CALL AllGETHERV(full_fis)
           numr = 1
           DO J=JSTA,JEND
             DO I=1,IM
               ceil_min = max( ceil(I,J)-FIS(I,J)*GI , 5.0) ! ceil_min in AGL
-              do jc = max(JSTA,J-numr),min(JEND,J+numr)
+              do jc = max(1,J-numr),min(JM,J+numr)
               do ic = max(1,I-numr),min(IM,I+numr)
-                ceil_neighbor = max( ceil(ic,jc)-FIS(ic,jc)*GI , 5.0) !  ceil_neighbor in AGL
+                ceil_neighbor = max( full_ceil(ic,jc)-full_fis(ic,jc)*GI , 5.0) !  ceil_neighbor in AGL
                 ceil_min = min( ceil_min, ceil_neighbor )
               enddo
               enddo
@@ -2158,6 +2169,8 @@ SUBROUTINE CLDRAD
               enddo
             ENDDO
           ENDDO
+          if (allocated(full_ceil)) deallocate(full_ceil)
+          if (allocated(full_fis)) deallocate(full_fis)
 
           ! Parameters 711/798: experimental ceiling diagnostic #2 (height and pressure, respectively)
           IF (IGET(711)>0) THEN

sorc/ncep_post.fd/CTLBLK.f

@@ -41,7 +41,7 @@ module CTLBLK_mod
   real*8 :: gdsdegr
   real,allocatable :: datapd(:,:,:)
 !
-  logical :: gocart_on, d3d_on, hyb_sigp
+  logical :: gocart_on, d3d_on, hyb_sigp, rdaod
   logical :: SIGMA,RUN,FIRST,RESTRT
   logical :: global
   logical :: SMFLAG
@@ -67,7 +67,8 @@ module CTLBLK_mod
 !  
   real(kind=8) :: ETAFLD2_tim=0.,ETA2P_tim=0.,SURFCE2_tim=0.,          &
                   CLDRAD_tim=0.,MISCLN_tim=0.,FIXED_tim=0.,            &
-                  MDL2SIGMA_tim=0.,READxml_tim=0.                      !comm tim_info
+                  MDL2SIGMA_tim=0.,READxml_tim=0.,MDL2AGL_tim=0.,      &
+                  MDL2STD_tim=0.,MDL2THANDPV_tim=0.,CALRAD_WCLOUD_tim=0.!comm tim_info
 !
   real(kind=8) :: time_output=0., time_e2out=0.           !comm jjt
 !

sorc/ncep_post.fd/MDLFLD.f

@@ -3385,7 +3385,11 @@ SUBROUTINE MDLFLD
 !$omp parallel do private(i,j)
               DO J=JSTA,JEND
                 DO I=1,IM
+                IF(PBLRI(I,J)<spval.and.ZINT(I,J,LM+1)<spval)THEN
                   EGRID3(I,J) = PBLRI(I,J) + ZINT(I,J,LM+1)
+                ELSE
+                  EGRID3(I,J) = spval
+                ENDIF
                 END DO
               END DO  
 ! compute U and V separately because they are on different locations for B grid
@@ -3404,7 +3408,9 @@ SUBROUTINE MDLFLD
                  HCOUNT=0
                  DO J=JSTA,JEND
                   DO I=1,IM
-
+                   if (EGRID4(I,J)<spval.and.EGRID5(I,J)<spval.and.&
+                       EGRID6(I,J)<spval.and.EGRID7(I,J)<spval.and.&
+                       UH(I,J,1)<spval)THEN
                    if (EGRID5(I,J)  <=  EGRID4(I,J)) then
 !       if (I == 50 .and. J == 50) then
 !        write(0,*) 'working with L : ', L
@@ -3416,6 +3422,7 @@ SUBROUTINE MDLFLD
 !                  else
 !                    exit vert_loopu
                    endif
+                   endif
                   end do
                 end do 
                  if(HCOUNT < 1 )exit vert_loopu
@@ -3449,6 +3456,9 @@ SUBROUTINE MDLFLD
 		 HCOUNT=0
                  DO J=JSTA,JEND
                   DO I=1,IM
+                   if (EGRID4(I,J)<spval.and.EGRID5(I,J)<spval.and.&
+                       EGRID6(I,J)<spval.and.EGRID7(I,J)<spval.and.&
+                       VH(I,J,1)<spval)THEN
                    if (EGRID5(I,J) <= EGRID4(I,J)) then
                      HCOUNT=HCOUNT+1
                      DP = EGRID6(I,J) - EGRID7(I,J)
@@ -3457,6 +3467,7 @@ SUBROUTINE MDLFLD
 !                  else
 !                    exit vert_loopu
                    endif
+                   endif 
                   end do
                  end do 
                  if(HCOUNT<1)exit vert_loopv

sorc/ncep_post.fd/SURFCE.f

@@ -6264,56 +6264,5 @@ SUBROUTINE SURFCE
 
       ENDIF
 
-
-!      TIME-AVERAGED EXCHANGE COEFFICIENTS FOR MASS REQUESTED FOR CMAQ
-      IF (IGET(503)>0) THEN
-            DO J=JSTA,JEND
-            DO I=1,IM
-             GRID1(I,J)=AKHSAVG(I,J)
-            ENDDO
-            ENDDO
-            ID(1:25) = 0
-            ID(02)= 133
-         ID(19)     = IFHR
-         IF (IFHR==0) THEN
-           ID(18) = 0
-         ELSE
-           ID(18) = IFHR - 1
-         ENDIF
-            ID(20)     = 3
-         if(grib=='grib2') then
-            cfld=cfld+1
-            fld_info(cfld)%ifld=IAVBLFLD(IGET(503))
-            fld_info(cfld)%ntrange=IFHR-ID(18)
-            fld_info(cfld)%tinvstat=1
-            datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
-         endif
-       ENDIF
-
-!      TIME-AVERAGED EXCHANGE COEFFICIENTS FOR WIND REQUESTED FOR CMAQ
-      IF (IGET(504)>0) THEN
-            DO J=JSTA,JEND
-            DO I=1,IM
-             GRID1(I,J)=AKMSAVG(I,J)
-            ENDDO
-            ENDDO
-            ID(1:25) = 0
-            ID(02)= 133
-         ID(19)     = IFHR
-         IF (IFHR==0) THEN
-           ID(18) = 0
-         ELSE
-           ID(18) = IFHR - 1
-         ENDIF
-            ID(20)     = 3
-         if(grib=='grib2') then
-            cfld=cfld+1
-            fld_info(cfld)%ifld=IAVBLFLD(IGET(504))
-            fld_info(cfld)%ntrange=IFHR-ID(18)
-            fld_info(cfld)%tinvstat=1
-            datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
-         endif
-      ENDIF
-
       RETURN
       END

sorc/ncep_post.fd/WRFPOST.f

@@ -437,6 +437,7 @@ PROGRAM WRFPOST
           call ext_ncd_ioclose ( DataHandle, Status )
          ELSE
 ! use netcdf lib directly to read FV3 output in netCDF
+          spval = 9.99e20
           Status = nf90_open(trim(fileName),NF90_NOWRITE, ncid3d)
           if ( Status /= 0 ) then
             print*,'error opening ',fileName, ' Status = ', Status 
@@ -484,6 +485,7 @@ PROGRAM WRFPOST
          END IF 
 ! use netcdf_parallel lib directly to read FV3 output in netCDF
         ELSE IF(TRIM(IOFORM) == 'netcdfpara') THEN
+          spval = 9.99e20
           Status = nf90_open(trim(fileName),ior(nf90_nowrite, nf90_mpiio), &
                              ncid3d, comm=mpi_comm_world, info=mpi_info_null)
           if ( Status /= 0 ) then