SUBROUTINE SNMRBF ( lunin, istbyt, ihr, iday, ifct, istnm,
     +                      slat, slon, selv, npsn, npsf, nz, snbufr,
     +                      sfbufr, iclass, iret )
C************************************************************************
C* SNMRBF								*
C*									*
C* This subroutine returns the next sounding subset of model profile	*
C* data stored in a BUFR file.						*
C*									*
C* The output sounding data is ordered parameter-wise, that is, the	*
C* first element is parameter 1 on level 1, the next element is 	*
C* parameter 2 on level 1, . . ., the last element is parameter NPSN	*
C* on level NZ.								*
C*									*
C* SNMRBF  ( LUNIN, ISTBYT, IHR, IDAY, IFCT, ISTNM, SLAT, SLON, SELV, 	*
C*	     NPSN, NPSF, NZ, SNBUFR, SFBUFR, ICLASS, IRET )		*
C*									*
C* Input parameters:							*
C*	LUNIN		INTEGER		Unit number of the BUFR file	*
C*									*
C* Input and output parameter:						*
C*	ISTBYT		INTEGER		Starting byte number		*
C*					  ISTBYT = 1 on first call	*
C*									*
C* Output parameters:							*
C*	IHR		INTEGER		Cycle hour			*
C*      IDAY (3)        INTEGER         Starting month, day, year       *
C*	IFCT		INTEGER		Forecast time (seconds)		*
C*	ISTNM		INTEGER		Station ID number		*
C*	SLAT		REAL		Station latitude (deg)		*
C*	SLON		REAL		Station longitude (deg, + east) *
C*	SELV		REAL		Station elevation (m)		*
C*	NPSN		INTEGER		Number of sounding parameters	*
C*	NPSF		INTEGER		Number of surface parameters	*
C*	NZ		INTEGER		Number of sounding levels	*
C*	SNBUFR(NPSN*NZ)	REAL		Output profile data values	*
C*	SFBUFR (NPSF)	REAL		Output surface data values	*
C*	ICLASS		INTEGER		Class of profile output		*
C*	IRET		INTEGER		Return code			*
C*					 +1 = probable end of file	*
C*					  0 = normal			*
C*					-20 = open error for Table B	*
C*					-21 = open error for Table D	*
C*					-22 = missing forecast time	*
C*					-23 = missing station number	*
C*					-24 = missing station lat	*
C*					-25 = missing station lon	*
C*					-26 = missing station elevation *
C*					-27 = missing class		*
C*					-28 = zero length data array	*
C*					-29 = no data--try again	*
C**									*
C* Log:									*
C* K. Brill/NMC		 5/94						*
C* K. Brill/NMC		 7/94	Documentation				*
C* K. Brill/NMC		10/94	Set MAXR=32->1000			*
C* K. Brill/NMC		10/94	Assume longitude is negative west	*
C* K. Brill/NMC		10/95	Decode BUFTBL for path to w3buf tables	*
C* K. Brill/EMC		 4/96	Check for lat/lon in radians		*
C************************************************************************
        PARAMETER       ( MAXR = 2000, MAXD = 3500, RMISSD = -9999.0 )
        PARAMETER       ( PI = 3.14159265  )
        PARAMETER       ( RTD = 180. / PI  )
C*
	REAL		snbufr (*), sfbufr (*)
	INTEGER		iday (3)
C*
	CHARACTER*32	errstr
	CHARACTER	cmssg*(32768*4)
        INTEGER         messg (32768)
	EQUIVALENCE	(cmssg, messg)
        INTEGER         istack ( 1024 ), mstack ( 2, MAXD ),
     +                  lstack ( 2, MAXD )
        INTEGER         iptr ( 100 ), ident ( 100 ), ldata ( MAXD )
        INTEGER         kdata ( MAXR, MAXD ), knr ( MAXR )
	LOGICAL		sndflg, sfcflg, hdrflg, radflg
C*
	SAVE		iptr, istack, mstack, lstack, ident, ldata,
     +			kdata, knr, messg,
     +			iub, iud, indx, radflg
        DATA            iub, iud / 0, 0 /
C-----------------------------------------------------------------------
	iret = 0
	nz = 0
C*
	IF ( iub * iud .eq. 0 ) THEN
C
C*	    Open the standard BUFR table files.
C
	    iub = 91
	    OPEN ( unit=iub, file='tableb.tbl', IOSTAT=ios )
	    IF ( ios .ne. 0 ) THEN
	    	iret = -20
	    	errstr = 'Open failed -- TABLE B'
	    	CALL ER_WMSG ( 'SNMDSN', iret, errstr, ier )
	    	RETURN
	    END IF
	    iud = 92
	    OPEN ( unit=iud, file='tabled.tbl', IOSTAT=ios )
	    IF ( ios .ne. 0 ) THEN
	    	iret = -21
	    	errstr = 'Open failed -- TABLE D'
	    	CALL ER_WMSG ( 'SNMDSN', iret, errstr, ier )
	    	RETURN
	    END IF
	END IF
C
C*	Read in a profile report.
C
	IF ( istbyt .eq. 1 ) THEN
	    CALL BF_SRCH ( lunin, istbyt, lngth, istbyt, messg, ier )
	    IF ( ier .ne. 0 ) THEN
		iret = +1
		errstr = ' Probable END OF BUFR file.'
		CALL ER_WMSG ( 'SNMDSN', iret, errstr, ier )
		RETURN
	    END IF
	    indx = 0
C
C*	    Read the Woollen BUFR tables from the first message.
C
	    iptr ( 20 ) = 0
	    iptr ( 21 ) = 0
C
C*	    Check for lat/lon in radians.
C
	    iq1 = INDEX ( cmssg, '5  -158000' )
	    iq2 = INDEX ( cmssg, '5  -315000' )
	    iq = iq1 * iq2
	    IF ( iq .ne. 0 ) THEN
		radflg = .true.
	    ELSE
		radflg = .false.
	    END IF
            CALL BF_PARS ( iptr, ident, messg, istack, mstack, kdata,
     +                    knr, indx, ldata, lstack, MAXR, MAXD,
     +                    iub, iud )
C*
	    CALL BF_SRCH ( lunin, istbyt, lngth, istbyt, messg, ier )
	    IF ( ier .ne. 0 ) THEN
		iret = +1
		errstr = ' Probable END OF BUFR file.'
		CALL ER_WMSG ( 'SNMDSN', iret, errstr, ier )
		RETURN
	    END IF
	    indx = 0
	END IF
C*
        CALL BF_PARS ( iptr, ident, messg, istack, mstack, kdata,
     +                knr, indx, ldata, lstack, MAXR, MAXD,
     +                iub, iud )
	IF ( iptr (1) .eq. 99 ) THEN
C
C*	    Read the next BUFR message.
C
	    CALL BF_SRCH ( lunin, istbyt, lngth, istbyt, messg, ier )
	    IF ( ier .ne. 0 ) THEN
		iret = +1
		errstr = ' Probable END OF BUFR file.'
		CALL ER_WMSG ( 'SNMDSN', iret, errstr, ier )
		RETURN
	    END IF
	    indx = 0
            CALL BF_PARS ( iptr, ident, messg, istack, mstack, kdata,
     +                    knr, indx, ldata, lstack, MAXR, MAXD,
     +                    iub, iud )
	END IF
	iday (3) = ident ( 8 )
	iday (1) = ident ( 9 )
	iday (2) = ident ( 10 )
	ihr      = ident ( 11 )
C
C*	Search backward for the last replication descriptor.
C*	Everything after it can be ignored.
C
	i = iptr (31)
	iend = 0
	DO WHILE ( i .ne. 0 .and. iend .eq. 0 )
	    CALL BF_2FXY ( mstack (1,i), mf, mx, my, ier )
	    IF ( mf .eq. 1 ) iend = i - 1
	    i = i - 1
	END DO
	IF ( i .eq. 0 ) THEN
	    iret = -28
	    RETURN
	END IF
C
C*	Go through the data getting the parameter values
C*	and the counts for levels and parameters.
C
	sndflg = .false.
	sfcflg = .false.
	hdrflg = .true.
	nhdr   = 0
	npsn   = 0
	npsf   = 0
	ncnt   = 0
	maxcnt = 0
	ibn    = 0
	i = 0
	DO WHILE ( i .lt. iend )
	    i = i + 1
C
C*	    Compute numerical values.
C
	    kdt = kdata ( indx, i )
	    CALL BF_2FXY ( mstack (1,i), mf, mx, my, ier )
	    np  = mstack ( 2, i )
	    IF ( kdt .eq. 0 ) THEN
		rdt = 0.
	    ELSE IF ( np .eq. 0 ) THEN
		rdt = FLOAT ( kdt )
	    ELSE
	        rdt = FLOAT ( kdt ) / 10. ** np
	    END IF
C*
	    IF ( mf .eq. 0 .and. my .eq. 0 ) THEN
C
C*		Skip this descriptor.
C
	    ELSE IF ( mf .eq. 1 ) THEN
C
C*		Next descriptor is the number of levels.
C
		sndflg = .true. 
		hdrflg = .false.
		sfcflg = .false.
		ncnt = 0
C*
	    ELSE IF ( mf .eq. 0 .and. mx .eq. 31 .and.
     +		      my .eq. 1 ) THEN
C
C*		Set the number of levels.
C
		nz = kdt
		IF ( nz .lt. 2 ) THEN
		    iret = -29
		    RETURN
		END IF
		npsnsb = 0
	    ELSE
C
C*		Decode appropriate data.
C
		IF ( hdrflg ) THEN
		    nhdr = nhdr + 1
		    IF ( nhdr .eq. 1 ) THEN
			IF ( kdt .eq. 999999 ) THEN
			    iret = -22
			    RETURN
			ELSE
			    ifct = kdt
			END IF
		    ELSE IF ( nhdr .eq. 2 ) THEN
			IF ( kdt .eq. 999999 ) THEN
			    iret = -23
			    RETURN
			ELSE
			    istnm = kdt
			END IF
		    ELSE IF ( nhdr .eq. 3 ) THEN
			IF ( kdt .eq. 999999 ) THEN
			    iret = -24
			    RETURN
			ELSE IF ( radflg ) THEN
			    slat = rdt * RTD
			ELSE
			    slat = rdt
			END IF
		    ELSE IF ( nhdr .eq. 4 ) THEN
			IF ( kdt .eq. 999999 ) THEN
			    iret = -25
			    RETURN
			ELSE IF ( radflg ) THEN
			    slon = rdt * RTD
			ELSE
			    slon = rdt
			END IF
		    ELSE IF ( nhdr .eq. 5 ) THEN
			IF ( kdt .eq. 999999 ) THEN
			    iret = -26
			    RETURN
			ELSE
			    selv = rdt
			END IF
		    ELSE IF ( nhdr .eq. 6 ) THEN
			IF ( kdt .eq. 999999 ) THEN
			    iret = -27
			    RETURN
			ELSE
			    iclass = kdt
			END IF
			hdrflg = .false.
		    END IF
C*
		ELSE IF ( sndflg ) THEN
		    ncnt = ncnt + 1
		    IF ( npsnsb .eq. 0 ) THEN
			idsv = mstack (1,i)
			npsnsb = 1
		    ELSE IF ( idsv .ne. 0 ) THEN
			IF ( idsv .ne. mstack (1,i) ) THEN
			    npsnsb = npsnsb + 1
			ELSE
			    idsv = 0
			    npsn = npsn + npsnsb
			    maxcnt = npsnsb * nz
			END IF
		    END IF
		    ibn = ibn + 1
		    IF ( kdt .eq. 999999 ) THEN
			snbufr ( ibn ) = RMISSD
		    ELSE
		        snbufr ( ibn ) = rdt
		    END IF
C
C*		    Check for end of sounding data.
C
		    IF ( ncnt .eq. maxcnt ) THEN
			sndflg = .false.
			sfcflg = .true.
		    END IF
C*
		ELSE IF ( sfcflg ) THEN
		    npsf = npsf + 1
		    IF ( kdt .eq. 999999 ) THEN
                        sfbufr ( npsf ) = RMISSD
                    ELSE
                        sfbufr ( npsf ) = rdt
                    END IF
		END IF
C*
	    END IF
	END DO
C*
	RETURN
	END