SUBROUTINE read_surface_obs(infile,blackfile,                           & 2,1
           maxsta,istart,atime,n_meso_g,                                &
           n_meso_pos,n_sao_g,n_sao_pos_g,n_sao_b,n_sao_pos_b,n_obs_g,  &
           n_obs_pos_g,n_obs_b,n_obs_pos_b,stn,obstype,lat,lon,elev,wx, &
           t,td,dd,ff,ddg,ffg,pstn,pmsl,alt,kloud,ceil,lowcld,cover,rad, &
           idp3,store_emv,store_amt,store_hgt,vis,obstime,istatus)
!
!*******************************************************************************
!
!    Routine to read mesonet and SAO data for LAPS that has been written
!    into the .LSO file by the 'get_surface_obs' routine.
!
!    Changes:
!            P. Stamus       12-30-92  Original version.
!                            01-07-93  Add/change obs counters.
!                            01-08-93  Add read_header entry.
!            K. Brewster     12-20-99  Moved the initialization of
!                                      cloud amts to missing to
!                                      inside of station read loop
!
!    Input/Output:
!
!     Variable        Var type   I/O   Description
!    ----------      ---------- ----- -------------
!     infile            A*80      I    Directory where LSO file is.
!     maxsta             I        I    Max Number of stations allowed.
!     atime             A*24      O    Data time in dd-mmm-yyyy hh:mm
!     n_meso_g           I        O    Number of FSL mesonet stations
!     n_meso_pos         I        O    Total number mesonet stations psbl
!     n_sao_g            I        O    Number of SAOs in the laps grid
!     n_sao_pos_g        I        O    Total num. of SAOs psbl in laps grid
!     n_sao_b            I        O    Number of SAOs in the box
!     n_sao_pos_b        I        O    Total num of SAOs psbl in the box
!     n_obs_g            I        O    Number of obs in the laps grid
!     n_obs_pos_g        I        O    Total num of obs psbl in the laps grid
!     n_obs_b            I        O    Number of obs in the box
!     n_obs_pos_b        I        O    Total num of obs possible in the box
!     stn               A*3 A     O    Station names (array)
!     lat                RA       O    Station latitude (deg)
!     lon                RA       O    Station longitude (deg)
!     elev               RA       O    Station elevation (m)
!     obstype           A*8 A     O    Observation type (SA, SP, ASOS, etc)
!     obstime            IA       O    Time of observation (hhmm)
!     wx                A*8 A     O    Observed weather
!     t                  RA       O    Temperature (F)
!     td                 RA       O    Dewpoint (F)
!     dd                 RA       O    Wind direction (deg)
!     ff                 RA       O    Wind speed (kt)
!     ddg                RA       O    Gust wind direction (deg)
!     ffg                RA       O    Gust wind speed (kt)
!     pstn               RA       O    Station pressure (mb)
!     pmsl               RA       O    MSL pressure (mb)
!     alt                RA       O    Altimeter setting (mb)
!     kloud              IA       O    Number of cloud layers...max of 5.
!     ceil               RA       O    Ceiling height (m)
!     lowcld             RA       O    Height lowest cloud (m)
!     cover              RA       O    Cloud cover (tenths)
!     vis                RA       O    Visibility (miles)
!     rad                RA       O    Solar radiation.
!     idp3               IA       O    3-h coded pressure change (e.g.,608)
!     store_emv         A*1 A     O    Cloud descriptors: ea. layer, ea. stn
!     store_amt         A*4 A     O    Cloud layer coverage.
!     store_hgt          RA       O    Height of each cloud layer.
!     istatus            I        O    Status flag: 1 = normal
!                                                  -1 = file not found
!                                                  -2 = Arrays too small
!
!    User Notes:
!
!    1.  Arrays should be dimensioned 'maxsta' in the calling program,
!        with maxsta *at least* 120 (for CO domain).
!
!    2.  Pressures are stored as reported, except that altimeters are
!        converted to millibars.
!
!    3.  The 'kloud' variable tells whether there are clouds and how
!        many layers if there are:
!            a) kloud = 0    means   No cloud DATA (but NOT "no clouds").
!            b) kloud = 1    means   CLR or 1 cloud layer.  A height is
!                                    given for CLR which is the maximum valid
!                                    height of the observation (automatic
!                                    stations have limited valid heights).
!            c) kloud = 2-5  means   Two to five cloud layers.
!
!    4.  Thin obscured (-X) is a cloud layer and is given a 'badflag'
!        height, since it is not supposed to have a height (you're supposed
!        to be able to see other clouds and/or sky).
!
!*******************************************************************************
!
  IMPLICIT NONE
  INTEGER :: maxsta
  INTEGER :: istart
  INTEGER :: misval
  PARAMETER       (misval=999)
  REAL :: badflag
  PARAMETER       (badflag = -99.9)
!
  REAL :: lat(maxsta),lon(maxsta),elev(maxsta)
  REAL :: t(maxsta),td(maxsta)
  REAL :: dd(maxsta),ff(maxsta)
  REAL :: ddg(maxsta),ffg(maxsta)
  REAL :: pstn(maxsta),pmsl(maxsta),alt(maxsta)
  REAL :: store_hgt(maxsta,5)
  REAL :: ceil(maxsta),lowcld(maxsta),cover(maxsta)
  REAL :: vis(maxsta),rad(maxsta)
!
  INTEGER :: obstime(maxsta),kloud(maxsta),idp3(maxsta)
!
  CHARACTER (LEN=132) :: infile
  CHARACTER (LEN=132) :: blackfile
  CHARACTER (LEN=24) :: atime
  CHARACTER (LEN=5) :: stn(maxsta)
  CHARACTER (LEN=8) :: obstype(maxsta)
  CHARACTER (LEN=8) :: wx(maxsta)
  CHARACTER (LEN=1) :: store_emv(maxsta,5)
  CHARACTER (LEN=4) :: store_amt(maxsta,5)
!
  INTEGER :: n_meso_g,n_meso_pos,n_sao_g,n_sao_pos_g
  INTEGER :: n_sao_b,n_sao_pos_b,n_obs_g,n_obs_pos_g
  INTEGER :: n_obs_b,n_obs_pos_b
  INTEGER :: istatus
!
  INTEGER :: i,k,ios,ii
!
!.....  Start here.  Set the status to nothing, zero out the cloud storage.
!
  istatus = 0
!
!.....  Open the file.  Check for a 'file not found' or other problem.
!
  OPEN(1,IOSTAT=ios,FILE=trim(infile),STATUS='old',                     &
       ACCESS='sequential',FORM='formatted')
  IF(ios /= 0) THEN     ! error during read
    istatus = -1
    WRITE(6,650) infile
    650       FORMAT(' +++ ERROR opening: ',a80,' +++')
    WRITE(6,651) ios
    651       FORMAT('     IOS code = ',i5)
    RETURN
  END IF
!
!.....  File open...first read the header.
!
  READ(1,900) atime,              & ! data time
           n_meso_g,          & ! # of mesonet stations
           n_meso_pos,        & ! total # mesonet stations possible
           n_sao_g,           & ! # of saos in the laps grid
           n_sao_pos_g,       & ! total # of saos possible in laps grid
           n_sao_b,           & ! # of saos in the box
           n_sao_pos_b,       & ! total # of saos possible in the box
           n_obs_g,           & ! # of obs in the laps grid
           n_obs_pos_g,       & ! total # of obs psbl in the laps grid
           n_obs_b,           & ! # of obs in the box
           n_obs_pos_b        ! total # of obs possible in the box
  900     FORMAT(1X,a24,10(1X,i4))
!wdt tmp
!  1900     FORMAT("XXX header:",1X,a24,10(1X,i4))
!  WRITE(*,1900) atime,              & ! data time
!           n_meso_g,          & ! # of mesonet stations
!           n_meso_pos,        & ! total # mesonet stations possible
!           n_sao_g,           & ! # of saos in the laps grid
!           n_sao_pos_g,       & ! total # of saos possible in laps grid
!           n_sao_b,           & ! # of saos in the box
!           n_sao_pos_b,       & ! total # of saos possible in the box
!           n_obs_g,           & ! # of obs in the laps grid
!           n_obs_pos_g,       & ! total # of obs psbl in the laps grid
!           n_obs_b,           & ! # of obs in the box
!           n_obs_pos_b        ! total # of obs possible in the box
!
!.....  Error trapping for too many stations for array size.
!
  IF(n_obs_b > maxsta) THEN
    PRINT 990, maxsta,n_obs_b,atime
    990       FORMAT(' +++ ERROR in READ_SURFACE_OBS: maxstns = ',i8,/, &
           ' but there are ',i8,' stations in the ',a24,' obs file.',/)
    PRINT *,'    Increase the value of "maxstns" and try again.'
    istatus = -2
    RETURN
  END IF
!
!.....  Now read the station data.
!
  DO i=1,n_obs_b
    k=i+istart-1
    READ(1,901) stn(k),lat(k),lon(k),elev(k),obstype(k),                &
        obstime(k),wx(k)
    901       FORMAT(1X,a5,f6.2,1X,f7.2,1X,f5.0,1X,a8,1X,i4,1X,a8)
!wdt tmp
!    WRITE(*,1901) stn(k),lat(k),lon(k),elev(k),obstype(k),                &
!        obstime(k),wx(k)
!    1901       FORMAT("XXX stn dta:",1X,a5,f6.2,1X,f7.2,1X,f5.0,1X,a8,1X,i4,1X,a8)
!
    READ(1,903) t(k),td(k),dd(k),ff(k),ddg(k),ffg(k),pstn(k),           &
                pmsl(k),alt(k)
    903       FORMAT(4X,2(f6.1,1X),4(f5.0,1X),3(f6.1,1X))
!wdt tmp
!    WRITE(*,1903) t(k),td(k),dd(k),ff(k),ddg(k),ffg(k),pstn(k),           &
!                pmsl(k),alt(k)
!    1903       FORMAT("XXX         ",4X,2(f6.1,1X),4(f5.0,1X),3(f6.1,1X))
!
    READ(1,905) kloud(k),ceil(k),lowcld(k),cover(k),vis(k),rad(k),      &
        idp3(k)
    905       FORMAT(4X,i2,2(1X,f7.1),1X,f5.1,1X,f7.3,1X,f6.1,1X,i4)
!wdt tmp
!    WRITE(*,1905) kloud(k),ceil(k),lowcld(k),cover(k),vis(k),rad(k),      &
!        idp3(k)
!    1905       FORMAT("XXX cloud   ",4X,i2,2(1X,f7.1),1X,f5.1,1X,f7.3,1X,f6.1,1X,i4)
!
!.....  Read the cloud data if we have any.
!
    DO ii=1,5
      store_emv(k,ii) = ' '
      store_amt(k,ii) = '    '
      store_hgt(k,ii) = badflag
    END DO ! ii
    IF(kloud(k) > 0) THEN
!wdt update
      DO ii=1,kloud(k)
        IF (ii <= 5) THEN
          READ(1,907) store_emv(k,ii),store_amt(k,ii),store_hgt(k,ii)
          907           FORMAT(5X,a1,1X,a4,1X,f7.1)
!wdt tmp
!        WRITE(*,1907) store_emv(k,ii),store_amt(k,ii),store_hgt(k,ii)
!        1907           FORMAT("XXX storm   ",5X,a1,1X,a4,1X,f7.1)
        ELSE
          READ (1)
          WRITE (*,*) "SKIPPING extra cloud layers for station ",stn(k)
        END IF
      END DO !ii
    END IF
!
  END DO !k
!
  REWIND(1)
  CLOSE(1)
!
  CALL blklistsfc(blackfile,maxsta,istart,n_obs_b,misval,badflag,       &
      stn,obstype,wx,                                                   &
      t,td,dd,ff,ddg,ffg,pstn,pmsl,alt,kloud,ceil,lowcld,cover,rad,     &
      idp3,store_emv,store_amt,store_hgt,vis,istatus)
!
!..... End of data gathering. Let's go home...
!
  istatus = 1             ! everything's ok...
  PRINT *, ' Normal completion of READ_SURFACE_OBS'
!
  RETURN
!
!
  ENTRY read_surface_header(infile,atime,n_meso_g,n_meso_pos,           &
      n_sao_g,n_sao_pos_g,n_sao_b,n_sao_pos_b,n_obs_g,n_obs_pos_g,      &
      n_obs_b,n_obs_pos_b,istatus)
!
!.....  Entry to read and pass back just the header info from the lso file.
!
!.....  Open the file.  Check for a 'file not found' or other problem.
!
  istatus = 0
  OPEN(1,IOSTAT=ios,FILE=trim(infile),STATUS='old',                     &
       ACCESS='sequential',FORM='formatted')
  IF(ios /= 0) THEN     ! error during read
    istatus = -1
    WRITE(6,650) infile
    WRITE(6,651) ios
    RETURN
  END IF
!
!.....  File open...first read the header.
!
  READ(1,900) atime,              & ! data time
           n_meso_g,          & ! # of mesonet stations
           n_meso_pos,        & ! total # mesonet stations possible
           n_sao_g,           & ! # of saos in the laps grid
           n_sao_pos_g,       & ! total # of saos possible in laps grid
           n_sao_b,           & ! # of saos in the box
           n_sao_pos_b,       & ! total # of saos possible in the box
           n_obs_g,           & ! # of obs in the laps grid
           n_obs_pos_g,       & ! total # of obs psbl in the laps grid
           n_obs_b,           & ! # of obs in the box
           n_obs_pos_b        ! total # of obs possible in the box
!
!.....  Rewind and close the file so we can call this again in the same program.
!
  REWIND(1)
  CLOSE(1)
  istatus = 1
!
  RETURN
END SUBROUTINE read_surface_obs
!


SUBROUTINE blklistsfc(blkfile,maxsta,istart,nobs,misval,rmisval,        & 1
           stn,obstype,wx,                                              &
           t,td,dd,ff,ddg,ffg,pstn,pmsl,alt,kloud,ceil,lowcld,cover,rad, &
           idp3,store_emv,store_amt,store_hgt,vis,istatus)
!
!  Reads list of stations and variables from a file
!  to force variables known to be chronically wrong to "missing".
!
!  Keith Brewster, CAPS
!  May, 1995
!
  IMPLICIT NONE
!
!  Arguments
!
  CHARACTER (LEN=132) :: blkfile
  INTEGER :: maxsta,istart,nobs,misval
  REAL :: rmisval
  CHARACTER (LEN=5) :: stn(maxsta)
  REAL :: t(maxsta),td(maxsta)
  REAL :: dd(maxsta),ff(maxsta),ddg(maxsta),ffg(maxsta)
  REAL :: pstn(maxsta),pmsl(maxsta),alt(maxsta)
  REAL :: store_hgt(maxsta,5)
  REAL :: ceil(maxsta),lowcld(maxsta),cover(maxsta)
  REAL :: vis(maxsta),rad(maxsta)
!
  INTEGER*4   kloud(maxsta),idp3(maxsta)
!
  CHARACTER (LEN=8) :: wx(maxsta)
  CHARACTER (LEN=8) :: obstype(maxsta)
  CHARACTER (LEN=1) :: store_emv(maxsta,5)
  CHARACTER (LEN=4) :: store_amt(maxsta,5)
  INTEGER :: istatus
!
!  Some internal parameters
!
  INTEGER :: maxblk
  PARAMETER (maxblk=10)
  CHARACTER (LEN=40) :: BLANK
  PARAMETER(BLANK='                                        ')
!
!  Misc internal variables
!
  CHARACTER (LEN=5) :: blkstn
  INTEGER :: blkvar(maxblk)
  INTEGER :: i,item,ista,ivar,nblack
!
  OPEN(12,FILE=trim(blkfile),ERR=500,STATUS='old')
  DO item=1,maxsta
    READ(12,810,ERR=520,END=550) blkstn,nblack
    810   FORMAT(a5,i5)
    DO i=1,maxblk
      blkvar(i)=-99
    END DO
    READ(12,*,ERR=240,END=240) (blkvar(i),i=1,nblack)
    240   CONTINUE
    PRINT *, ' blkstn: ',blkstn
    PRINT *, ' blkvar: ',blkvar
    DO i=1,nobs
      ista=i+istart-1
      IF(stn(ista) == blkstn) THEN
        DO ivar=1,nblack
          IF(blkvar(ivar) < 0) GOTO 400
          GO TO (301,302,303,304,305,306,307) blkvar(ivar)
          301         CONTINUE
          WRITE(6,831) blkvar(ivar),blkstn
          831           FORMAT(' Blacklisting Temp variable(s) ',i4,' at ',a5)
          t(ista)=rmisval
          CYCLE
          302         CONTINUE
          WRITE(6,832) blkvar(ivar),blkstn
          832           FORMAT(' Blacklisting Dew Pt variable(s) ',i4,' at ',a5)
          td(ista)=rmisval
          CYCLE
          303         CONTINUE
          WRITE(6,833) blkvar(ivar),blkstn
          833           FORMAT(' Blacklisting Wind variable(s) ',i4,' at ',a5)
          dd(ista)=rmisval
          ff(ista)=rmisval
          ddg(ista)=rmisval
          ffg(ista)=rmisval
          CYCLE
          304         CONTINUE
          WRITE(6,834) blkvar(ivar),blkstn
          834           FORMAT(' Blacklisting Pres variable(s) ',i4,' at ',a5)
          pstn(ista)=rmisval
          pmsl(ista)=rmisval
          alt(ista)=rmisval
          CYCLE
          305         CONTINUE
          WRITE(6,835) blkvar(ivar),blkstn
          835           FORMAT(' Blacklisting Cloud variable(s) ',i4,' at ',a5)
          kloud(ista)=0
          ceil(ista)=rmisval
          lowcld(ista)=rmisval
          cover(ista)=rmisval
          CYCLE
          306         CONTINUE
          WRITE(6,836) blkvar(ivar),blkstn
          836           FORMAT(' Blacklisting Vis variable(s) ',i4,' at ',a5)
          vis(ista)=rmisval
          CYCLE
          307         CONTINUE
          WRITE(6,837) blkvar(ivar),blkstn
          837           FORMAT(' Blacklisting Solar variable(s) ',i4,' at ',a5)
          rad(ista)=rmisval
          CYCLE
        END DO
        GOTO 400
      END IF
    END DO
    WRITE(6,830) blkstn
    830   FORMAT(' Blacklisted station ',a5,' not found in dataset')
400 CONTINUE
  END DO
  CLOSE (12)
  RETURN
  500 CONTINUE
  CLOSE (12)
  RETURN
  520 CONTINUE
  CLOSE (12)
  RETURN
  550 CONTINUE
  CLOSE (12)
  RETURN
END SUBROUTINE blklistsfc