SUBROUTINE SNMRBF ( lunbuf, maxsnd, mxprof, maxsfc,
     +			    tblde, nde, degree, ihr, iday, ifct, istnm,
     +                      slat, slon, selv, npsn, nz, nprofs, npsf,
     +			    snbufr, sfbufr, iclass, iret )
C************************************************************************
C* SNMRBF								*
C*									*
C* This subroutine returns the next sounding subset of MODEL profile	*
C* and surface point data stored in a BUFR file.			*
C*									*
C* Note:  the BUFR file is assumed open and connected to unit LUNBUF.   *
C* The BUFR file is opened using JB_OPEN. 			        *
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.  This applies to each profile data set encountered.	*
C* The first one is in SNBUFR (*,1), the second in SNBUFR (*,2), etc.	*
C* The * represents the range of index values required to accomodate	*
C* the sounding data ordered parameter-wise as described above.  Each	*
C* sounding data set is assumed to have a TABLE D entry having PROFIL	*
C* as the first six characters.						*
C*									*
C* On RETURN, the output arrays will have the following dimensions	*
C*									*
C*	SNBUFR (MAXSND,NPROFS)  with first index limited to		*
C*				NPSN(i) * NZ (i) for each profile set	*
C*	NPSN   (NPROFS)							*
C*	NZ     (NPROFS)							*
C*	SFBUFR (NPSF)							*
C*									*
C* The HEADR TABLE D entry will be the source of the station data.	*
C* All of the other TABLE D entries that do not begin with PROFIL will	*
C* be assumed to be surface data, even if replicated.  Such data will	*
C* be loaded into SFBUFR in the order implied by the BUFR table.	*
C*									*
C* If this is an old BUFR file, the SLAT, SLON, were stored as radians	*
C* in the BUFR file.  In that case, the values in the table file will	*
C* be scaled by five and have the reference -158000 for latitude and	*
C* -315000 for longitude.  For this case DEGREE must be set to FALSE	*
C* in SNMPRP.								*
C*									*
C* The TBLDE array contains the list of table D entries in the order	*
C* of occurrence in the file as generated by a call to SNMPRP.		*
C*									*
C* SNMRBF  ( LUNBUF, MAXSND, MXPROF, MAXSFC, TBLDE, NDE, DEGREE, 	*
C*	     IHR, IDAY, IFCT, ISTNM, SLAT, SLON, SELV,			*
C*	     NPSN, NZ, NPROFS, NPSF, SNBUFR, SFBUFR, ICLASS, IRET )	*
C*									*
C* Input parameters:							*
C*	LUNBUF		INTEGER		Unit number of the BUFR file	*
C*	MAXSND		INTEGER		Maximum 1st dimension of SNBUFR *
C*	MXPROF		INTEGER		Maximum 2nd dimension of SNBUFR	*
C*	MAXSFC		INTEGER		Maximum dimension of SFBUFR	*
C*	TBLDE (NDE)	CHAR*(*)	TABLE D entries from BUFR table	*
C*	NDE		INTEGER		# of TABLE D entries		*
C*	DEGREE		LOGICAL		Flag for lat/lon in degrees	*
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 (MXPROF)	INTEGER		Number of sounding parameters	*
C*	NZ (MXPROF)	INTEGER		Number of sounding levels	*
C*	NPROFS		INTEGER		Number of profile sets		*
C*	NPSF		INTEGER		Number of surface parameters	*
C*	SNBUFR(MAXSND,							*
C*	       MXPROF)	REAL		Output profile data values	*
C*	SFBUFR (MAXSFC)	REAL		Output surface data values	*
C*	ICLASS		INTEGER		Class of profile output		*
C*	IRET		INTEGER		Return code			*
C*					  0 = normal			*
C*					 +1 = end of input file         *
C*					-12 = error reading input file  *
C*					-20 = sequence name not found   *
C*					-21 = no parameters requested   *
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*					-36 = too many profiles         *
C**									*
C* Log:									*
C* D. Kidwell/NCEP	 8/98						*
C* K. Brill/EMC		 8/98	Check missing values; ICLASS missing = 0*
C* K. Brill/EMC		 9/98	CALL JTB_SPLT rather than BTB_SPLT	*
C************************************************************************
C* GEMPRM.PRM
C*
C* This include file contains parameter definitions for SNMRBF.
C*
C**
C************************************************************************
C!
C!	Missing data definitions
C!
 	PARAMETER	( RMISSD = -9999.0 )
C!						Missing data value
	PARAMETER	( RDIFFD =  0.1    )
C!						Missing value fuzziness
	PARAMETER	( IMISSD = -9999   )
C!						Missing integer value
	LOGICAL		  ERMISS
C!						Declare for stmt func
C*
	CHARACTER*(*)	tblde (*)
	REAL		snbufr (maxsnd,*), sfbufr (*)
	INTEGER		npsn (*), nz (*), iday (3)
	LOGICAL		degree
C*
	CHARACTER*8	seqs (16), pseq, pnams (80)
	CHARACTER*400	parms
	REAL*8		work ( 32768 )
C*	
C**********************************************************************
C*                                                                    *
C*  Function statement for missing value test.  When using this       *
C*  test it is important to remember to include this file AFTER       *
C*  all declarations, parameter statements, and data statements.      *
C*  It is also necessary to include the file (GEMPRM.PRM) that        *
C*  contains the parameter statements for the missing data values     *
C*  (RMISSD AND RDIFFD).                                              *
C**********************************************************************
C
       ERMISS (xxxx) = ( ABS ( xxxx - RMISSD ) .lt. RDIFFD )
C-----------------------------------------------------------------------
	iret = 0
C
C* 	Get the next BUFR report.
C
	CALL JB_NEXT ( lunbuf, iymdh, ier )
	IF ( ier .ne. 0 ) THEN
	    IF ( ier .eq. -1 ) iret = 1
	    IF ( ier .eq. -2 ) iret = -12
	    RETURN
	END IF
C
C*	Get the cycle hour and starting month, day and year.
C
	ihr = MOD ( iymdh, 100 ) 
	iymdh = iymdh / 100
	iday ( 2 ) = MOD ( iymdh, 100 )
	iymdh = iymdh / 100
	iday ( 1 ) = MOD ( iymdh, 100 )
	iday ( 3 ) = iymdh / 100
C
C*	Loop over all TABLE D entries.
C
	npsf = 0
	nprofs = 0
	DO i = 1, mxprof
	    npsn ( i ) = 0
	    nz ( i )   = 0
	END DO
C
	nseq = nde
	DO i = 1, nde
	    seqs ( i ) = tblde ( i )
	END DO
C
	DO i = 1, nde
C
C*	    Get parameter names for the next sequence.
C
	    CALL JTB_SPLT ( seqs, nseq, pseq, pnams, np, ier )
	    IF ( ier .ne. 0 ) THEN
		iret = -20
		RETURN
	    END IF
	    CALL ST_LSTC ( pnams, np, ' ', parms, ier )
	    IF ( ier .ne. 0 ) WRITE (6,*)
     +			' Error in ST_LSTC -- continuing.'
	    CALL ST_LSTR ( parms, len, ier )
C
C*	    Get the data values for the sequence.
C
	    IF ( pseq ( 1:6 ) .eq. 'PROFIL' ) THEN
		CALL JB_READ ( lunbuf, parms (:len), maxsnd, work, nprm,
     +			       nlvl, ier )
	      ELSE
		CALL JB_READ ( lunbuf, parms (:len), maxsfc, work, nprm,
     +			       nlvl, ier )
	    END IF
	    IF ( ier .ne. 0 ) THEN
	        IF ( ier .eq. -1 ) iret = -12
	        IF ( ier .eq. -2 ) iret = -21
		RETURN
	    END IF
C
	    IF ( pseq ( 1:5 ) .eq. 'HEADR' ) THEN
C
C*	        Set the station parameters.
C
		ifct   = IMISSD
		istnm  = IMISSD
		slat   = RMISSD
		slon   = RMISSD
		selv   = RMISSD
		iclass = IMISSD
		DO j = 1, np
		    IF ( ABS ( work (j) - 1.E11 ) .lt. .05 )
     +			work (j) = RMISSD
		    IF ( pnams ( j ) ( 1:4 ) .eq. 'FTIM' .and.
     +			 .not. ERMISS ( work (j) ) ) THEN
			ifct   = IDNINT ( work ( j ) )
		      ELSE IF ( pnams ( j ) ( 1:4 ) .eq. 'STNM' .and.
     +			 .not. ERMISS ( work (j) ) ) THEN
			istnm  = IDNINT ( work ( j ) )
		      ELSE IF ( pnams ( j ) ( 2:4 ) .eq. 'LAT' .and.
     +			 .not. ERMISS ( work (j) ) ) THEN
			slat   = work ( j )
			IF ( .not. degree ) slat = RTD * slat
		      ELSE IF ( pnams ( j ) ( 2:4 ) .eq. 'LON' .and.
     +			 .not. ERMISS ( work (j) ) ) THEN
			slon   = work ( j )
			IF ( .not. degree ) slon = RTD * slon
		      ELSE IF ( pnams ( j ) ( 2:4 ) .eq. 'ELV' .and.
     +			 .not. ERMISS ( work (j) ) ) THEN
			selv   = work ( j )
		      ELSE IF ( pnams ( j ) ( 1:4 ) .eq. 'CLSS' .and.
     +			 .not. ERMISS ( work (j) ) ) THEN
			iclass = IDNINT ( work ( j ) ) 
		    END IF
		END DO
C
C*		Check for missing station data.  
C
		IF ( ifct .eq. IMISSD ) THEN
		    iret = -22
		  ELSE IF ( istnm .eq. IMISSD ) THEN
		    iret = -23
		  ELSE IF ( ERMISS ( slat ) ) THEN
		    iret = -24
		  ELSE IF ( ERMISS ( slon ) ) THEN
		    iret = -25
		  ELSE IF ( ERMISS ( selv ) ) THEN
		    iret = -26
		  ELSE IF ( iclass .eq. IMISSD ) THEN
		    iclass = 0
		END IF
		IF ( iret .lt. 0 ) RETURN
C
	      ELSE IF ( pseq ( 1:6 ) .eq. 'PROFIL' ) THEN
C
C*	        Append data to SNBUFR.
C
		IF ( nprofs .lt. mxprof ) THEN
		    nprofs = nprofs + 1
		    npsn ( nprofs ) = nprm
		    nz ( nprofs )   = nlvl
		    indx = 0
		    np   = 0
		    DO lvl = 1, nlvl
		        DO iprm = 1, nprm
			    indx = indx + 1
			    np   = np + 1
			    snbufr ( np, nprofs ) = work ( indx )
			    IF ( ABS ( snbufr (np,nprofs) - 1.E11 )
     +				 .lt. .05 )
     +				snbufr (np,nprofs) = RMISSD
		        END DO
		    END DO
		  ELSE
C		                     
C*		    Have too many profiles.
C
		    iret = -36
		    RETURN
		END IF
C
	      ELSE
C
C*	        Append data to SFBUFR.
C
		indx = 0
		DO lvl = 1, nlvl
		    DO iprm = 1, nprm
			indx = indx + 1
			npsf = npsf + 1
			sfbufr ( npsf ) = work ( indx )
			IF ( ABS ( sfbufr (npsf) - 1.E11 )
     +			     .lt. .05 )
     +			    sfbufr (npsf) = RMISSD
		    END DO
		END DO
	    END IF
	END DO
C*	
	RETURN
	END