!
!##################################################################
!##################################################################
!######                                                      ######
!######                 SUBROUTINE ADASREAD                  ######
!######                                                      ######
!######                     Developed by                     ######
!######     Center for Analysis and Prediction of Storms     ######
!######                University of Oklahoma                ######
!######                                                      ######
!##################################################################
!##################################################################
!
!


SUBROUTINE adasread(nx,ny,nz,x,y,z,zp,                                  & 1,7
           isrc,ireturn,adastim,                                        &
           ubar,vbar,pbar,ptbar,rhostr,qvbar,                           &
           u,v,w,pprt,ptprt,qv,qc,qr,qi,qs,qh,j1,j2,j3,                 &
           tem1,tem2,tem3,tem4,tem5,tem6,tem7,tem8,                     &
           tem9,rhobar)
!
!-----------------------------------------------------------------------
!
!  PURPOSE:
!
!  Coordinates the ingestion of ADAS background data files.
!
!-----------------------------------------------------------------------
!
!  AUTHOR: Limin Zhao
!
!  2/21/1996
!
!  MODIFICATION HISTORY:
!
!  2/17/97 (L. Zhao)
!  Modified the code to ingest the ARPS4.2.4 history format.
!
!-----------------------------------------------------------------------
!
!  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
!
!    x        x coordinate of grid points in physical/comp. space (m)
!    y        y coordinate of grid points in physical/comp. space (m)
!    z        z coordinate of grid points in computational space (m)
!    zp       Vertical coordinate of grid points in physical space (m)
!
!  OUTPUT:
!
!    ireturn  Flag, indicating read status of input file
!             = 0 Successful read
!             = 1 Unsuccessful read
!
!    adastim  Times of all input files
!
!    ubar     Base state x velocity component (m/s)
!    vbar     Base state y velocity component (m/s)
!    pbar     Base state pressure (Pascal)
!    ptbar    Base state potential temperature (K)
!    rhostr   Base state density (kg/m**3) times j3
!    qvbar    Base state water vapor specific humidity (kg/kg)
!    rhobar   Base state density (kg/m**3)
!
!    u        x component of velocity at a given time level (m/s)
!    v        y component of velocity at a given time level (m/s)
!    w        Vertical component of Cartesian velocity at a given
!             time level (m/s)
!    pprt     Perturbation pressure at times tpast and tpresent (Pascal)
!    ptprt    Perturbation potential temperature at times tpast and
!             tpresent (K)
!
!    qv       Water vapor specific humidity (kg/kg)
!    qc       Cloud water mixing ratio (kg/kg)
!    qr       Rain water mixing ratio (kg/kg)
!    qi       Cloud ice mixing ratio (kg/kg)
!    qs       Snow mixing ratio (kg/kg)
!    qh       Hail mixing ratio (kg/kg)
!    tke      Turbulent Kinetic Energy ((m/s)**2)
!
!    kmh      Horizontal turb. mixing coef. for momentum ( m**2/s )
!    kmv      Vertical turb. mixing coef. for momentum ( m**2/s )
!
!
!  WORK ARRAYS:
!
!    tem1     Temporary work array.
!    tem2     Temporary work array.
!    tem3     Temporary work array.
!    tem4     Temporary work array.
!    tem5     Temporary work array.
!    tem6     Temporary work array.
!    tem7     Temporary work array.
!    tem8     Temporary work array.
!    tem9     Temporary work array.
!
!-----------------------------------------------------------------------
!
!  Variable Declarations.
!
!-----------------------------------------------------------------------
!
  IMPLICIT NONE
!
  INTEGER :: nt           ! Number of time levels of time-dependent arrays.
  INTEGER :: tim          ! Index of time level.
  INTEGER :: tpast        ! Index of time level for the past time.
  INTEGER :: tpresent     ! Index of time level for the present time.
  INTEGER :: tfuture      ! Index of time level for the future time.

  PARAMETER (nt=3, tpast=1, tpresent=2, tfuture=3)

  INTEGER :: nx, ny, nz        ! Number of grid points in 3 directions

  REAL :: x     (nx)           ! The x-coord. of the physical and
                               ! computational grid. Defined at u-point.
  REAL :: y     (ny)           ! The y-coord. of the physical and
                               ! computational grid. Defined at v-point.
  REAL :: z     (nz)           ! The z-coord. of the computational grid.
                               ! Defined at w-point on the staggered grid.
  REAL :: zp    (nx,ny,nz)     ! The physical height coordinate defined at
                               ! w-point of the staggered grid.

  INTEGER :: isrc             ! Flag indicating source of calling routine
  INTEGER :: nstyps
  REAL :: adastim              ! Time of data input files

  REAL :: ubar  (nx,ny,nz)     ! Base state x-velocity (m/s)
  REAL :: vbar  (nx,ny,nz)     ! Base state y-velocity (m/s)
  REAL :: pbar  (nx,ny,nz)     ! Base state pressure (Pascal)
  REAL :: ptbar (nx,ny,nz)     ! Base state potential temperature (K)
  REAL :: rhostr(nx,ny,nz)     ! Base state air density (kg/m**3) times j3
  REAL :: qvbar (nx,ny,nz)     ! Base state water vapor specific humidity (kg/kg)
  REAL :: rhobar(nx,ny,nz)     ! Base state air density (kg/m**3)

  REAL :: u     (nx,ny,nz,nt)  ! Total u-velocity (m/s)
  REAL :: v     (nx,ny,nz,nt)  ! Total v-velocity (m/s)
  REAL :: w     (nx,ny,nz,nt)  ! Total w-velocity (m/s)
  REAL :: pprt  (nx,ny,nz,nt)  ! Perturbation pressure (Pascal)
  REAL :: ptprt (nx,ny,nz,nt)  ! Perturbation potential temperature (K)

  REAL :: qv    (nx,ny,nz,nt)  ! Water vapor specific humidity (kg/kg)
  REAL :: qc    (nx,ny,nz,nt)  ! Cloud water mixing ratio (kg/kg)
  REAL :: qr    (nx,ny,nz,nt)  ! Rain water mixing ratio (kg/kg)
  REAL :: qi    (nx,ny,nz,nt)  ! Cloud ice mixing ratio (kg/kg)
  REAL :: qs    (nx,ny,nz,nt)  ! Snow mixing ratio (kg/kg)
  REAL :: qh    (nx,ny,nz,nt)  ! Hail mixing ratio (kg/kg)
!  real kte   (nx,ny,nz)     ! Turbulent Kinetic Energy ((m/s)**2)

!   real kmh   (nx,ny,nz)     !Horizontal turb. mixing coef.for momentum ( m**2/s )
!   real kmv   (nx,ny,nz)     !Vertical turb. mixing coef. for momentum ( m**2/s )
  REAL :: j1(nx,ny,nz)
  REAL :: j2(nx,ny,nz)
  REAL :: j3(nx,ny,nz)


  REAL :: tem1  (nx,ny,nz)     ! Temporary work array
  REAL :: tem2  (nx,ny,nz)     ! Temporary work array
  REAL :: tem3  (nx,ny,nz)     ! Temporary work array
  REAL :: tem4  (nx,ny,nz)     ! Temporary work array
  REAL :: tem5  (nx,ny,nz)     ! Temporary work array
  REAL :: tem6  (nx,ny,nz)     ! Temporary work array
  REAL :: tem7  (nx,ny,nz)     ! Temporary work array
  REAL :: tem8  (nx,ny,nz)     ! Temporary work array
  REAL :: tem9  (nx,ny,nz)     ! Temporary work array

  INTEGER :: ireturn

!
!-----------------------------------------------------------------------
!
!  Routines called:
!
!-----------------------------------------------------------------------
!
  EXTERNAL dtahead
  EXTERNAL dtaread
!
!-----------------------------------------------------------------------
!
!  Misc. local variables:
!
!-----------------------------------------------------------------------
!
  INTEGER :: is      ! Counter, used for reading input data
  SAVE    is
  DATA    is/1/

  INTEGER :: i,j,k,n ! Loop index
  INTEGER :: nchanl  ! FORTRAN I/O channel number for history data output.

  INTEGER :: lengbf,lendtf,lbasdmpf
  INTEGER :: itimesv

  REAL :: storstop         ! Temporarily stores the model stop time

  CHARACTER (LEN=128  ) :: saverunm  ! Temporarily stores the name of this run
  CHARACTER (LEN=128    ) :: filein  ! Input file name for recovery
!
!-----------------------------------------------------------------------
!
!  Include files:
!
!-----------------------------------------------------------------------
!
  INCLUDE 'assim.inc'
  INCLUDE 'globcst.inc'
  INCLUDE 'adas.inc'
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
!  Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
!
!-----------------------------------------------------------------------
!
!  If isrc=1, then read the times (adastim) from ADAS data file
!  headers. This is done in order to determine if the background data
!  is available.
!
!-----------------------------------------------------------------------
!
  WRITE(6,*)'code in adasread'

  tim = tpresent

  IF (isrc == 1) THEN

    lendtf=LEN(adasdat(is))
    CALL strlnth( adasdat(is), lendtf)
    WRITE(6,'(/a,a)')'The file name is ',adasdat(is)(1:lendtf)

    saverunm = runname

    CALL dtahead(nx,ny,nz,                                              &
         inifmt,inigbf,lengbf,adasdat(is),                              &
         lendtf,adastim,x,y,z,zp,tem4,tem5,tem6,                        &
         ptprt(1,1,1,tim),pprt(1,1,1,tim),tem7,                         &
         qc(1,1,1,tim),qr(1,1,1,tim),qi(1,1,1,tim),                     &
         qs(1,1,1,tim),qh(1,1,1,tim),tem9,                              &
         ubar,vbar,tem8,ptbar,pbar,rhobar,qvbar,                        &
         ireturn,tem1,tem2,tem3)

    runname = saverunm

    IF(ireturn /= 0) RETURN
!
!-----------------------------------------------------------------------
!
!  Read in a single data file.
!
!-----------------------------------------------------------------------
!
  ELSE IF(isrc == 3) THEN


    lengbf=LEN(inigbf)
    CALL strlnth( inigbf, lengbf)
    WRITE(6,'(/a,a)')                                                   &
        'The grid/base state file name is ',inigbf(1:lengbf)

    lendtf=LEN(adasdat(is))
    CALL strlnth( adasdat(is), lendtf)
    WRITE(6,'(/a,a)')'The file name is ',adasdat(is)(1:lendtf)

    saverunm = runname

    WRITE(6,*)'ADAS background field',adasdat(is)
!
!-----------------------------------------------------------------------
!
!  Set the tem8 array to zero.  This is done to avoid overwriting
!  wbar on calls to dtaread.
!
!-----------------------------------------------------------------------
!
    DO k=1,nz
      DO j=1,ny
        DO i=1,nx
          tem8(i,j,k) = 0.0
        END DO
      END DO
    END DO

    storstop = tstop  ! Temporary. For ingestion of model data
                      ! generated prior to 4.0

    CALL ctim2abss( year, month, day, hour, minute, second, itimesv )
    CALL dtaread(nx,ny,nz,nstyps,                                       &
         inifmt,nchanl,inigbf,lengbf,adasdat(is),                       &
         lendtf,adastim,x,y,z,zp,tem4,tem5,tem6,                        &
         ptprt(1,1,1,tim),pprt(1,1,1,tim),tem7,                         &
         qc(1,1,1,tim),qr(1,1,1,tim),qi(1,1,1,tim),                     &
         qs(1,1,1,tim),qh(1,1,1,tim),tem9,tem9,tem9,                    &
         ubar,vbar,tem8,ptbar,pbar,rhobar,qvbar,                        &
         tem9(1,1,1),tem9(1,1,1),tem9(1,1,1),                           &
         tem9(1,1,1),tem9(1,1,1),tem9(1,1,1),                           &
         tem9(1,1,1),tem9(1,1,1),tem9(1,1,1),                           &
         tem9(1,1,1),tem9(1,1,1),tem9(1,1,1),                           &
         tem9(1,1,1),tem9(1,1,1),tem9(1,1,1),                           &
         tem9(1,1,1),tem9(1,1,1),tem9(1,1,1),                           &
         tem9(1,1,1),tem9(1,1,1),tem9(1,1,1),tem9(1,1,1),               &
         ireturn,tem1,tem2,tem3)

    CALL abss2ctim( itimesv, year, month, day, hour, minute, second )
    tstop   = storstop
    runname = saverunm

    IF(ireturn /= 0) RETURN
!
!-----------------------------------------------------------------------
!
!  The arrays tem2,tem3 and tem4 contain uprt, vprt, wprt
!  respectively. The total fields are stored in u and v.
!
!-----------------------------------------------------------------------
!
    DO i = 1,nx
      DO j = 1,ny-1
        DO k = 1,nz-1
          tem2(i,j,k)  = tem4(i,j,k) + ubar(i,j,k)
          u(i,j,k,tim) = tem2(i,j,k)
        END DO
      END DO
    END DO

    DO i = 1,nx-1
      DO j = 1,ny
        DO k = 1,nz-1
          tem3(i,j,k)  = tem5(i,j,k)+ vbar(i,j,k)
          v(i,j,k,tim) = tem3(i,j,k)
        END DO
      END DO
    END DO

    DO i = 1,nx-1
      DO j = 1,ny-1
        DO k = 1,nz
          tem4(i,j,k)  = tem6(i,j,k)
          w(i,j,k,tim) = tem4(i,j,k)
        END DO
      END DO
    END DO

    DO i = 1,nx-1
      DO j = 1,ny-1
        DO k = 1,nz-1
          rhostr(i,j,k) = rhobar(i,j,k)*j3(i,j,k)
          qv(i,j,k,tim) = qvbar(i,j,k) + tem7(i,j,k)
        END DO
      END DO
    END DO

  END IF

  RETURN


END SUBROUTINE adasread