diff --git a/sorc/ncep_post.fd/INITPOST_NETCDF.f b/sorc/ncep_post.fd/INITPOST_NETCDF.f index 5a3018395..ba78397e9 100644 --- a/sorc/ncep_post.fd/INITPOST_NETCDF.f +++ b/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) diff --git a/sorc/ncep_post.fd/UPP_MATH.f b/sorc/ncep_post.fd/UPP_MATH.f index 28da9b87a..a19eaf06d 100644 --- a/sorc/ncep_post.fd/UPP_MATH.f +++ b/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)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 diff --git a/sorc/ncep_post.fd/UPP_PHYSICS.f b/sorc/ncep_post.fd/UPP_PHYSICS.f index 239cbde7a..cc609aabf 100644 --- a/sorc/ncep_post.fd/UPP_PHYSICS.f +++ b/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)