CMAX: [Version 1.0 (6/22/93)]
CMAX: ----------------------------------------------------
CMAX: Transformation of RDHUV from rdhuv2.f
CMAX: ----------------------------------------------------
      SUBROUTINE rdhuv(zmod,tmod,z1000,data,nobs,suspect,ze,zelat,zelon,
     &    nze)
      
      INTEGER MaxObservPoints
      PARAMETER (MaxObservPoints = 150000)
c***********************************************************************
c
c  Program Name: RDHUV
c  Programmer:   M. Nestler ( modifications by M. Seablom )
c  Date:         September 14, 1988  (most recent modification 8/1992)
c  Computer:     Cray YMP
c
c  Adapted to RS6000 : Gregor von Laszewski
c
c
c  Program RDHUV reads upper air observational data.
c
c  *** SPECIAL TEST VERSION ***
C-----------------------------------------------------------------------
C    Version reads from non-repack (flexible) format datasets.
C-----------------------------------------------------------------------
c
c Upper air data is stored in the DATA array, initial data quality
c information is contained in array SUSPECT.
c Include model fields to compute satellite heights.
c
c
c     Maximal observation points
c
c
c
      REAL data (MaxObservPoints * 10), zmod (im,jnp,mlev)
      real tmod (im,jnp,mlev)
      REAL z1000 (im,jnp)
      REAL ze (20000), zelat (20000), zelon (20000), ibmbuf, zwtim
      REAL zwkx, zwlat, zwlon, pzw, z, wu, wv, pzr, tw, qz, qw
      REAL zwdum
      REAL sat_wind (MaxObservPoints), ref_pressure (MaxObservPoints)
      LOGICAL suspect (MaxObservPoints, 2), next
      INTEGER end_address, datasets
      INTEGER error_code
      LOGICAL end_of_file
      COMMON / LEVEL / ibmbuf (85, 12), zwtim (85), zwkx (85), zwlat (85
     &), zwlon (85), pzw (85), z (85), wu (85), wv (85), pzr (85), tw (8
     &5), qz (85), qw (85), zwdum (4), PAD4 (157956), BPAD (20000)
C
C OBSERVATIONS INFORMATION
C ----------------------------------------------------------------------
      REAL HH, VCOROE, OBSERR, WW
      CHARACTER * 8 DATANAME, OBSNAME
      LOGICAL QOBS, OFFLEV
      COMMON / OBS / MAXDEX, NFGGE, LUN, HH (13, 13, 20), 
     &VCOROE (18, 18, 4), OBSERR (200, 4, 19), WW (13, 13, 20), 
     & QOBS (200, 5), OFFLEV (200)
      common / obschar / dataname (5), obsname(200)
      COMMON / scan / maxobs, rscan, onestage, MaxData
      INTEGER MaxData
C Set vertical levels.
      COMMON / mlay / mlev, mlevm1, mmix, mmixm1, ls, lsm1
      COMMON / pmh / pmand (18)
C
C ANALYSIS CONTROL PARAMETERS
C ----------------------------------------------------------------------
      LOGICAL STRAT, SLP, FDCOS, FEXP, SAVEAE, SIGDAT
      COMMON / CONTRL / IM, JNP, NB, NDALT, NHMS, NLAY, NLAYM1, NLAYP1, 
     &NYMD, STRAT, IDIMEN, SLP, FDCOS, FEXP, SAVEAE, SIGDAT, MAXREP
C
C OBSERVATIONAL DATA INFO.
C ----------------------------------------------------------------------
      COMMON / RECORD / INDAT, INTIM, INCTIM, NFOR (5), NBUF (5)
C
C DATA POINTERS
C ----------------------------------------------------------------------
      COMMON / DATAPTRS / IKX, ILAT, ILON, IPZW, ITYPE, IZ, IFCER
C
C CLOUD TRACK WIND REASSIGNMENT FLAG.
C ----------------------------------------------------------------------
      COMMON / SATWIND / CWIND
      LOGICAL CWIND
C
C LOCAL VARIABLES.
C ----------------------------------------------------------------------
      CHARACTER * 60 message
      REAL FORM, BUFF, XFORM, XBUFF, FILL
!hpf$ distribute bpad(block)
!hpf$ distribute data(block)
!hpf$ distribute hh(block,block,block)
!hpf$ distribute ibmbuf(block,block)
!hpf$ distribute nbuf(block)
!hpf$ distribute nfor(block)
!hpf$ distribute obserr(block,block,block)
!hpf$ distribute offlev(block)
!hpf$ distribute pad4(block)
!hpf$ distribute pmand(block)
!hpf$ distribute pzr(block)
!hpf$ distribute pzw(block)
!hpf$ distribute qobs(block,block)
!hpf$ distribute qw(block)
!hpf$ distribute qz(block)
!hpf$ distribute ref_pressure(block)
!hpf$ distribute retv(block,block)
!hpf$ distribute rkx(block)
!hpf$ distribute rlat(block)
!hpf$ distribute rlon(block)
!hpf$ distribute rpref(block)
!hpf$ distribute sat_wind(block)
!hpf$ distribute suspect(block,block)
!hpf$ distribute tmod(block,block,block)
!hpf$ distribute tw(block)
!hpf$ distribute vcoroe(block,block,block)
!hpf$ distribute wu(block)
!hpf$ distribute wv(block)
!hpf$ distribute ww(block,block,block)
!hpf$ distribute z(block)
!hpf$ distribute z1000(block,block)
!hpf$ distribute ze(block)
!hpf$ distribute zelat(block)
!hpf$ distribute zelon(block)
!hpf$ distribute zmod(block,block,block)
!hpf$ distribute zwdum(block)
!hpf$ distribute zwkx(block)
!hpf$ distribute zwlat(block)
!hpf$ distribute zwlon(block)
!hpf$ distribute zwtim(block)
      DATA FILL / 1.e15 /
      REAL rkx (12000), rlat (12000), rlon (12000), retv (12000, 15), rp
     &ref (12000)
      INTEGER Ti1, Ti2
      message(1:60) = ' '
      suspect = .FALSE.
      REWIND( 79 ) 
      READ( 79,* ) date,time
C Define highest pressure level for upper air analysis.
      top_level = pmand(1)
C Starting address of data array.
      ikx = 1
      ilat = maxobservpoints + 1
      ilon = 2 * maxobservpoints + 1
      ipzw = 3 * maxobservpoints + 1
      itype = 4 * maxobservpoints + 1
      iz = 5 * maxobservpoints + 1
      iwu = 6 * maxobservpoints + 1
      iwv = 7 * maxobservpoints + 1
      itime = 9 * maxobservpoints + 1
C Double check on data positioned to right date and time.
      IF (date .NE. nymd .OR. time .NE. nhms) THEN
        WRITE( 6,1000 ) nymd,nhms,date,time
        message = ' RDHUV: Dataset is positioned to wrong date/time.'
        CALL flash(5,message,1)
      ENDIF
1000  FORMAT (' FATAL: RDHUV>> Observation dataset positioned to  ','the
     & wrong date/time. ',/' ',5X,'Expected to perform analysis at :',2I
     &8,/' ',5X,'Data positioned at date / time=',2I8)
      nobs = 0
      i = 1
      end_of_file = .FALSE.
 7000 IF ((.NOT.end_of_file)) THEN
        READ( 79,*,IOSTAT=error_code ) time_displacement,
     &      data(ikx + i - 1),data(ilat + i - 1),data(ilon + i - 1),
     &      data(ipzw + i - 1),data(iz + i - 1),data(iwu + i - 1),
     &      data(iwv + i - 1),ref_pressure(i),sat_wind(i),quality_z,
     &      quality_wind
        IF (error_code .NE. 0) THEN
          end_of_file = .TRUE.
        ELSEIF (data(ikx + i - 1) .LT. 201.) THEN
          kk = nint(data(ikx + i - 1))
          IF (data(ipzw + i - 1) .GE. .99 * top_level .AND. (quality_z 
     &          .LT. 1.99 .OR. quality_wind .LT. 1.99) .AND. (qobs(kk,1)
     &          )) THEN
            IF (quality_z .GT. .5) THEN
              suspect(i,1) = .TRUE.
            ELSE
              suspect(i,1) = .FALSE.
            ENDIF
            IF (quality_wind .GT. .5) THEN
              suspect(i,2) = .TRUE.
            ELSE
              suspect(i,2) = .FALSE.
            ENDIF
            IF (quality_z .GT. 1.5) THEN
              data(iz + i - 1) = fill
            ENDIF
            IF (quality_wind .GT. 1.5) THEN
              data(iwu + i - 1) = fill
            ENDIF
            IF (quality_wind .GT. 1.5) THEN
              data(iwv + i - 1) = fill
            ENDIF
            nobs = nobs + 1
            i = i + 1
          ENDIF
        ENDIF
        GOTO 7000
      ENDIF
 7001 CONTINUE
c  Include 1000mb heights generated from sea level pressure reports
c  over oceanic regions.
      DO 7002 i = 1 , nze
        nobs = nobs + 1
        IF (nobs .GT. maxobservpoints) THEN
          WRITE( 6,'(///)' ) 
          message = ' RDHUV: Excessive number of GEN1000 heights. '
          CALL flash(5,message,1)
        ENDIF
        data(ikx + nobs - 1) = 87.
        data(ilat + nobs - 1) = zelat(i)
        data(ilon + nobs - 1) = zelon(i)
        data(ipzw + nobs - 1) = 1000.
        data(iz + nobs - 1) = ze(i)
        data(iwu + nobs - 1) = fill
        data(iwv + nobs - 1) = fill
        ref_pressure(nobs) = fill
        sat_wind(nobs) = fill
   30   CONTINUE
 7002 CONTINUE
      WRITE( 6,'(" RDHUV:",i6, " 1000mb heights obtained from ",        
     &    "sea-level pressure reports.")' ) nze
      IF (nobs .EQ. 0) THEN
        RETURN
      ENDIF
C Add in the reference heights.
      CALL refhgt(data,nobs,ikx,ilat,ilon,ipzw,itype,iz,iwu,iwv,itime,
     &    ref_pressure,maxobservpoints)
C Compress the DATA array.
      DO i = 1 , nobs
        data(i + nobs) = data(ilat + i - 1)
      ENDDO
      DO i = 1 , nobs
        data(i + 2 * nobs) = data(ilon + i - 1)
      ENDDO
      DO i = 1 , nobs
        data(i + 3 * nobs) = data(ipzw + i - 1)
      ENDDO
      DO i = 1 , nobs
        data(i + 4 * nobs) = data(itype + i - 1)
      ENDDO
      DO i = 1 , nobs
        data(i + 5 * nobs) = data(iz + i - 1)
      ENDDO
      DO i = 1 , nobs
        data(i + 6 * nobs) = data(iwu + i - 1)
      ENDDO
      DO i = 1 , nobs
        data(i + 7 * nobs) = data(iwv + i - 1)
      ENDDO
      DO i = 1 , nobs
        data(i + 9 * nobs) = data(itime + i - 1)
      ENDDO
C
C CHANGE DATA POINTERS.
C---------------------------------------------------------------------
      ilat = nobs + 1
      ilon = 2 * nobs + 1
      ipzw = 3 * nobs + 1
      itype = 4 * nobs + 1
      iz = 5 * nobs + 1
      iwu = 6 * nobs + 1
      iwv = 7 * nobs + 1
      itime = 9 * nobs + 1
C Alter the satellite observations.
      next = .TRUE.
      DO 7022 datasets = 1 , nfgge
        i = 31
 7020   IF (((next) .AND. i .LE. 86)) THEN
          IF (qobs(i,datasets)) THEN
            CALL sathgt_v1(data,ikx,maxobservpoints * 10,data,ilat,
     &          maxobservpoints * 10,data,ilon,maxobservpoints * 10,data
     &          ,iz,maxobservpoints * 10,ref_pressure,nobs,zmod,z1000)
            next = .FALSE.
          ELSE
            i = i + 1
          ENDIF
          GOTO 7020
        ENDIF
 7021   CONTINUE
 7022 CONTINUE
      IF (cwind) THEN
        CALL satwnd_v1(data,ikx,maxobservpoints * 10,data,ilat,
     &      maxobservpoints * 10,data,ilon,maxobservpoints * 10,data,
     &      ipzw,maxobservpoints * 10,data,iwu,maxobservpoints * 10,data
     &      ,iwv,maxobservpoints * 10,sat_wind,nobs,tmod,zmod)
      ENDIF
      RETURN
C  ERROR EXIT
C  ----------
      CONTINUE
      WRITE( 6,1010 ) lin,nymd,nhms
1010  FORMAT (' ****** ERROR IN RDZUV: END OF FILE ON UNIT ',I5,/' THE O
     &BSERVATION DATA FOR DATE/TIME=',2I10,' IS ','MISSING OR INCOMPLETE
     & ')
      STOP 'RDZUV 2'
      END
