SUBROUTINE AP_DCOD  ( cldt, mapfl, bufrtb, nhours, iret )
C************************************************************************
C* AP_DCOD								*
C*									*
C* This routine decodes MAP (multi-agency profiler) data files from FSL	*
C* into BUFR format.							*
C*									*
C* AP_DCOD ( CLDT, MAPFL, BUFRTB, NHOURS, IRET )			*
C*									*
C* Input parameters:							*
C*	CLDT		CHAR*		Date-time from command line	*
C*	MAPFL		CHAR*		MAP data file from FSL		*
C*	BUFRTB		CHAR*		BUFR tables file		*
C*	NHOURS		INTEGER		Max # of hours before run time	*
C*					for creating BUFR output	*
C*									*
C* Output parameters:							*
C*	IRET		INTEGER		Return code:			*
C*					  0 = normal return		*
C*									*
C**									*
C* Log:									*
C* J. Ator/NCEP		10/08						*
C* J. Ator/NCEP         08/11   Add processing of STATYPE as BUFR A4ME  *
C* J. Ator/NCEP         11/12   Fix faulty 3rd dimension in beam arrays	*
C************************************************************************
	INCLUDE		'GEMPRM.PRM'
	INCLUDE		'BRIDGE.PRM'
	INCLUDE		'apcmn.cmn'
C*
	CHARACTER*(*)	cldt, mapfl, bufrtb
C*
	CHARACTER	rundt*12, sysdt*12,
     +			mapdn*(DCMXLN), mapbn*(DCMXLN),
     +			stid(MXSTNS)*10,
     +			crpttm(MXSTNS)*9, cstrtm*9,
     +			prvid(MXSTNS)*10,
     +			qcdml(MXLVLS,MXSTNS,NVARML)*1,
     +			qcdbl(MXSTNS,NVARBL)*1,
     +			qcdsl(MXSTNS,NVARSL)*1,
     +			vcnmml(NVARML)*7,
     +			vcnmbl(NVARBL)*7,
     +			vcnmsl(NVARSL)*7,
     +			rimnem(NRIMN)*8, cimnem(NCIMN)*8
C*
	REAL		slat ( MXSTNS ), slon ( MXSTNS ),
     +			selv ( MXSTNS ),
     +			obsml ( MXLVLS, MXSTNS, NVARML ),
     +			obsbl ( MXSTNS, NVARBL ),
     +			obssl ( MXSTNS, NVARSL )
C*
	INTEGER		irundt (5), irptdt (5),
     +			istnm ( MXSTNS ),
     +			nlvl ( MXLVLS ),
     +			nbeam ( MXLVLS ),
     +			nsta ( MXSTNS ),
     +			iqcaml ( MXLVLS, MXSTNS, NVARML ),
     +			iqcabl ( MXSTNS, NVARBL ),
     +			iqcasl ( MXSTNS, NVARSL ),
     +			iqcrml ( MXLVLS, MXSTNS, NVARML ),
     +			iqcrbl ( MXSTNS, NVARBL ),
     +			iqcrsl ( MXSTNS, NVARSL )
C*
	INCLUDE		'ERMISS.FNC'
C*
C*
C*	The following variable code names define, in accordance
C*	with the MADIS table files "static/maptbl.txt" and
C*	"static/mapvcn.txt", the variables that will be read
C*	from the MAP data file.
C*
C*	Multi-level data.
C*
	DATA		vcnmml
     +			/ 'HT     ', 'DD     ', 'FF     ', 'W      ',
     +			  'TV     ', 'LEVTYPE', 'USDEV  ', 'VSDEV  ',
     +			  'WSDEV  ' /
C*
C*	Antenna beam data.
C*
	DATA		vcnmbl
     +			/ 'GSW1   ', 'GSW2   ', 'GSW3   ' /
C*
C*	Single-level data.
C*
	DATA		vcnmsl
     +			/ 'AVGMIN ', 'STATYPE' /
C*-----------------------------------------------------------------------
	iret = 0
C
C*	Extract the basename from the MAP data file and write it to
C*	the decoder log.
C
	CALL FL_PATH  ( mapfl, mapdn, mapbn, ierpth )
	logmsg = 'MAP filename:  ' // mapbn
	CALL DC_WLOG  ( 0, 'DC', 2, logmsg, ierwlg )
C
C*	The MADIS (Meteorological Assimilation Data Ingest System)
C*	software from FSL will be used to read the MAP data file.
C*	Initialize this software.
C
	CALL MINIT  ( 'MAP', 'FSL', .false., ierfin )
	IF  ( ierfin .ne. 0 )  THEN
	    CALL UT_EMSG  ( 0, 'MINIT', ierfin )
	    RETURN
	END IF
C
C*	Using the MAP data file basename, compute the MADIS date-time.
C
	READ  ( UNIT = mapbn, FMT = '( I4.4, 2I2.2, 1X, 2I2.2 )',
     +		IOSTAT = ier )
     +	    ifyear, ifmnth, ifdays, ifhour, ifminu
	IF  ( ier .ne. 0 )  THEN
	    CALL UT_EMSG  ( 0, 'READ', ier )
	    RETURN
	END IF
	CALL MCHRTIM  ( ifyear, ifmnth, ifdays, ifhour, ifminu,
     +			cstrtm, ierfct )
	IF  ( ierfct .ne. 0 )  THEN
	    CALL UT_EMSG  ( 0, 'MCHRTIM', ierfct )
	    RETURN
	END IF
C
C*	Retrieve all of the stations for which there is data in the
C*	MAP data file.
C
	CALL MMAPSTA  ( cstrtm, nstns, stid, istnm, slat, slon, selv,
     +			crpttm, prvid, ierfst )
	IF  ( ierfst .ne. 0 )  THEN
	    IF  ( ierfst .eq. 1006 )  THEN
		logmsg = 'contained no reports'
		CALL DC_WLOG  ( 0, 'DC', 2, logmsg, ierwlg )
	    ELSE
	        CALL UT_EMSG  ( 0, 'MMAPSTA', ierfst )
	    END IF
	    RETURN
	END IF
C
C*	Now, retrieve the rest of the data for these stations.
C
C*	Multi-level data.
C
	DO ii = 1, NVARML
	    CALL MGETMAP  ( cstrtm, vcnmml ( ii ), itemp, nnmsg, nlvl,
     +			    obsml  ( 1, 1, ii ), qcdml  ( 1, 1, ii ),
     +			    iqcaml ( 1, 1, ii ), iqcrml ( 1, 1, ii ),
     +			    ierfgs )
	    IF  ( ( ierfgs .ne. 0 ) .and. ( ierfgs .ne. 1006 ) )  THEN
		CALL UT_EMSG  ( 0, 'MGETMAP (multi)', ierfgs )
		RETURN
	    END IF
	END DO
C
C*	Antenna beam data.
C
	DO ii = 1, NVARBL
	    CALL MGETMAP  ( cstrtm, vcnmbl ( ii ), itemp, nnmsg, nbeam,
     +			    obsbl  ( 1, ii ), qcdbl  ( 1, ii ),
     +			    iqcabl ( 1, ii ), iqcrbl ( 1, ii ),
     +			    ierfgs )
	    IF  ( ( ierfgs .ne. 0 ) .and. ( ierfgs .ne. 1006 ) )  THEN
		CALL UT_EMSG  ( 0, 'MGETMAP (antenna)', ierfgs )
		RETURN
	    END IF
	END DO
C
C*	Single-level data.
C
	DO ii = 1, NVARSL
	    CALL MGETMAP  ( cstrtm, vcnmsl ( ii ), itemp, nnmsg, nsta,
     +	   		    obssl  ( 1, ii ), qcdsl  ( 1, ii ),
     +			    iqcasl ( 1, ii ), iqcrsl ( 1, ii ),
     +			    ierfgs )
	    IF  ( ( ierfgs .ne. 0 ) .and. ( ierfgs .ne. 1006 ) )  THEN
		CALL UT_EMSG  ( 0, 'MGETMAP (single)', ierfgs )
		RETURN
	    END IF
	END DO
C
C*	Set the pointers for the interface arrays.
C
	CALL AP_IFSP  ( rimnem, cimnem, ierfsp )
	IF  ( ierfsp .ne. 0 )  THEN
	    RETURN
	ENDIF
C
C*	Open the BUFR tables file.
C
	CALL FL_SOPN  ( bufrtb, iunbft, ierspn )
	IF  ( ierspn .ne. 0 )  THEN
	    CALL DC_WLOG  ( 0, 'FL', ierspn, bufrtb, ierwlg )
	    RETURN
	END IF
C
C*	Open the BUFR output files.
C
	CALL FL_GLUN  ( iunbfp, iergln )
	IF  ( iergln .ne. 0 )  THEN
	    CALL DC_WLOG  ( 0, 'FL', iergln, ' ', ierwlg )
	    RETURN
	END IF
	CALL FL_GLUN  ( iunbfr, iergln )
	IF  ( iergln .ne. 0 )  THEN
	    CALL DC_WLOG  ( 0, 'FL', iergln, ' ', ierwlg )
	    RETURN
	END IF
C
C*	Connect the BUFR tables and output files to the BUFR interface.
C
	CALL OPENBF  ( iunbfp, 'NUL', iunbft )
	CALL OPENBF  ( iunbfr, 'NUL', iunbft )
C
C*	Close the BUFR tables file.
C
	CALL FL_CLOS  ( iunbft, iercls )
	IF  ( iercls .ne. 0 )  THEN
	    CALL DC_WLOG  ( 0, 'FL', iercls, ' ', ierwlg )
	END IF
C
C*	Get the system time.
C
	itype = 1
	CALL CSS_GTIM  ( itype, sysdt, iergtm )
	IF  ( iergtm .ne. 0 )  THEN
	    CALL DC_WLOG  ( 2, 'SS', iergtm, ' ', ierwlg )
	    RETURN
	END IF
C
C*	If a date-time was entered on the command line, then use it as
C*	the run date-time.  Otherwise, use the system time as the run
C*	date-time.
C
	IF  ( cldt .eq. 'SYSTEM' )  THEN
	    rundt = sysdt
	ELSE
	    CALL TI_STAN  ( cldt, sysdt, rundt, ierstn )
	    IF  ( ierstn .ne. 0 )  THEN
		CALL DC_WLOG  ( 2, 'TI', ierstn, ' ', ierwlg )
		RETURN
	    END IF
	END IF
C
C*	Convert the run date-time to integer.
C
	CALL TI_CTOI  ( rundt, irundt, iercto )
	IF  ( iercto .ne. 0 )  THEN
	    CALL DC_WLOG  ( 2, 'TI', iercto, ' ', ierwlg )
	    RETURN
	END IF
C
C*	Write the number of reports to the decoder log.
C
	WRITE  ( UNIT = logmsg, FMT = '( A, I6, A )' )
     +		'contained ', nstns, ' reports'
	CALL DC_WLOG  ( 0, 'DC', 2, logmsg, ierwlg )
C
C*	Loop on each report.
C
	DO ii = 1, nstns
C
C*        Filter out FSL MAP report types that are not to be
C*	  decoded into BUFR. 
C
	  IF  ( ( prvid (ii) (1:5) .ne. 'HKOBS' ) .and.
     +		( prvid (ii) (1:3) .ne. 'JMA' ) ) THEN
C
C*		Start an entry for this report in the decoder log.
C
		logmsg = '--------------------'
		CALL DC_WLOG  ( 3, 'DC', 2, logmsg, ierwlg )
C
C*		Initialize the interface values arrays.
C
		CALL AP_IFIV  ( ierfiv )
C
C*		Compute and store the date-time.
C
		CALL MINTTIM  ( crpttm ( ii ), ifyear, ifmnth, ifdays,
     +				ifhour, ifminu, ierftm )
		IF  ( ierftm .ne. 0 )  THEN
		    CALL UT_EMSG  ( 2, 'MINTTIM', ierftm )
		ELSE
		    rivals ( iryear ) = FLOAT ( 1900 + ifyear )
		    rivals ( irmnth ) = FLOAT ( ifmnth )
		    rivals ( irdays ) = FLOAT ( ifdays )
		    rivals ( irhour ) = FLOAT ( ifhour )
		    rivals ( irminu ) = FLOAT ( ifminu )
		END IF
C
C*		Station ID and provider ID.
C
		civals ( icstid )  = stid ( ii )
		civals ( icprvid ) = prvid ( ii )
C
C*		Latitude, longitude and elevation.
C
		rivals ( irslat ) = UT_MDRI ( slat ( ii ) )
		rivals ( irslon ) = UT_MDRI ( slon ( ii ) )
		rivals ( irselv ) = UT_MDRI ( selv ( ii ) )
C
C*		Averaging period in minutes.
C
		rivals ( iravpm ) = UT_MDRI ( obssl ( ii, 1 ) )
		rivals ( irsttp ) = UT_MDRI ( obssl ( ii, 2 ) )
C
C*		Gate spacing.
C
		rivals ( irgsw1 ) = UT_MDRI ( obsbl ( ii, 1 ) )
		rivals ( irgsw2 ) = UT_MDRI ( obsbl ( ii, 2 ) )
		rivals ( irgsw3 ) = UT_MDRI ( obsbl ( ii, 3 ) )
C
C*		Number of levels.
C
		rivals ( irnlvl ) = FLOAT ( nlvl ( ii ) )
C
C*		Loop on each level for the multi-level data.
C
		DO jj = 1, nlvl ( ii )
C
C*		  Level type.
C
		  rivals ( irltyp ( jj ) ) =
     +				UT_MDRI ( obsml ( jj, ii, 6 ) )
C
C*		  Height above mean sea level.
C
		  rivals ( irhgtm ( jj ) ) =
     +				UT_MDRI ( obsml ( jj, ii, 1 ) )
C
C*		  Wind direction (and associated QC values).
C
		  rivals ( irdrct ( jj ) ) =
     +				UT_MDRI ( obsml ( jj, ii, 2 ) )
		  rivals ( irdrctqa ( jj ) ) =
     +			UT_MDRI ( FLOAT ( iqcaml ( jj, ii, 2 ) ) )
		  rivals ( irdrctqr ( jj ) ) =
     +			UT_MDRI ( FLOAT ( iqcrml ( jj, ii, 2 ) ) )
		  civals ( icdrctqd ( jj ) ) = qcdml ( jj, ii, 2 )
C
C*		  Wind speed (and associated QC values).
C
		  rivals ( irsped ( jj ) ) =
     +				UT_MDRI ( obsml ( jj, ii, 3 ) )
		  rivals ( irspedqa ( jj ) ) =
     +			UT_MDRI ( FLOAT ( iqcaml ( jj, ii, 3 ) ) )
		  rivals ( irspedqr ( jj ) ) =
     +			UT_MDRI ( FLOAT ( iqcrml ( jj, ii, 3 ) ) )
		  civals ( icspedqd ( jj ) ) = qcdml ( jj, ii, 3 )
C
C*		  Standard deviation of U-wind component.
C
		  rivals ( irudev ( jj ) ) =
     +				UT_MDRI ( obsml ( jj, ii, 7 ) )
C
C*		  Standard deviation of V-wind component.
C
		  rivals ( irvdev ( jj ) ) =
     +				UT_MDRI ( obsml ( jj, ii, 8 ) )
C
C*		  W-component.
C
		  rivals ( irwcmp ( jj ) ) =
     +				UT_MDRI ( obsml ( jj, ii, 4 ) )
C
C*		  Standard deviation of W-wind component.
C
		  rivals ( irwdev ( jj ) ) =
     +				UT_MDRI ( obsml ( jj, ii, 9 ) )
C
C*		  Virtual temperatures (and associated QC values).
C
		  rivals ( irvtmp ( jj ) ) =
     +				UT_MDRI ( obsml ( jj, ii, 5 ) )
		  rivals ( irvtmpqa ( jj ) ) =
     +			UT_MDRI ( FLOAT ( iqcaml ( jj, ii, 5 ) ) )
		  rivals ( irvtmpqr ( jj ) ) =
     +			UT_MDRI ( FLOAT ( iqcrml ( jj, ii, 5 ) ) )
		  civals ( icvtmpqd ( jj ) ) = qcdml ( jj, ii, 5 )
C
		END DO
C
C*		Write the interface output to the decoder log.
C
		CALL AP_IFPT  ( 3, rimnem, cimnem, ierfpt )
C
C*		Do not create BUFR output for reports that are
C*		more than NHOURS before or more than 3 hours
C*		after the run time.
C
		IF  (  ( ERMISS ( rivals ( iryear ) ) ) .or.
     +		       ( ERMISS ( rivals ( irmnth ) ) ) .or.
     +		       ( ERMISS ( rivals ( irdays ) ) ) .or.
     +		       ( ERMISS ( rivals ( irhour ) ) ) .or.
     +		       ( ERMISS ( rivals ( irminu ) ) )  )  THEN
		    iertmk = -1
		ELSE
		    irptdt (1) = INT ( rivals ( iryear ) )
		    irptdt (2) = INT ( rivals ( irmnth ) )
		    irptdt (3) = INT ( rivals ( irdays ) )
		    irptdt (4) = INT ( rivals ( irhour ) )
		    irptdt (5) = INT ( rivals ( irminu ) )
		    CALL DC_TMCK  ( 2, irundt, irptdt, nhours, 180,
     +				    iertmk )
		END IF
		IF  ( iertmk .eq. 0 )  THEN
C
C*		    Convert interface-format data for this report
C*		    into BUFR output and then write the BUFR output
C*		    to the BUFR output stream.
C
		    CALL AP_BUFR  ( iunbfp, iunbfr, irundt, ierbfr )
		END IF
C
	  END IF
C
	END DO
C
C*	Make sure that all BUFR output has been written before exiting. 
C
	CALL UT_WBFR  ( iunbfp, 'map', 1, ierwbf )
	CALL UT_WBFR  ( iunbfr, 'map', 1, ierwbf )
C
	CALL CLOSBF  ( iunbfp )
	CALL CLOSBF  ( iunbfr )
	CALL FL_CLAL  ( iercal )
C*
	RETURN
	END