Fix for absv computation in RRFS (#516)

sorc/ncep_post.fd/INITPOST_NETCDF.f

@@ -17,6 +17,7 @@
 !> 2022-03-15 | Wen Meng      | Unify regional and global interfaces
 !> 2022-03-22 | Wen Meng      | Read PWAT from model
 !> 2022-04-08 | Bo Cui        | 2D decomposition for unified fv3 read interfaces
+!> 2022-06-05 | Hui-Ya Chuang | Modify dx/dy computation for RRFS domain over north pole
 !>
 !> @author Hui-Ya Chuang @date 2016-03-04
       SUBROUTINE INITPOST_NETCDF(ncid2d,ncid3d)
@@ -872,8 +873,16 @@ SUBROUTINE INITPOST_NETCDF(ncid2d,ncid3d)
         do i = ista, iend_m
           ip1 = i + 1
 !          if (ip1 > im) ip1 = ip1 - im
-          DX (i,j) = ERAD*COS(GDLAT(I,J)*DTR) *(GDLON(IP1,J)-GDLON(I,J))*DTR
-          DY (i,j) = ERAD*(GDLAT(I,J+1)-GDLAT(I,J))*DTR  ! like A*DPH
+          if(MAPTYPE==207)then
+            DX(i,j) = erad*dxval*dtr/gdsdegr
+          else
+            DX(i,j) = ERAD*COS(GDLAT(I,J)*DTR) *(GDLON(IP1,J)-GDLON(I,J))*DTR
+          endif
+          if(MAPTYPE==207)then
+            DY(i,j)= erad*dyval*dtr/gdsdegr
+          else
+            DY(i,j) = ERAD*(GDLAT(I,J+1)-GDLAT(I,J))*DTR  ! like A*DPH
+          endif
 !	  F(I,J)=1.454441e-4*sin(gdlat(i,j)*DTR)         ! 2*omeg*sin(phi)
 !     if (i == ii .and. j == jj) print*,'sample LATLON, DY, DY='    &
 !           ,i,j,GDLAT(I,J),GDLON(I,J),DX(I,J),DY(I,J)

sorc/ncep_post.fd/UPP_MATH.f

@@ -12,6 +12,7 @@
 !> Date | Programmer | Comments
 !> -----|------------|---------
 !> 2020-05-20 | Jesse Meng | Initial
+!> 2022-06-10 | Wen Meng   | Modify dvdxdudy to retrict computation on undefined grids  
 !>
 !> @author Jesse Meng @date 2020-05-20
   module upp_math
@@ -49,13 +50,24 @@ subroutine dvdxdudy(uwnd,vwnd)
       integer i, j
       real r2dx, r2dy
       INTEGER, allocatable ::  IHE(:),IHW(:)
-!
+
+!Initializing
+      DO J=JSTA_M,JEND_M
+        DO I=ISTA_M,IEND_M
+           DDVDX(I,J)=SPVAL
+           DDUDY(I,J)=SPVAL
+           UUAVG(I,J)=SPVAL
+        ENDDO
+      ENDDO
+
       IF(GRIDTYPE == 'A')THEN
 !$omp parallel do  private(i,j,r2dx,r2dy)
         DO J=JSTA_M,JEND_M
         DO I=ISTA_M,IEND_M
-           IF(VWND(I+1,J)<SPVAL.AND.VWND(I-1,J)<SPVAL.AND.              &
-     &        UWND(I,J+1)<SPVAL.AND.UWND(I,J-1)<SPVAL) THEN
+           IF(VWND(I+1,J)<SPVAL.AND.VWND(I-1,J)<SPVAL.AND.      &
+              UWND(I,J+1)<SPVAL.AND.UWND(I,J-1)<SPVAL.AND.      &
+              UWND(I,J)<SPVAL.AND.VWND(I,J)<SPVAL.AND.          &
+              ABS(DX(I,J))>1.E-5.AND.ABS(DY(I,J))>1.E-5) THEN
               R2DX   = 1./(2.*DX(I,J))
               R2DY   = 1./(2.*DY(I,J))
               DDVDX(I,J)   = (VWND(I+1,J)-VWND(I-1,J))*R2DX

sorc/ncep_post.fd/UPP_PHYSICS.f

@@ -1692,6 +1692,7 @@ end function TVIRTUAL
 !> 2016-08-05 | S Moorthi    | add zonal filetering
 !> 2019-10-17 | Y Mao        | Skip calculation when U/V is SPVAL
 !> 2020-11-06 | J Meng       | Use UPP_MATH Module
+!> 2022-05-26 | H Chuang     | Use GSL approach for FV3R
 !>
 !> @author Russ Treadon W/NP2 @date 1992-12-22
       SUBROUTINE CALVOR(UWND,VWND,ABSV)
@@ -2041,13 +2042,14 @@ SUBROUTINE CALVOR(UWND,VWND,ABSV)
           JMT2 = JM/2+1
           TPHI = (J-JMT2)*(DYVAL/gdsdegr)*DTR
           DO I=ISTA_M,IEND_M
-            IF(VWND(I+1,J)<SPVAL.AND.VWND(I-1,J)<SPVAL.AND.              &
+            IF(DDVDX(I,J)<SPVAL.AND.DDUDY(I,J)<SPVAL.AND. &
+               UUAVG(I,J)<SPVAL.AND.UWND(I,J)<SPVAL.AND.  &
      &         UWND(I,J+1)<SPVAL.AND.UWND(I,J-1)<SPVAL) THEN
               DVDX   = DDVDX(I,J)
               DUDY   = DDUDY(I,J)
               UAVG   = UUAVG(I,J) 
 !  is there a (f+tan(phi)/erad)*u term?
-              IF(MODELNAME  == 'RAPR') then
+              IF(MODELNAME  == 'RAPR' .OR. MODELNAME  == 'FV3R') then
                  ABSV(I,J) = DVDX - DUDY + F(I,J)   ! for run RAP over north pole      
               else
                  ABSV(I,J) = DVDX - DUDY + F(I,J) + UAVG*TAN(GDLAT(I,J)*DTR)/ERAD  ! not sure about this???