!
!
!##################################################################
!##################################################################
!###### ######
!###### SUBROUTINE WCONTRA ######
!###### ######
!###### Developed by ######
!###### Center for the Analysis and Prediction of Storms ######
!###### University of Oklahoma ######
!###### ######
!##################################################################
!##################################################################
!
SUBROUTINE wcontra(nx,ny,nz,u,v,w,mapfct,j1,j2,j3,aj3z, & 9,1
rhostr,rhostru,rhostrv,rhostrw,wcont,ustr,vstr)
!
!-----------------------------------------------------------------------
!
! PURPOSE:
!
! Calculate wcont, the contravariant vertical velocity (m/s)
!
!-----------------------------------------------------------------------
!
! AUTHOR: Ming Xue & Hao Jin
! 1/4/1993.
!
! Modification history:
! 8/29/94 (A. Shapiro)
! Bug fix. Call to vbcwcont moved outside IF block.
!
! 9/9/94 (M. Xue)
! Optimized.
!
! 1/25/96 (Donghai Wang & Yuhe Liu)
! Added the map projection factor to ARPS governing equations.
!
! 11/06/97 (D. Weber)
! Added three additional levels to the mapfct array. The three
! levels (4,5,6) represent the inverse of the first three in order.
! The inverse map factors are computed to improve efficiency.
!
! 9/28/98 (D. Weber)
! Added (mapfct(i,j,7-8) and aj3z to improve efficiency.
!
!-----------------------------------------------------------------------
!
! INPUT:
!
! 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 vertical
!
! u x component of velocity at all time levels (m/s)
! v y component of velocity at all time levels (m/s)
! w Vertical component of Cartesian velocity
! at all time levels (m/s)
!
! mapfct Map factors at scalar, u and v points
!
! j1 Coordinate transform Jacobian -d(zp)/dx
! j2 Coordinate transform Jacobian -d(zp)/dy
! j3 Coordinate transform Jacobian d(zp)/dz
! aj3z Avgz of the coordinate transformation Jacobian d(zp)/dz
!
! rhostr j3 times base state density rhobar(kg/m**3).
! rhostru Average rhostr at u points (kg/m**3).
! rhostrv Average rhostr at v points (kg/m**3).
! rhostrw Average rhostr at w points (kg/m**3).
!
! OUTPUT:
!
! wcont Vertical component of contravariant velocity in
! computational coordinates (m/s)
!
! WORK ARRAYS:
!
! ustr Work array
! vstr Work array
!
!-----------------------------------------------------------------------
!
!
!-----------------------------------------------------------------------
!
! Variable Declarations.
!
!-----------------------------------------------------------------------
!
IMPLICIT NONE
INTEGER :: nx,ny,nz ! The number of grid points in 3
! directions
REAL :: u (nx,ny,nz) ! Total u-velocity (m/s)
REAL :: v (nx,ny,nz) ! Total v-velocity (m/s)
REAL :: w (nx,ny,nz) ! Total w-velocity (m/s)
REAL :: mapfct(nx,ny,8) ! Map factors at scalar, u and v points
REAL :: j1 (nx,ny,nz) ! Coordinate transform Jacobian
! defined as - d( zp )/d( x ).
REAL :: j2 (nx,ny,nz) ! Coordinate transform Jacobian
! defined as - d( zp )/d( y ).
REAL :: j3 (nx,ny,nz) ! Coordinate transform Jacobian
! defined as d( zp )/d( z ).
REAL :: aj3z (nx,ny,nz) ! Coordinate transformation Jacobian defined
! as d( zp )/d( z ) AVERAGED IN THE Z-DIR.
REAL :: rhostr(nx,ny,nz) ! j3 times base state density rhobar
! (kg/m**3).
REAL :: rhostru(nx,ny,nz) ! Average rhostr at u points (kg/m**3).
REAL :: rhostrv(nx,ny,nz) ! Average rhostr at v points (kg/m**3).
REAL :: rhostrw(nx,ny,nz) ! Average rhostr at w points (kg/m**3).
REAL :: wcont (nx,ny,nz) ! Vertical velocity in computational
! coordinates (m/s)
REAL :: ustr (nx,ny,nz) ! temporary work array
REAL :: vstr (nx,ny,nz) ! temporary work array
!-----------------------------------------------------------------------
!
! Include files:
!
!-----------------------------------------------------------------------
!
INCLUDE 'globcst.inc'
!
!-----------------------------------------------------------------------
!
! Misc. local variables:
!
!-----------------------------------------------------------------------
!
INTEGER :: i,j,k
!
!-----------------------------------------------------------------------
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
! Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
IF( crdtrns == 0 ) THEN ! No coord. transformation case.
DO k= 2,nz-1
DO j= 1,ny-1
DO i= 1,nx-1
wcont(i,j,k)=w(i,j,k)
END DO
END DO
END DO
ELSE IF( ternopt == 0) THEN
DO k= 2,nz-1
DO j= 1,ny-1
DO i= 1,nx-1
wcont(i,j,k)=w(i,j,k)/aj3z(i,j,k)
END DO
END DO
END DO
ELSE
DO k= 1,nz-1
DO j= 1,ny-1
DO i= 1,nx
ustr(i,j,k)=u(i,j,k)*rhostru(i,j,k)
END DO
END DO
END DO
DO k= 1,nz-1
DO j= 1,ny
DO i= 1,nx-1
vstr(i,j,k)=v(i,j,k)*rhostrv(i,j,k)
END DO
END DO
END DO
DO k= 2,nz-1
DO j= 1,ny-1
DO i= 1,nx-1
wcont(i,j,k)= ( &
((ustr(i ,j,k)+ustr(i ,j,k-1))*j1(i ,j,k) &
+(ustr(i+1,j,k)+ustr(i+1,j,k-1))*j1(i+1,j,k) &
+(vstr(i ,j,k)+vstr(i ,j,k-1))*j2(i ,j,k) &
+(vstr(i,j+1,k)+vstr(i,j+1,k-1))*j2(i,j+1,k)) &
* mapfct(i,j,8) &
/ rhostrw(i,j,k) + w(i,j,k) &
) /aj3z(i,j,k)
END DO
END DO
END DO
END IF
CALL vbcwcont
(nx,ny,nz,wcont)
!call test_dump (wcont,"XXXwc_wcont1",nx,ny,nz,1,0)
!call test_dump (wcont,"XXXwc_wcont",nx,ny,nz,0,0)
!call test_dump (ustr,"XXXwc_ustr",nx,ny,nz,1,0)
!call test_dump (vstr,"XXXwc_vstr2",nx,ny,nz,2,0)
!call test_dump (vstr,"XXXwc_vstr1",nx,ny,nz,1,0)
!call test_dump (w,"XXXwc_w1",nx,ny,nz,1,0)
RETURN
END SUBROUTINE wcontra
!
!
!##################################################################
!##################################################################
!###### ######
!###### SUBROUTINE WCTOW ######
!###### ######
!###### Developed by ######
!###### Center for the Analysis and Prediction of Storms ######
!###### University of Oklahoma ######
!###### ######
!##################################################################
!##################################################################
!
SUBROUTINE wctow(nx,ny,nz,u,v,wcont,mapfct, & 2,2
j1,j2,j3,aj3z,rhostr,rhostru,rhostrv,rhostrw,ubc,bbc, &
w, &
ustr,vstr)
!
!-----------------------------------------------------------------------
!
! PURPOSE:
!
! Calculate w from wcont, the contravariant vertical velocity (m/s)
!
!-----------------------------------------------------------------------
!
! AUTHOR: Ming Xue
! 7/28/1998.
!
! Modification history:
!
! 9/28/98 (D. Weber)
! Added aj3z to improve efficiency.
!
!-----------------------------------------------------------------------
!
! INPUT:
!
! 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 vertical
!
! u x component of velocity at all time levels (m/s)
! v y component of velocity at all time levels (m/s)
! wcont Vertical component of contravariant velocity in
! computational coordinates (m/s)
!
! mapfct Map factors at scalar, u and v points
!
! j1 Coordinate transform Jacobian -d(zp)/dx
! j2 Coordinate transform Jacobian -d(zp)/dy
! j3 Coordinate transform Jacobian d(zp)/dz
! aj3z Avgz of the coordinate transformation Jacobian d(zp)/dz
!
! rhostr j3 times base state density rhobar(kg/m**3).
! rhostru Average rhostr at u points (kg/m**3).
! rhostrv Average rhostr at v points (kg/m**3).
! rhostrw Average rhostr at w points (kg/m**3).
! ubc, bbc Flags for upper and bottom boundary conditions
!
! OUTPUT:
!
! w Vertical component of Cartesian velocity (m/s)
!
! WORK ARRAYS:
!
! ustr Work array
! vstr Work array
!
!-----------------------------------------------------------------------
!
!
!-----------------------------------------------------------------------
!
! Variable Declarations.
!
!-----------------------------------------------------------------------
!
IMPLICIT NONE
INTEGER :: nx,ny,nz ! The number of grid points in 3
! directions
REAL :: u (nx,ny,nz) ! Total u-velocity (m/s)
REAL :: v (nx,ny,nz) ! Total v-velocity (m/s)
REAL :: wcont (nx,ny,nz) ! Vertical velocity in computational
! coordinates (m/s)
REAL :: mapfct(nx,ny,8) ! Map factors at scalar, u and v points
REAL :: j1 (nx,ny,nz) ! Coordinate transform Jacobian
! defined as - d( zp )/d( x ).
REAL :: j2 (nx,ny,nz) ! Coordinate transform Jacobian
! defined as - d( zp )/d( y ).
REAL :: j3 (nx,ny,nz) ! Coordinate transform Jacobian
! defined as d( zp )/d( z ).
REAL :: aj3z (nx,ny,nz) ! Coordinate transformation Jacobian defined
! as d( zp )/d( z ) AVERAGED IN THE Z-DIR.
REAL :: rhostr(nx,ny,nz) ! j3 times base state density rhobar
! (kg/m**3).
REAL :: rhostru(nx,ny,nz) ! Average rhostr at u points (kg/m**3).
REAL :: rhostrv(nx,ny,nz) ! Average rhostr at v points (kg/m**3).
REAL :: rhostrw(nx,ny,nz) ! Average rhostr at w points (kg/m**3).
INTEGER :: ubc, bbc ! Flags for upper and bottom boundary conditions
REAL :: w (nx,ny,nz) ! Total w-velocity (m/s)
REAL :: ustr (nx,ny,nz) ! temporary work array
REAL :: vstr (nx,ny,nz) ! temporary work array
!-----------------------------------------------------------------------
!
! Include files:
!
!-----------------------------------------------------------------------
!
INCLUDE 'globcst.inc'
!
!-----------------------------------------------------------------------
!
! Misc. local variables:
!
!-----------------------------------------------------------------------
!
INTEGER :: i,j,k
!
!-----------------------------------------------------------------------
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
! Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
IF( crdtrns == 0 ) THEN ! No coord. transformation case.
DO k= 1,nz
DO j= 1,ny-1
DO i= 1,nx-1
w(i,j,k)=wcont(i,j,k)
END DO
END DO
END DO
ELSE IF( ternopt == 0) THEN
DO k= 2,nz-1
DO j= 1,ny-1
DO i= 1,nx-1
w(i,j,k)=wcont(i,j,k)*aj3z(i,j,k)
END DO
END DO
END DO
CALL vbcw
(nx,ny,nz,w,wcont,ubc,bbc,u,v, &
rhostr,rhostru,rhostrv,rhostrw, &
j1,j2,j3)
ELSE
DO k= 1,nz-1
DO j= 1,ny-1
DO i= 1,nx
ustr(i,j,k)=u(i,j,k)*rhostru(i,j,k)
END DO
END DO
END DO
DO k= 1,nz-1
DO j= 1,ny
DO i= 1,nx-1
vstr(i,j,k)=v(i,j,k)*rhostrv(i,j,k)
END DO
END DO
END DO
DO k= 2,nz-1
DO j= 1,ny-1
DO i= 1,nx-1
w(i,j,k)= ( wcont(i,j,k) - &
((ustr(i ,j,k)+ustr(i ,j,k-1))*j1(i ,j,k) &
+(ustr(i+1,j,k)+ustr(i+1,j,k-1))*j1(i+1,j,k) &
+(vstr(i ,j,k)+vstr(i ,j,k-1))*j2(i ,j,k) &
+(vstr(i,j+1,k)+vstr(i,j+1,k-1))*j2(i,j+1,k)) &
* mapfct(i,j,8)/ rhostrw(i,j,k) &
) * aj3z(i,j,k)
END DO
END DO
END DO
CALL vbcw
(nx,ny,nz,w,wcont,ubc,bbc,u,v, &
rhostr,rhostru,rhostrv,rhostrw, &
j1,j2,j3)
END IF
RETURN
END SUBROUTINE wctow