!
!##################################################################
!##################################################################
!###### ######
!###### SUBROUTINE VRHOLE ######
!###### ######
!###### Developed by ######
!###### Center for Analysis and Prediction of Storms ######
!###### University of Oklahoma ######
!###### ######
!##################################################################
!##################################################################
!
SUBROUTINE vrhole(nx,ny,nz,x,y,z,zp, & 1,3
u,v,w, &
vrom,ubar,vbar,ptol, &
tem4,tem5,tem6,tem7,tem8,tem9)
!
!-----------------------------------------------------------------------
!
! PURPOSE:This program is designed to fill-in the holes for missing
! single-Doppler data on a Cartesian grid.
!
!-----------------------------------------------------------------------
!
!-----------------------------------------------------------------------
!
! AUTHOR: Steve Weygandt
!
!
! MODIFICATION HISTORY:
!
! 1/96 (Steve Lazarus)
! Created this sbroutine from a block of code generated by SW.
!
! 23/02/96 (Limin Zhao)
! Adapted the code into the data assimilation package.
!
! 06/03/96 (Limin Zhao)
! Added the include file 'assim.inc'
!
! 08/03/96 (Limin Zhao)
! Added checks for processing real data.
!
!-----------------------------------------------------------------------
!
!
!-----------------------------------------------------------------------
!
! INPUT ARRAYS:
!
!
! vrom Observed radial velocity on model grid scalar point.
!
! ubar Base-state u wind component
! vbar Base-state v wind component
!
! nx Number of grid points in the x-direction (east/west)
! ny Number of grid points in the y-direction (north/south)
! nz Number of grid points in the z-direction (vertical)
!
! dx Grid spacing in the x-direction (east/west)
! dy Grid spacing in the y-direction (north/south)
! dz Grid spacing in the z-direction (vertical)
!
! OUTPUT ARRAYS:
!
! tem9 Output hole-filled vr (observed)
!
!
! WORK ARRAYS:
!
! tem4
! tem5
! tem6
! tem7
! tem8
!
!-----------------------------------------------------------------------
!
!
!-----------------------------------------------------------------------
!
! Variable Declarations:
!
!-----------------------------------------------------------------------
!
IMPLICIT NONE ! Force explicit declarations
INTEGER :: nx, ny, nz ! Number of grid points in 3 directions
REAL :: u(nx,ny,nz) !Note: u,v,w are working arrays here.
REAL :: v(nx,ny,nz)
REAL :: w(nx,ny,nz)
REAL :: vrom (nx,ny,nz) ! Observed radial velocity on model grid
REAL :: ubar (nx,ny,nz) ! U component mean wind
REAL :: vbar (nx,ny,nz) ! V component mean wind
REAL :: tem4 (nx,ny,nz) ! Work array
REAL :: tem5 (nx,ny,nz) ! Work array
REAL :: tem6 (nx,ny,nz) ! Work array
REAL :: tem7 (nx,ny,nz) ! Work array
REAL :: tem8 (nx,ny,nz) ! Work array
REAL :: tem9 (nx,ny,nz) ! Hole-filled vr
REAL :: x (nx) ! Work array
REAL :: y (ny) ! Work array
REAL :: z (nz) ! Work array
REAL :: zp (nx,ny,nz) ! Work array
REAL :: assimtim (100)
REAL :: ptol
!
!-----------------------------------------------------------------------
!
! Miscellaneous local variables:
!
!-----------------------------------------------------------------------
!
INTEGER :: i,j,k ! Do-loop indices
INTEGER :: count
REAL :: rad,xs,ys,zs
REAL :: xmove,ymove
!-----------------------------------------------------------------------
!
! Include files:
!
!-----------------------------------------------------------------------
!
INCLUDE 'globcst.inc' ! Model control constants
INCLUDE 'assim.inc' ! Assim/Retr control parameters
INCLUDE 'grid.inc'
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
! Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
WRITE(6,*) 'code in vrhole; spval=',spval
WRITE(6,*) 'adas mean wind ubar(5,5,5),vbar(5,5,5): ', &
ubar(5,5,5),vbar(5,5,5)
WRITE(6,*) 'xshift,yshift,zshift: ', xshift,yshift,zshift
umove=0.0
vmove=0.0
xmove= xshift - umove*(curtim-assimtim(1))
ymove= yshift - vmove*(curtim-assimtim(1))
count = 0
DO k=1,nz
DO j=1,ny
DO i=1,nx
tem5(i,j,k) = 0.0
tem4(i,j,k) = 0.0
tem6(i,j,k) = 0.0
tem7(i,j,k) = 0.0
tem8(i,j,k) = 0.0
tem9(i,j,k) = 0.0
END DO
END DO
END DO
DO k=1,nz-1
DO j=1,ny-1
DO i=1,nx-1
tem6(i,j,k) = 0.0
tem7(i,j,k) = 0.0
tem8(i,j,k) = 0.0
xs = 0.5*(x(i)+x(i+1)) - xmove
ys = 0.5*(y(j)+y(j+1)) - ymove
zs = 0.5*(z(k)+z(k+1)) - zshift
rad = SQRT(xs**2+ys**2+zs**2)
IF(vrom(i,j,k) /= spval) THEN
tem5(i,j,k) = vrom(i,j,k)*(xs/rad)-u(i,j,k)
tem4(i,j,k) = 0.0
ELSE IF(i == 1.OR.i == nx-1.OR.j == 1.OR.j == ny-1) THEN
tem5(i,j,k) = 0.0
tem4(i,j,k) = 0.0
ELSE ! Fill vru outside rain regions
tem5(i,j,k) = 0.0
tem4(i,j,k) = spval
count = count + 1
END IF
END DO
END DO
END DO
PRINT *,'On call to POIS3D, there are ',count,' filled vrU values'
CALL pois3d
(nx,ny,nz,dx,dy,dz,ptol,2.0,tem8,tem4,tem5,tem6,tem7)
DO k=1,nz-1
DO j=1,ny-1
DO i=1,nx-1
xs = 0.5*(x(i)+x(i+1)) - xmove
ys = 0.5*(y(j)+y(j+1)) - ymove
zs = 0.5*(z(k)+z(k+1)) - zshift
rad = SQRT(xs**2+ys**2+zs**2)
tem9(i,j,k) = tem5(i,j,k)*xs/rad + tem9(i,j,k)
END DO
END DO
END DO
count = 0
DO k=1,nz-1
DO j=1,ny-1
DO i=1,nx-1
tem6(i,j,k) = 0.0
tem7(i,j,k) = 0.0
tem8(i,j,k) = 0.0
xs = 0.5*(x(i)+x(i+1)) - xmove
ys = 0.5*(y(j)+y(j+1)) - ymove
zs = 0.5*(z(k)+z(k+1)) - zshift
rad = SQRT(xs**2+ys**2+zs**2)
IF(vrom(i,j,k) /= spval) THEN
tem5(i,j,k) = vrom(i,j,k)*(ys/rad)-v(i,j,k)
tem4(i,j,k) = 0.0
ELSE IF(i == 1.OR.i == nx-1.OR.j == 1.OR.j == ny-1) THEN
tem5(i,j,k) = 0.0
tem4(i,j,k) = 0.0
ELSE ! Fill vrV outside rain regions
tem5(i,j,k) = 0.0
tem4(i,j,k) = spval
count = count + 1
END IF
END DO
END DO
END DO
PRINT *,'On call to POIS3D, there are ',count,' filled vrV values'
CALL pois3d
(nx,ny,nz,dx,dy,dz,ptol,2.0,tem8,tem4,tem5,tem6,tem7)
DO k=1,nz-1
DO j=1,ny-1
DO i=1,nx-1
xs = 0.5*(x(i)+x(i+1)) - xmove
ys = 0.5*(y(j)+y(j+1)) - ymove
zs = 0.5*(z(k)+z(k+1)) - zshift
rad = SQRT(xs**2+ys**2+zs**2)
tem9(i,j,k) = tem5(i,j,k)*ys/rad + tem9(i,j,k)
END DO
END DO
END DO
count = 0
DO k=1,nz-1
DO j=1,ny-1
DO i=1,nx-1
tem6(i,j,k) = 0.0
tem7(i,j,k) = 0.0
tem8(i,j,k) = 0.0
xs = 0.5*(x(i)+x(i+1)) - xmove
ys = 0.5*(y(j)+y(j+1)) - ymove
zs = 0.5*(z(k)+z(k+1)) - zshift
rad = SQRT(xs**2+ys**2+zs**2)
IF(vrom(i,j,k) /= spval) THEN
tem5(i,j,k) = vrom(i,j,k)*(zs/rad)
tem4(i,j,k) = 0.0
ELSE IF(k == 2.OR.k == nz-1) THEN
tem5(i,j,k) = 0.0
tem4(i,j,k) = 0.0
ELSE ! Fill w outside rain regions
tem5(i,j,k) = 0.0
tem4(i,j,k) = spval
count = count + 1
END IF
END DO
END DO
END DO
PRINT *,'On call to POIS3D, there are ',count,' filled vrW values'
CALL pois3d
(nx,ny,nz,dx,dy,dz,ptol,2.0,tem8,tem4,tem5,tem6,tem7)
DO k=1,nz-1
DO j=1,ny-1
DO i=1,nx-1
rad = SQRT(xs**2+ys**2+zs**2)
xs = 0.5*(x(i)+x(i+1)) - xmove
ys = 0.5*(y(j)+y(j+1)) - ymove
zs = 0.5*(z(k)+z(k+1)) - zshift
rad = SQRT(xs**2+ys**2+zs**2)
tem9(i,j,k) = tem5(i,j,k)*zs/rad + tem9(i,j,k)
END DO
END DO
END DO
DO k=1,nz-1
DO j=1,ny-1
DO i=1,nx-1
xs = 0.5*(x(i)+x(i+1)) - xmove
ys = 0.5*(y(j)+y(j+1)) - ymove
zs = 0.5*(z(k)+z(k+1)) - zshift
rad = SQRT(xs**2+ys**2+zs**2)
tem9(i,j,k) = tem9(i,j,k) + u(i,j,k)*(xs/rad) &
+ v(i,j,k)*(ys/rad)
vrom(i,j,k) = tem9(i,j,k)
END DO
END DO
END DO
RETURN
END SUBROUTINE vrhole