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


SUBROUTINE rdprof(nvar,nzua,mxua,jsrc,proffile,                         & 1,2
           stnua,elevua,xua,yua,hgtua,obsua,                            &
           qualua,isrcua,nlevsua,                                       &
           rmiss,nprev,ntotal,istatus)
!
!-----------------------------------------------------------------------
!
!  PURPOSE:
!
!  Read ASCII file containing wind profiler data.
!
!-----------------------------------------------------------------------
!
!  AUTHOR: Keith Brewster
!  July, 1995
!
!  MODIFICATION HISTORY:
!  9/3/96  Keith Brewster
!  Added full documentation.
!
!  2/16/98 Keith Brewster
!  Added jsrc, source number to the variable list
!
!-----------------------------------------------------------------------
!
!  INPUT :
!
!    nvar       Number of variables in analysis (array dimension)
!    nzua       Maximum number of vertical levels (array dimension)
!    mxua       Maximum number of UA stations (array dimension)
!    jsrc       Source number of data set
!    proffile   Name of profiler data file to read
!    rmiss      Missing data fill value
!    nprev      Number of stations read previously into UA observation
!               data arrays (array index)
!
!  OUTPUT :
!
!    stnua      station name (character*4)
!    elevua     station elevation (m MSL)
!    xua        station location x-coordinate (m)
!    yua        station location y-coordinate (m)
!    hgtua      height of data (m MSL)
!    obsua      observation data
!    qualua     observation quality indicator
!    isrcua     data source index
!    nlevsua    number of levels of data
!    ntotal     number of stations
!    istatus    status indicator
!
!-----------------------------------------------------------------------
!
  IMPLICIT NONE
  INTEGER :: nvar,nzua,mxua
!
  INTEGER :: jsrc
  CHARACTER (LEN=132) :: proffile
  CHARACTER (LEN=5) :: stnua(mxua)
  REAL :: elevua(mxua)
  REAL :: xua(mxua)
  REAL :: yua(mxua)
  REAL :: hgtua(nzua,mxua)
  REAL :: obsua(nvar,nzua,mxua)
  INTEGER :: qualua(nvar,nzua,mxua)
  INTEGER :: isrcua(mxua)
  INTEGER :: nlevsua(mxua)
  REAL :: rmiss
  INTEGER :: nprev,ntotal
  INTEGER :: istatus
!
!-----------------------------------------------------------------------
!
!  Misc. local variables
!
!-----------------------------------------------------------------------
!
  INTEGER :: ista,ivar,jlev,jend,ksta,mxprof,nprof
  INTEGER :: numsta
  REAL :: hgtdum,rlat,rlon,DIRECT,speed,ddrot
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
!  Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
  OPEN(12,FILE=trim(proffile),ERR=400,STATUS='old')
!
  mxprof=mxua-nprev
!
!-----------------------------------------------------------------------
!
!  Fill arrays with "missing data" indicator
!
!-----------------------------------------------------------------------
!
  DO ista=1,mxprof
    DO jlev=1,nzua
      DO ivar=1,nvar
        ksta=ista+nprev
        obsua(ivar,jlev,ksta)=rmiss
        qualua(ivar,jlev,ksta)=-99
      END DO
    END DO
  END DO
!
!-----------------------------------------------------------------------
!
!  Main data-reading loop
!
!-----------------------------------------------------------------------
!
  DO ista=1,mxprof
    ksta=ista+nprev
    READ(12,'(i12,i12,f11.0,f15.0,f15.0,5x,a5)',ERR=250,END=250)        &
        numsta,nlevsua(ksta),rlat,rlon,elevua(ksta),stnua(ksta)

    PRINT *, 'Reading Wind Profiler <', stnua(ksta), '>'
!
    isrcua(ksta)=jsrc
    CALL lltoxy(1,1,rlat,rlon,xua(ksta),yua(ksta))
!
    jend=MIN(nlevsua(ksta),nzua)
    DO jlev=1,jend
      READ(12,*,ERR=250,END=250) hgtua(jlev,ksta),DIRECT,speed

      IF(DIRECT >= 0. .AND. speed >= 0.) THEN
        CALL ddrotuv(1,rlon,DIRECT,speed,ddrot,                         &
                      obsua(1,jlev,ksta),obsua(2,jlev,ksta))
!        print *, ' direct,speed,u,v=',direct,speed,
!    +                 obsua(1,jlev,ksta),obsua(2,jlev,ksta)
        qualua(1,jlev,ksta)=100
        qualua(2,jlev,ksta)=100
      END IF
!
    END DO
!
!-----------------------------------------------------------------------
!
!  Read any extra levels after nzua, but discard them.
!
!-----------------------------------------------------------------------
!
    IF(nlevsua(ksta) > nzua) THEN
      WRITE(6,'(//a,a/,a,i4,a)') ' RDPROF: WARNING profiler: ',         &
           stnua(ksta),' truncated to nzua=',nzua,' levels.'
      WRITE(6,'(a,i4,a)') ' Data file has ',nlevsua(ksta),              &
           ' levels.'
      WRITE(6,'(a/)') ' Increase nz_ua in adas.inc'
      DO jlev=jend+1,nlevsua(ksta)
        READ(12,*,ERR=250,END=250) hgtdum,DIRECT,speed
      END DO
      nlevsua(ksta)=nzua
    END IF

  END DO
!
!-----------------------------------------------------------------------
!
!  End-of-file destination
!
!-----------------------------------------------------------------------
!
  250 CONTINUE
  nprof=ista-1
  ntotal=nprev+nprof
  WRITE(6,'(a,i4,a)') ' Read ',nprof,' profiler sites'
  CLOSE(12)
  istatus=1
  RETURN
!
!-----------------------------------------------------------------------
!
!  Error opening file destination
!
!-----------------------------------------------------------------------
!
  400 CONTINUE
  WRITE(6,'(a)') ' Error opening profiler file: ',proffile
  ntotal=nprev
  istatus=-1
  RETURN
END SUBROUTINE rdprof
!
!##################################################################
!##################################################################
!######                                                      ######
!######                  SUBROUTINE RDRAOB                   ######
!######                                                      ######
!######                     Developed by                     ######
!######     Center for Analysis and Prediction of Storms     ######
!######                University of Oklahoma                ######
!######                                                      ######
!##################################################################
!##################################################################
!


SUBROUTINE rdraob(nvar,nzua,mxua,jsrc,raobfile,                         & 1,3
           stnua,elevua,xua,yua,hgtua,obsua,                            &
           qualua,isrcua,nlevsua,                                       &
           rmiss,nprev,ntotal,istatus)
!
!-----------------------------------------------------------------------
!
!  PURPOSE:
!
!  Read ASCII file containing rawinsonde observations (RAOBs).
!
!-----------------------------------------------------------------------
!
!  AUTHOR: Keith Brewster
!  Jan, 1994
!
!  MODIFICATION HISTORY:
!  9/3/96  Keith Brewster
!  Restored proper calculation of moisture variable.
!  Added full documentation.
!
!  2/16/98 Keith Brewster
!  Added jsrc, source number to the variable list
!
!-----------------------------------------------------------------------
!
!  INPUT :
!
!    nvar       Number of variables in analysis (array dimension)
!    nzua       Maximum number of vertical levels (array dimension)
!    mxua       Maximum number of UA stations (array dimension)
!    jsrc       Source number of RAOB data set
!    raobfile   Name of profiler data file to read
!    rmiss      Missing data fill value
!    nprev      Number of stations read previously into UA observation
!               data arrays (array index)
!
!  OUTPUT :
!
!    stnua      station name (character*4)
!    elevua     station elevation (m MSL)
!    xua        station location x-coordinate (m)
!    yua        station location y-coordinate (m)
!    hgtua      height of data (m MSL)
!    obsua      observation data
!    qualua     observation quality indicator
!    isrcua     data source index
!    nlevsua    number of levels of data
!    ntotal     number of stations
!    istatus    status indicator
!
!-----------------------------------------------------------------------
!
  IMPLICIT NONE
  INTEGER :: nvar,nzua,mxua
!
  INTEGER :: jsrc
  CHARACTER (LEN=132) :: raobfile
  CHARACTER (LEN=5) :: stnua(mxua)
  REAL :: elevua(mxua)
  REAL :: xua(mxua)
  REAL :: yua(mxua)
  REAL :: hgtua(nzua,mxua)
  REAL :: obsua(nvar,nzua,mxua)
  INTEGER :: qualua(nvar,nzua,mxua)
  INTEGER :: isrcua(mxua)
  INTEGER :: nlevsua(mxua)
  REAL :: rmiss
  INTEGER :: nprev,ntotal
  INTEGER :: istatus
!
  REAL :: mbtopa
  PARAMETER (mbtopa=100.)
!
  INCLUDE 'phycst.inc'
!
!-----------------------------------------------------------------------
!
!  Misc. local variables
!
!-----------------------------------------------------------------------
!
  INTEGER :: ista,ivar,jlev,jend,ksta,nraob,mxraob
  INTEGER :: numsta
  INTEGER :: nlevlast
  REAL :: rlat,rlon,hgtdum,press,temp,tdew,DIRECT,speed,ddrot,tdk
  REAL :: u1last,v1last,pr1last,pt1last,rh1last
!
!-----------------------------------------------------------------------
!
!  Function f_qvsat and inline directive for Cray PVP
!
!-----------------------------------------------------------------------
!
  REAL :: f_qvsat

!fpp$ expand (f_qvsat)
!dir$ inline always f_qvsat
!*$*  inline routine (f_qvsat)

!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
!  Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
  OPEN(12,FILE=trim(raobfile),ERR=400,STATUS='old')
!
  mxraob=mxua-nprev

  nlevlast=0
  u1last=-9999.
  v1last=-9999.
  pr1last=-9999.
  pt1last=-9999.
  rh1last=-9999.
!
!-----------------------------------------------------------------------
!
!  Fill arrays with "missing data" indicator
!
!-----------------------------------------------------------------------
!
  DO ista=1,mxraob
    DO jlev=1,nzua
      DO ivar=1,nvar
        ksta=ista+nprev
        obsua(ivar,jlev,ksta)=rmiss
        qualua(ivar,jlev,ksta)=-99
      END DO
    END DO
  END DO
!
!-----------------------------------------------------------------------
!
!  Main data-reading loop
!
!-----------------------------------------------------------------------
!
  ksta=nprev+1
  ntotal=nprev
  DO ista=1, mxraob
    READ(12,'(i12,i12,f11.4,f15.4,f15.0,5x,a5)',ERR=250,END=250)        &
        numsta,nlevsua(ksta),rlat,rlon,elevua(ksta),stnua(ksta)
!
    isrcua(ksta)=jsrc
    CALL lltoxy(1,1,rlat,rlon,xua(ksta),yua(ksta))
!
    jend=MIN(nlevsua(ksta),nzua)
    DO jlev=1,jend
      READ(12,*,ERR=250,END=250)                                        &
          hgtua(jlev,ksta),press,temp,tdew,DIRECT,speed
!
!-----------------------------------------------------------------------
!
!  observed u,v
!
!-----------------------------------------------------------------------
!
      IF(DIRECT >= 0. .AND. speed >= 0.) THEN
        CALL ddrotuv(1,rlon,DIRECT,speed,ddrot,                         &
                      obsua(1,jlev,ksta),obsua(2,jlev,ksta))
        qualua(1,jlev,ksta)=100
        qualua(2,jlev,ksta)=100
      END IF
!
!-----------------------------------------------------------------------
!
!  observed press and potential temperature
!
!-----------------------------------------------------------------------
!
      IF(press >= 0.) THEN
        obsua(3,jlev,ksta)=press*mbtopa
        qualua(3,jlev,ksta)=100
        IF(temp > -99.) THEN
          obsua(4,jlev,ksta)=                                           &
              (temp+273.15)*((p0/obsua(3,jlev,ksta))**rddcp)
          qualua(4,jlev,ksta)=100
        END IF
!
!-----------------------------------------------------------------------
!
!  observed specific humidity
!
!-----------------------------------------------------------------------
!
        IF(temp > -99. .AND. tdew > -99.) THEN
          tdk=tdew + 273.15
          obsua(5,jlev,ksta)=                                           &
               MAX(1.0E-08,f_qvsat(obsua(3,jlev,ksta),tdk))
          qualua(5,jlev,ksta)=100
        END IF
      END IF
    END DO
!
!-----------------------------------------------------------------------
!
!  Read any extra levels after nzua, but discard them.
!
!-----------------------------------------------------------------------
!
    IF(nlevsua(ksta) > nzua) THEN
      WRITE(6,'(//a,a/,a,i4,a)') ' RDRAOB: WARNING rawinsonde: ',       &
           stnua(ksta),' truncated to nzua=',nzua,' levels.'
      WRITE(6,'(a,i4,a)') ' Data file has ',nlevsua(ksta),              &
           ' levels.'
      WRITE(6,'(a/)') ' Increase nz_ua in adas.inc'
!
      DO jlev=jend+1,nlevsua(ksta)
        READ(12,*,ERR=250,END=250)                                      &
            hgtdum,press,temp,tdew,DIRECT,speed
      END DO
      nlevsua(ksta)=nzua
    END IF
!
!-----------------------------------------------------------------------
!
!  Check for duplicate sounding to to error some .snd files
!  If dupe is found, do not increment ksta or ntotal counter.
!
!-----------------------------------------------------------------------
!
    IF(nlevsua(ksta) == nlevlast .AND. obsua(1,1,ksta) == u1last .AND.  &
          obsua(2,1,ksta) == v1last .AND.                               &
          obsua(3,1,ksta) == pr1last .AND.                              &
          obsua(4,1,ksta) == pt1last .AND.                              &
          obsua(5,1,ksta) == rh1last ) THEN

      WRITE(6,'(a,a)')                                                  &
          ' Discarding erroneous duplicate data stored for',            &
          stnua(ksta)
    ELSE

!wdt update
      WRITE(6,'(a,i5,2A)') ' Read', nlevsua(ksta),                     &
          ' levels of data from radiosonde station ', TRIM(stnua(ksta))
      nlevlast=nlevsua(ksta)
      u1last=obsua(1,1,ksta)
      v1last=obsua(2,1,ksta)
      pr1last=obsua(3,1,ksta)
      pt1last=obsua(4,1,ksta)
      rh1last=obsua(5,1,ksta)

      ksta=ksta+1
      ntotal=ntotal+1

    END IF

  END DO
!
!-----------------------------------------------------------------------
!
!  End-of-file destination
!
!-----------------------------------------------------------------------
!
  250 CONTINUE
  nraob=ntotal-nprev
  CLOSE(12)
  RETURN
!
!-----------------------------------------------------------------------
!
!  Error opening file destination
!
!-----------------------------------------------------------------------
!
  400 CONTINUE
  WRITE(6,'(a)') ' Error opening raob file: ',raobfile
  ntotal=nprev
  RETURN
END SUBROUTINE rdraob