!
!##################################################################
!##################################################################
!######                                                      ######
!######                SUBROUTINE TRANS                      ######
!######                                                      ######
!######    Center for Analysis and Prediction of Storms      ######
!######    University of Oklahoma.                           ######
!######                                                      ######
!##################################################################
!##################################################################
!
!
!-----------------------------------------------------------------------
!
!  PURPOSE:
!
!  Convert (u,v,pprt,ptprt,qv,w) to x
!
!-----------------------------------------------------------------------
!
!  AUTHOR: JIDONG GAO
!  01/17/00
!
!
!-----------------------------------------------------------------------
!
!

SUBROUTINE trans(numctr,nx,ny,nz,u,v,pprt,ptprt,qv,w,x) 1
!  INPUT:
!
!    numctr     The number of components of the control variables.
!    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).
!    pprt     Perturbation pressure at all time levels (Pascal)
!    ptprt    Perturbation potential temperature at all time levels (K)
!    qv       Water vapor specific humidity at all time levels (kg/kg)
!    w        z-component of velocity at all time levels (m/s).
!
!    Output:
!    x        The control variable.
!
!    Temporary Variables:
!    itemp    Temporary variable indicating the position of the index.
!    i,j,k
!
!-----------------------------------------------------------------------
!
!
!  Variable Declarations.
!
!-----------------------------------------------------------------------
!
  IMPLICIT NONE

  INTEGER :: numctr         ! The no. of components of the control var.
  INTEGER :: itemp, i,j,k ! Temporary variables.

  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 :: pprt  (nx,ny,nz)  ! Perturbation pressure from that
  REAL :: ptprt (nx,ny,nz)  ! Perturbation potential temperature
  REAL :: qv    (nx,ny,nz)  ! Water vapor specific humidity (kg/kg).
  REAL :: w     (nx,ny,nz)  ! Total w-velocity (m/s).
  REAL :: x     (numctr)       ! Control variable.
!
!    only initial conditions are controled.
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
!  Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
!-----------------------------------------------------------------------
!
!  We first place the initial conditions for (u,v,w,ptprt,pprt,qv)
!  in x in the order as they appear.
!
!-----------------------------------------------------------------------
!
  itemp = 0

  DO i=1,nx
    DO j=1,ny
      DO k=1,nz
        itemp=itemp+1
        x(itemp)=u    (i,j,k)
      END DO
    END DO
  END DO

  DO i=1,nx
    DO j=1,ny
      DO k=1,nz
        itemp=itemp+1
        x(itemp)=v    (i,j,k)
      END DO
    END DO
  END DO

  DO i=1,nx
    DO j=1,ny
      DO k=1,nz
        itemp=itemp+1
        x(itemp)=pprt (i,j,k)
      END DO
    END DO
  END DO

  DO i=1,nx
    DO j=1,ny
      DO k=1,nz
        itemp=itemp+1
        x(itemp)=ptprt(i,j,k)
      END DO
    END DO
  END DO

  DO i=1,nx
    DO j=1,ny
      DO k=1,nz
        itemp=itemp+1
        x(itemp)=qv   (i,j,k)
      END DO
    END DO
  END DO

  DO i=1,nx
    DO j=1,ny
      DO k=1,nz
        itemp=itemp+1
        x(itemp)=w    (i,j,k)
      END DO
    END DO
  END DO

!
!-----------------------------------------------------------------------
!
!  End of processing initial conditions.
!
!-----------------------------------------------------------------------
!
!
  RETURN
END SUBROUTINE trans
!
!##################################################################
!##################################################################
!######                                                      ######
!######                SUBROUTINE TRANSI                     ######
!######                                                      ######
!######    Center for Analysis and Prediction of Storms      ######
!######    University of Oklahoma.  All rights reserved.     ######
!######                                                      ######
!##################################################################
!##################################################################
!


SUBROUTINE transi(numctr,nx,ny,nz,u,v,pprt,ptprt,qv,w,x) 3
!
!-----------------------------------------------------------------------
!
!  PURPOSE:
!
!  Convert x to (u,v,w,ptprt,pprt,qv)
!
!-----------------------------------------------------------------------
!
!  AUTHOR: JIDONG GAO
!  01/17/00
!
!  MODIFICATION HISTORY:
!
!-----------------------------------------------------------------------
!
!  INPUT:
!
!    numctr     The number of components of the control variables.
!    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).
!    pprt     Perturbation pressure at all time levels (Pascal)
!    ptprt    Perturbation potential temperature at all time levels (K)
!    qv       Water vapor specific humidity at all time levels (kg/kg)
!    w        z-component of velocity at all time levels (m/s).
!
!    Output:
!    x        The control variable.
!
!    Temporary Variables:
!    itemp    Temporary variable indicating the position of the index.
!    i,j,k
!
!-----------------------------------------------------------------------
!
!
!  Variable Declarations.
!
!-----------------------------------------------------------------------
!
  IMPLICIT NONE

  INTEGER :: numctr         ! The no. of components of the control var.
  INTEGER :: itemp, i,j,k ! Temporary variables.

  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 :: pprt  (nx,ny,nz)  ! Perturbation pressure from that
  REAL :: ptprt (nx,ny,nz)  ! Perturbation potential temperature
  REAL :: qv    (nx,ny,nz)  ! Water vapor specific humidity (kg/kg).
  REAL :: w     (nx,ny,nz)  ! Total w-velocity (m/s).
  REAL :: x     (numctr)       ! Control variable.
!
!    only initial conditions are controled.
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
!  Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
!-----------------------------------------------------------------------
!
!  We first place the initial conditions for (u,v,w,ptprt,pprt,qv)
!  in x in the order as they appear.
!
!-----------------------------------------------------------------------
!
  itemp = 0

  DO i=1,nx
    DO j=1,ny
      DO k=1,nz
        itemp=itemp+1
        u    (i,j,k) = x(itemp)
      END DO
    END DO
  END DO

  DO i=1,nx
    DO j=1,ny
      DO k=1,nz
        itemp=itemp+1
        v    (i,j,k) = x(itemp)
      END DO
    END DO
  END DO

  DO i=1,nx
    DO j=1,ny
      DO k=1,nz
        itemp=itemp+1
        pprt (i,j,k) = x(itemp)
      END DO
    END DO
  END DO

  DO i=1,nx
    DO j=1,ny
      DO k=1,nz
        itemp=itemp+1
        ptprt(i,j,k) = x(itemp)
      END DO
    END DO
  END DO

  DO i=1,nx
    DO j=1,ny
      DO k=1,nz
        itemp=itemp+1
        qv   (i,j,k) = x(itemp)
      END DO
    END DO
  END DO

  DO i=1,nx
    DO j=1,ny
      DO k=1,nz
        itemp=itemp+1
        w    (i,j,k) = x(itemp)
      END DO
    END DO
  END DO

!
!-----------------------------------------------------------------------
!
!  End of processing initial conditions.
!
!-----------------------------------------------------------------------
!
!
  RETURN
END SUBROUTINE transi
!
!##################################################################
!##################################################################
!######                                                      ######
!######                SUBROUTINE PRODUCT                    ######
!######                                                      ######
!######    Center for Analysis and Prediction of Storms      ######
!######    University of Oklahoma.  All rights reserved.     ######
!######                                                      ######
!##################################################################
!##################################################################
!


SUBROUTINE product(a,b,nx,ny,nz,                                        &
           ibgn,iend,jbgn,jend,kbgn,kend,pr)

!
!-----------------------------------------------------------------------
!
!  PURPOSE:
!
!  Calculate the product SIGMA a(i,j,k)*b(i,j,k).
!
!-----------------------------------------------------------------------
!
!  AUTHOR: JIDONG GAO
!  01/23/00
!
!  MODIFICATION HISTORY:
!
!-----------------------------------------------------------------------
!
!  INPUT:
!
!    nx       First dimension of arrays a, b and ab
!    ny       Second dimension of arrays a, b and ab
!    nz       Third dimension of arrays a, b and ab
!
!    a        First multiplier array
!    b        Second multiplier array
!
!    ibgn     i-index where multiplication begins.
!    iend     i-index where multiplication ends.
!    jbgn     j-index where multiplication begins.
!    jend     j-index where multiplication ends.
!    kbgn     k-index where multiplication begins.
!    kend     k-index where multiplication ends.
!
!  OUTPUT:
!
!    pr     The sum of the product a(i,j,k)*b(i,j,k).
!
!-----------------------------------------------------------------------
!
!  Variable Declarations.
!
!-----------------------------------------------------------------------
!
  IMPLICIT NONE
!
  INTEGER :: nx, ny, nz        ! Number of grid points in 3 directions
!
  REAL :: a (nx,ny,nz)         ! Input array 1
  REAL :: b (nx,ny,nz)         ! Input array 2
!
  INTEGER :: ibgn,iend,jbgn,jend,kbgn,kend
!
  REAL :: pr                   ! The sum of the product a(i,j,k)*b(i,j,k).
!
!-----------------------------------------------------------------------
!
!  Misc. local variables:
!
!-----------------------------------------------------------------------
!
  INTEGER :: i,j,k
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
!  Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!

  pr=0.
  DO k=kbgn,kend
    DO j=jbgn,jend
      DO i=ibgn,iend

        pr=pr+a(i,j,k)*b(i,j,k)

      END DO
    END DO
  END DO

  RETURN
END SUBROUTINE product