c------------------------------------------------------------------c
c                                                                  c
c  Program Name: RDSLP2                                            c
c  Date:         December 10, 1993                                 c
c  Programmer:   Mike Seablom                                      c
c                                                                  c
c  Program RDSLP reads in sea level pressure and wind data from    c
c  a non-repack dataset (flexible format) and performs initial     c
c  quality control duties.                                         c
c                                                                  c
c------------------------------------------------------------------c
c  Data parallel implementation (CMFortran) : M. Makivic           c
c  Date: 4/94                                                      c
c------------------------------------------------------------------c
      SUBROUTINE rdslp(data,nobs,suspect)
c      include '/usr/include/cm/CMF_defs.h'
      include 'params.h'
      
      REAL data (MaxObservPoints*NRECORDS), quality_slp, quality_wind,
     &time_displacement, date, time
      LOGICAL suspect (MaxObservPoints, 2), strat, sslp, fdcos, fexp, sa
     &veae, sigdat, qobs, offlev, onestage
      LOGICAL end_of_file
      INTEGER error_code
      CHARACTER * 8 dataname, obsname
      CHARACTER * 60 message
!hpf$ distribute data(block)
!hpf$ distribute suspect(block,block)
      DATA fill / 1.e15 /
      COMMON / contrl / im, jnp, nb, ndalt, nhms, nlay, nlaym1, nlayp1, 
     &nymd, strat, idimen, sslp, fdcos, fexp, saveae, sigdat, maxrep
      COMMON / dataptrs / ikx, ilat, ilon, ipr, itype, islp, ifcer
C  Initialize data quality flags ( array 'suspect' is true if an ob-
C  servation fails first-pass quality control ).
      INTEGER Ti1
      message(1:60) = ' '
      suspect(:,1) = .FALSE.
      suspect(:,2) = .FALSE.
C  Initialize the starting addresses for array "DATA".
      ikx = 1
      ilat = 1 * maxobservpoints + 1
      ilon = 2 * maxobservpoints + 1
      ipr = 3 * maxobservpoints + 1
      itype = 4 * maxobservpoints + 1
      islp = 5 * maxobservpoints + 1
      iuwnd = 6 * maxobservpoints + 1
      ivwnd = 7 * maxobservpoints + 1
C  Check for date and time match and dataset positioning.
      REWIND( 77 ) 
      READ( 77,* ) date,time
      IF (date .NE. nymd .OR. time .NE. nhms) THEN
        WRITE( 6,'(/," Analysis time: ",2i9,/," Time on dataset: ",     
     &    2i9)' ) nymd,nhms,date,time
        message = ' RDSLP2: Dataset positioned at wrong ' 
     &      // 'date/time.'
        CALL flash(5,'ABORT in RDSLP2. Dataset positioned to wrong date/
     &time.     ',1)
      ENDIF
      nobs = 0
      end_of_file = .FALSE.
      write(6,*) 'ready to start reading ',maxobservpoints
      i = 1
 7000 IF ((.NOT.end_of_file)) THEN
c      write(6,*) i,ikx,ilat,ilon,islp,iuwnd,ivwnd
        READ( 77,*,IOSTAT=error_code ) time_displacement,
     &      data(ikx + i - 1),data(ilat + i - 1),data(ilon + i - 1),
     &      data(islp + i - 1),data(iuwnd + i - 1),data(ivwnd + i - 1),
     &      quality_slp,quality_wind
c        READ( 77,*,IOSTAT=error_code ) btime_displacement,
c     &      blah1,blah2,blah3,
c     &      blah4,blah5,blah6,
c     &      bquality_slp,bquality_wind

        IF (error_code .NE. 0) THEN
          end_of_file = .TRUE.
        ELSE
c  Store only reports passing the proximity check.
          IF (data(ikx + i - 1) .LT. 1.E7 .AND. quality_slp .LT. 1.99 
     &          .AND. quality_wind .LT. 1.99) THEN
            i = i + 1
            nobs = nobs + 1
            IF (quality_wind .GT. .5) THEN
              suspect(i - 1,2) = .TRUE.
            ENDIF
            IF (quality_slp .GT. .5) THEN
              suspect(i - 1,1) = .TRUE.
            ENDIF
c  Assign fill values to very bad data.
            IF (quality_wind .GT. 1.5) THEN
              data(iuwnd + i - 2) = fill
              data(ivwnd + i - 2) = fill
            ENDIF
            IF (quality_slp .GT. 1.5) THEN
              data(islp + i - 2) = fill
            ENDIF
          ENDIF
        ENDIF
        GOTO 7000
      ENDIF
 7001 CONTINUE
      WRITE( 6,'(/," Total number of surface observations read:",       
     & i9)' ) nobs
C  Compress the data array in the surface  analysis.
      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(ipr + 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(islp + i - 1)
      ENDDO
      DO i = 1 , nobs
        data(i + 6 * nobs) = data(iuwnd + i - 1)
      ENDDO
      DO i = 1 , nobs
        data(i + 7 * nobs) = data(ivwnd + i - 1)
      ENDDO
      ikx = 1
      ilat = ikx + nobs
      ilon = ilat + nobs
      ipr = ilon + nobs
      itype = ipr + nobs
      islp = itype + nobs
      RETURN
      END
