SUBROUTINE AP_BUFR  ( iunbfp, iunbfr, irundt, iret )
C************************************************************************
C* AP_BUFR								*
C*									*
C* This subroutine retrieves data from the interface arrays, converts	*
C* it into BUFR output, and then writes the BUFR output to the BUFR	*
C* output stream.							*
C*									*
C* AP_BUFR  ( IUNBFP, IUNBFR, IRUNDT, IRET )				*
C*									*
C* Input parameters:							*
C*	IUNBFP		INTEGER		BUFR output file unit number	*
C*					for wind profiler data		*
C*	IUNBFR		INTEGER		BUFR output file unit number	*
C*					for RASS data			*
C*	IRUNDT (5)	INTEGER		Run date-time			*
C*					(YYYY, MM, DD, HH, MM)		*
C*									*
C* Output parameters:							*
C*	IRET		INTEGER		Return code:			*
C*					  0 = normal return		*
C**									*
C* Log:									*
C* J. Ator/NCEP		10/08						*
C* J. Ator/NCEP		08/11	Remove station elevation from		*
C*				calculation of HEIT			*
C* J. Ator/NCEP		11/12	Fix typo in variable name		*
C************************************************************************
	INCLUDE		'GEMPRM.PRM'
	INCLUDE		'apcmn.cmn'
C*
	CHARACTER*(*)	CPLVST
	PARAMETER	( CPLVST = 'HEIT WDIR WSPD WCMP SDVS NPQC' )
C*
	CHARACTER*(*)	CRLVST
	PARAMETER	( CRLVST = 'HEIT TMVR NPQC' )
C*
	REAL*8		r8pary ( 6, MXLVLS ),
     +			r8rary ( 3, MXLVLS ),
     +			UT_RIBM, AP_NPQC 
C*
	REAL		gswarr (3)
C*
	LOGICAL		keep
C*
	INTEGER		irundt (5)
C*
	INCLUDE		'ERMISS.FNC'
C*-----------------------------------------------------------------------
	iret = 0
C
C*	Determine how many of each type of level (wind profiler vs. RASS
C*	temperature) we have for this report.
C
	nplvl = 0
	nrlvl = 0
	gswarr (1) = rivals ( irgsw1 )
	gswarr (2) = rivals ( irgsw2 )
	gswarr (3) = rivals ( irgsw3 )
C
	DO ii = 1, INT ( rivals ( irnlvl ) )
	  ltyp = INT ( rivals ( irltyp ( ii ) ) )
	  heit = rivals ( irhgtm ( ii ) )
C
	  IF ( ltyp .eq. 4 )  THEN
C
C*	    RASS temperature level.
C
	    IF ( .not. ERMISS ( rivals ( irvtmp (ii) ) ) ) THEN
	      nrlvl = nrlvl + 1
	      r8rary ( 1, nrlvl ) = heit
	      r8rary ( 2, nrlvl ) = rivals ( irvtmp (ii) )
	      r8rary ( 3, nrlvl ) = AP_NPQC ( rivals ( irvtmpqr (ii) ) )
	    END IF
	  ELSE IF ( ( ltyp .ge. 1 ) .and. ( ltyp .le. 3 ) ) THEN
C
C*	    Wind profiler level.
C
	    IF ( .not. ERMISS ( rivals ( irdrct (ii) ) ) ) THEN
	      keep = .true.
	      gsw = gswarr ( ltyp )
	      qcr = rivals ( irdrctqr (ii) )
C
	      IF ( ( nplvl .gt. 1 ) .and. ( heit .eq. heitlast ) ) THEN
C
C*		The height at this level is the same as the height at
C*		the previous level.  Keep the one with the best QC
C*		(i.e. lowest QCR) value, or, if both such values are the
C*		same, keep the level with the smallest gate width.
C
		WRITE ( UNIT = logmsg, FMT = '( A, F7.1 )' )
     +		  'AP_BUFR found duplicate level at HGTM = ',
     +		  rivals ( irhgtm ( ii ) )
		CALL DC_WLOG  ( 4, 'DC', 2, logmsg, ierwlg )
		IF ( ( ( qcr .eq. qcrlast ) .and. ( gsw .lt. gswlast ) )
     +			.or. ( qcr .lt. qcrlast ) ) THEN
		  WRITE ( UNIT = logmsg, FMT = '( A, I2 )' )
     +		    '--> kept latest data from LTYP = ', ltyp
		  nplvl = nplvl - 1
		ELSE
		  WRITE ( UNIT = logmsg, FMT = '( A, I2 )' )
     +		    '--> kept previous data from LTYP = ',
     +		    INT ( rivals ( irltyp ( ii - 1 ) ) )
		  keep = .false.
		END IF
		CALL DC_WLOG  ( 4, 'DC', 2, logmsg, ierwlg )
	      END IF
C
	      IF ( keep ) THEN
		nplvl = nplvl + 1
		r8pary ( 1, nplvl ) = heit
		r8pary ( 2, nplvl ) = rivals ( irdrct (ii) )
		r8pary ( 3, nplvl ) = UT_RIBM ( rivals ( irsped (ii) ) )
		r8pary ( 4, nplvl ) = UT_RIBM ( rivals ( irwcmp (ii) ) )
		r8pary ( 5, nplvl ) = UT_RIBM ( rivals ( irwdev (ii) ) )
	        r8pary ( 6, nplvl ) = AP_NPQC ( qcr )
		heitlast = heit
		gswlast = gsw
		qcrlast = qcr
	      END IF
	    END IF
	  END IF
C
	END DO
C
C*	Set the BUFR message date-time.
C
	year = rivals ( iryear )
	rmth = rivals ( irmnth )
	days = rivals ( irdays )
	hour = rivals ( irhour )
	IF  ( ( ERMISS ( year ) ) .or. ( ERMISS ( rmth ) ) .or.
     +	      ( ERMISS ( days ) ) .or. ( ERMISS ( hour ) )  )  THEN
	    RETURN
	END IF
	ibfdt = ( INT ( year ) * 1000000 ) + ( INT ( rmth ) * 10000 ) +
     +		( INT ( days ) * 100 ) + INT ( hour )
C
C*	Store and write out the wind profiler data.
C
	IF ( nplvl .gt. 0 )  THEN
	    CALL OPENMB ( iunbfp, 'NC002011', ibfdt )
	    CALL AP_BFID ( iunbfp, irundt, ierbid )
	    CALL UFBINT ( iunbfp, r8pary, 6, nplvl, ierubf, CPLVST )
	    CALL UT_WBFR ( iunbfp, 'map', 0, ierwbf )
	END IF
C
C*	Store and write out the RASS temperature data.
C
	IF ( nrlvl .gt. 0 )  THEN
	    CALL OPENMB ( iunbfr, 'NC002012', ibfdt )
	    CALL AP_BFID ( iunbfr, irundt, ierbid )
	    CALL UFBINT ( iunbfr, r8rary, 3, nrlvl, ierubf, CRLVST )
	    CALL UT_WBFR ( iunbfr, 'map', 0, ierwbf )
	END IF
C*
	RETURN
	END