SUBROUTINE CP_BUFR  ( iunbfo, irundt, ccopbn, iret )
C************************************************************************
C* CP_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* CP_BUFR  ( IUNBFO, IRUNDT, CMSOBN, IRET )				*
C*									*
C* Input parameters:							*
C*	IUNBFO		INTEGER		BUFR output file unit number	*
C*	IRUNDT (5)	INTEGER		Run date-time			*
C*					(YYYY, MM, DD, HH, MM)		*
C*	CMSOBN		CHAR*18		COOP data file basename		*
C*									*
C* Output parameters:							*
C*	IRET		INTEGER		Return code:			*
C*					  0 = normal return		*
C**									*
C* Log:									*
C* J. Ator/NCEP		07/06						*
C* S. Guan/NCEP         11/09   To deal with NEPP and HCN data          *
C************************************************************************
	INCLUDE		'GEMPRM.PRM'
	INCLUDE		'cpcmn.cmn'
C*
	INTEGER		irundt (5)
C*
	CHARACTER	bfstyp*8, ccopbn*18
C*
	REAL*8		r8ary ( 9, MAX0 ( MXSOL, MXSNW ) ), UT_RIBM
C*
	INCLUDE		'ERMISS.FNC'
C*-----------------------------------------------------------------------
	iret = 0
C
	IF  ( ( civals ( icprvid )(1:3) .eq. 'HCN' ) .or.
     +      ( civals ( icprvid )(1:4) .eq. 'NEPP' ) )  THEN
            bfstyp = 'NC255101'
        ELSE
	    RETURN
	END IF
	rsrd = RMISSD
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*	Open a BUFR message for output.
C
	CALL OPENMB  ( iunbfo, bfstyp, ibfdt )
C
C*	Report date-time.
C
	CALL UT_RIBF  ( iunbfo, 'YEAR', rivals ( iryear ), ierrbf )
	CALL UT_RIBF  ( iunbfo, 'MNTH', rivals ( irmnth ), ierrbf )
	CALL UT_RIBF  ( iunbfo, 'DAYS', rivals ( irdays ), ierrbf )
	CALL UT_RIBF  ( iunbfo, 'HOUR', rivals ( irhour ), ierrbf )
	CALL UT_RIBF  ( iunbfo, 'MINU', rivals ( irminu ), ierrbf )
C
C*	Receipt date-time.
C
	CALL UT_RIBF  ( iunbfo, 'RCYR', FLOAT ( irundt (1) ), ierrbf )
	CALL UT_RIBF  ( iunbfo, 'RCMO', FLOAT ( irundt (2) ), ierrbf )
	CALL UT_RIBF  ( iunbfo, 'RCDY', FLOAT ( irundt (3) ), ierrbf )
	CALL UT_RIBF  ( iunbfo, 'RCHR', FLOAT ( irundt (4) ), ierrbf )
	CALL UT_RIBF  ( iunbfo, 'RCMI', FLOAT ( irundt (5) ), ierrbf )
	CALL UT_RIBF  ( iunbfo, 'RCTS', 0., ierrbf )
C
C*	Station ID.
C
	CALL UT_CIBF  ( iunbfo, 'RPID', civals ( icstid ), 8, iercbf )
C
C*	Provider ID.
C
	CALL ST_LSTR  ( civals ( icprvid ), lenp, ierltr )
	CALL UT_CIBF  ( iunbfo, 'PRVSTG',
     +			civals ( icprvid ), lenp, iercbf )
C
C*	File basename.
C
	CALL UT_CIBF  ( iunbfo, 'FNSTG', ccopbn, 18, iercbf )
C
C*	Latitude.
C
	CALL UT_RIBF  ( iunbfo, 'CLATH', rivals ( irslat ), ierrbf )
C
C*	Longitude.
C
	CALL UT_RIBF  ( iunbfo, 'CLONH', rivals ( irslon ), ierrbf )
C
C*	Elevation.
C
	CALL UT_RIBF  ( iunbfo, 'SELV', rivals ( irselv ), ierrbf )
C
C*	Platform type.
C
	CALL UT_RIBF  ( iunbfo, 'PLTTYP',
     +			PR_D100 ( rivals ( irpltp ) ) , ierrbf )
C
C*	Temperature (and associated QC values).
C
	CALL UT_QIBF  ( rivals ( irtmpk ),
     +			civals ( ictmpkqd ),
     +			rivals ( irtmpkqa ),
     +			rivals ( irtmpkqr ),
     +			r8ary ( 1, 1 ), r8ary ( 2, 1 ),
     +			r8ary ( 3, 1 ), r8ary ( 4, 1 ), ierqbf )
	IF  ( ierqbf .eq. 0 )  THEN
            CALL DRFINI  ( iunbfo, 1, 1, '<MNTMDBSQ>')
	    CALL UFBSEQ  ( iunbfo, r8ary, 4, 1, ierusq, 'MNTMDBSQ' )
	END IF
C
C*	Dewpoint temperature (and associated QC values).
C
	CALL UT_QIBF  ( rivals ( irdwpk ),
     +			civals ( icdwpkqd ),
     +			rivals ( irdwpkqa ),
     +			rivals ( irdwpkqr ),
     +			r8ary ( 1, 1 ), r8ary ( 2, 1 ),
     +			r8ary ( 3, 1 ), r8ary ( 4, 1 ), ierqbf )
	IF  ( ierqbf .eq. 0 )  THEN
            CALL DRFINI  ( iunbfo, 1, 1, '<MNTMDPSQ>')
	    CALL UFBSEQ  ( iunbfo, r8ary, 4, 1, ierusq, 'MNTMDPSQ' )
	END IF
C
C*	Wind direction (and associated QC values).
C
	CALL UT_QIBF  ( rivals ( irdrct ),
     +			civals ( icdrctqd ),
     +			rivals ( irdrctqa ),
     +			rivals ( irdrctqr ),
     +			r8ary ( 1, 1 ), r8ary ( 2, 1 ),
     +			r8ary ( 3, 1 ), r8ary ( 4, 1 ), ierqbf )
	IF  ( ierqbf .eq. 0 )  THEN
            CALL DRFINI  ( iunbfo, 1, 1, '<MNWDIRSQ>')
	    CALL UFBSEQ  ( iunbfo, r8ary, 4, 1, ierusq, 'MNWDIRSQ' )
	END IF
C
C*	Wind speed (and associated QC values).
C
	CALL UT_QIBF  ( rivals ( irsped ),
     +			civals ( icspedqd ),
     +			rivals ( irspedqa ),
     +			rivals ( irspedqr ),
     +			r8ary ( 1, 1 ), r8ary ( 2, 1 ),
     +			r8ary ( 3, 1 ), r8ary ( 4, 1 ), ierqbf )
	IF  ( ierqbf .eq. 0 )  THEN
            CALL DRFINI  ( iunbfo, 1, 1, '<MNWSPDSQ>')
	    CALL UFBSEQ  ( iunbfo, r8ary, 4, 1, ierusq, 'MNWSPDSQ' )
	END IF
C
C*	Soil moistures/temperatures (and associated QC values).
C
	nsol = INT ( rivals ( irnsol ) )
	IF  ( nsol .gt. 0 )  THEN
	    DO ii = 1, nsol
		r8ary ( 1, ii ) =
     +	      UT_RIBM ( PR_HGMK ( PR_INMM ( rivals ( irslin (ii) ) ) ) )
		CALL UT_QIBF  ( rivals ( irsolm (ii) ),
     +				civals ( icsolmqd (ii) ),
     +				rivals ( irsolmqa (ii) ),
     +				rivals ( irsolmqr (ii) ),
     +				r8ary ( 2, ii ), r8ary ( 3, ii ),
     +				r8ary ( 4, ii ), r8ary ( 5, ii ),
     +				ierqbf )
		CALL UT_QIBF  ( rivals ( irsolt (ii) ),
     +				civals ( icsoltqd (ii) ),
     +				rivals ( irsoltqa (ii) ),
     +				rivals ( irsoltqr (ii) ),
     +				r8ary ( 6, ii ), r8ary ( 7, ii ),
     +				r8ary ( 8, ii ), r8ary ( 9, ii ),
     +				ierqbf )
	    END DO
            CALL DRFINI  ( iunbfo, nsol, 1, '{MNSOMTSQ}')
	    CALL UFBSEQ  ( iunbfo, r8ary, 9, nsol, ierusq, 'MNSOMTSQ' )
	END IF
C
C*	Depth of fresh snow (and associated QC values).
C
	nsnw = INT ( rivals ( irnsnw ) )
	IF  ( nsnw .gt. 0 )  THEN
	    DO ii = 1, nsnw
		r8ary ( 1, ii ) = UT_RIBM ( rivals ( irsnhr (ii) ) )
		CALL UT_QIBF  ( rivals ( irdofs (ii) ),
     +				civals ( icdofsqd (ii) ),
     +				rivals ( irdofsqa (ii) ),
     +				rivals ( irdofsqr (ii) ),
     +				r8ary ( 2, ii ), r8ary ( 3, ii ),
     +				r8ary ( 4, ii ), r8ary ( 5, ii ),
     +				ierqbf )
	    END DO
            CALL DRFINI  ( iunbfo, nsnw, 1, '{MNDOFSSQ}')
	    CALL UFBSEQ  ( iunbfo, r8ary, 5, nsnw, ierusq, 'MNDOFSSQ' )
	END IF
C
C*	Total snow depth (and associated QC values).
C
	CALL UT_QIBF  ( rivals ( irtosd ),
     +			civals ( ictosdqd ),
     +			rivals ( irtosdqa ),
     +			rivals ( irtosdqr ),
     +			r8ary ( 1, 1 ), r8ary ( 2, 1 ),
     +			r8ary ( 3, 1 ), r8ary ( 4, 1 ), ierqbf )
	IF  ( ierqbf .eq. 0 )  THEN
            CALL DRFINI  ( iunbfo, 1, 1, '<MNTOSDSQ>')
	    CALL UFBSEQ  ( iunbfo, r8ary, 4, 1, ierusq, 'MNTOSDSQ' )
	END IF
C
C*	1-hr precipitation amount (and associated QC values).
C
C*	Note that, since the density of water is 1 g/cm**3, then
C*	1 m of precipitation = 1000 kg/m**2.
C
	CALL UT_QIBF  ( rivals ( irpc1h ),
     +			civals ( icpc1hqd ),
     +			rivals ( irpc1hqa ),
     +			rivals ( irpc1hqr ),
     +			r8ary ( 2, 1 ), r8ary ( 3, 1 ),
     +			r8ary ( 4, 1 ), r8ary ( 5, 1 ), ierqbf )
	IF  ( ierqbf .eq. 0 )  THEN
	    r8ary ( 1, 1 ) = 1.
            CALL DRFINI  ( iunbfo, 1, 1, '{MNTOPCSQ}')
	    CALL UFBSEQ  ( iunbfo, r8ary, 5, 1, ierusq, 'MNTOPCSQ' )
	END IF
C
C*	Restrictions on redistribution.
C
	CALL UT_RIBF  ( iunbfo, 'RSRD', rsrd, ierrbf )
C
C*	Store the BUFR report.
C
	CALL UT_WBFR  ( iunbfo, 'coop', 0, ierwbf )
C*
	RETURN
	END