PROGRAM TSTRED
C************************************************************************
C*   Program to test read a BUFR sounding data file.			*
C*									*
C* Log:									*
C* K. Brill/NMC		 1/95						*
C************************************************************************
	CHARACTER*128	snefil
	INTEGER		iday (3)
	REAL		snbufr (50000), sfbufr (2000)
	LOGICAL		done, more
C------------------------------------------------------------------------
	istbyt = 1
C
C*	Open the BUFR file.
C
	WRITE (6,*) ' Enter the BUFR file name:'
	READ (5,11) snefil
11	FORMAT (A)
	CALL ST_LSTR ( snefil, lngth, ier )
        CALL DA_OPEN ( snefil, lngth, lunin, ier )
	done = .false.
	DO WHILE ( .not. done )
C
C*	    Read the next sounding.
C
            CALL SNMRBF ( lunin, istbyt, ihr, iday, ifct, istnm,
     +                    slat, slon, selv, npsn, npsf, nz, snbufr,
     +                    sfbufr, iclass, iret )
	    IF ( iret .ne. 0 ) THEN
		WRITE (6,*) ' SNMRBF error - iret = ', iret
		IF ( iret .gt. 0 ) STOP
	    END IF
	    WRITE (6,101) istnm, iday(3), iday(1), iday(2), ihr, ifct
101	    FORMAT ( ' STN = ', I5, '   CYCLE = ',4I2.2,
     +		     '   FCST = ', I10 )
	    WRITE (6,103) slat, slon, selv, iclass
103	    FORMAT ( ' STN LAT/LON = ', F6.2, ' / ', F7.2,
     +		     ' STN ELEV = ',
     +		     F5.0, ' CLASS = ', I2 )
	    WRITE (6,105) npsf, npsn, nz
105	    FORMAT ( ' # SFC PARMS = ', I4, ' # SND PARMS = ', I4,
     +		     ' # SND LEVLS = ', I4 )
	    WRITE (6,*) '  SURFACE PARAMETER VALUES ARE: '
	    WRITE (6,107) (sfbufr(ij),ij=1,npsf)
107	    FORMAT ( 5 ( X, E11.4, 2X ) )
	    more = .true.
	    DO WHILE ( more )
		WRITE (6,*) ' Enter number of level to print data.  '
		WRITE (6,*) ' Enter 0 for next STN, -1 to STOP:'
		READ (5,109) k
109		FORMAT (I4)
		IF ( k .gt. nz ) k = nz
		IF ( k .le. 0 ) THEN
		    more = .false.
		ELSE
		    k1 = ( k - 1 ) * npsn + 1
		    k2 = k * npsn
		    WRITE ( 6, 111 ) k
111		    FORMAT ( ' LEVEL ', I4, ' DATA VALUES ARE:' )
		    WRITE ( 6, 107 ) ( snbufr (kkk), kkk = k1, k2 )
		END IF
	     END DO
	     IF ( k .lt. 0 ) done = .true.
	END DO
	CALL DA_CLOS ( lunin, ier )
	STOP
	END