SUBROUTINE OZ_DCOD ( iret ) C************************************************************************ C* OZ_DCOD * C* * C* This routine copies bulletins containing EPA AIRNOW Ozone * C* or AIRNOW particulate matter BUFR messages into the NCEP BUFR * C* database. * C* * C* OZ_DCOD ( IRET ) * C* * C* Input parameters: * C* None * C* * C* Output parameters: * C* IRET INTEGER Return code: * C* 0 = normal return * C* * C** * C* Log: * C* C. Caruso Magee/NCEP 04/04 Modifying for dcozon. * C* J. Ator/NCEP 06/04 Update cxdesc to reflect new Section 3, * C* fixed length of BUFR message in print * C* C. Caruso Magee/NCEP 06/04 Update cxdesc to fall back to original * C* 12 BUFR descriptors. * C* C. Caruso Magee/NCEP 02/05 Add ability to decode either original * C* 12 BUFR descriptors or new 1-hr or 8-hr * C* backward averages w/ 11 descriptors. * C* C. Caruso Magee/NCEP 02/06 Replace IUPB with IUPBS01 and modify * C* input args appropriately. C* C. Caruso Magee/NCEP 06/06 Add ability to decode new hrly backward * C* averaged files. C* C. Caruso Magee/NCEP 06/06 Add ability to decode new 2.5 micron * C* particulate matter files. C* S. Guan/NCEP 01/11 Add ability to decode hourly 2.5 micron * C* particulate matter files. * C************************************************************************ INCLUDE 'GEMPRM.PRM' INCLUDE 'BRIDGE.PRM' C* CHARACTER bull*(DCMXBF), cbull*(DCMXBF), bfstyp*8, + seqnum*8, buhd*8, cborg*8, bulldt*8, bbb*8, + logmsg*200 C* INTEGER ibull ( DCMXBF / 4 ) C* C* The variable "mbst" must be dimensioned one byte larger than C* the length of the maximum-size string that it may contain, C* because DBN_BUFR, which is written in C, will append a trailing C* null character. C* CHARACTER mbst*6 C LOGICAL bullok C* EQUIVALENCE ( cbull (1:4), ibull (1) ) C* C* Expected descriptors within Section 3 of an EPA AIRNOW Ozone or C* particulate matter BUFR message. 'A' refers to original forward- C* averaging, 'B' refers to new 1-hr or 8-hr backward averaging and C* to new hourly backward averaging files (as opposed to 1-hr and 8-hr C* files which were received once per day). 'C' refers to particulate C* matter data. C* PARAMETER ( NXDESCA = 12 ) PARAMETER ( NXDESCB = 11 ) PARAMETER ( NXDESCC = 15 ) CHARACTER cxdesca(NXDESCA)*6 CHARACTER cxdescb(NXDESCB)*6 CHARACTER cxdescc(NXDESCC)*6 C* DATA mbst /'ozone'/ DATA cxdesca + / '301011', '004004', '201141', '001050', + '201000', '301021', '015025', '008021', + '103002', '004024', '033020', '015026' / DATA cxdescb + / '301011', '004004', '201141', '001050', + '201000', '301021', '015025', '008021', + '004024', '033020', '015026' / DATA cxdescc + / '301011', '004004', '201141', '001050', + '201000', '301021', '015025', '008021', + '004024', '033020', '201131', '202129', + '015027', '202000', '201000' / C*----------------------------------------------------------------------- iret = 0 C DO WHILE ( .true. ) C C* Get a new bulletin from the input pipe. C CALL DC_GBUL ( bull, lenb, ifdtyp, iergbl ) IF ( iergbl .ne. 0 ) THEN C C* A time-out occurred while waiting for a new bulletin C* on the input pipe. Shut down the decoder and exit. C CALL DC_WLOG ( 0, 'DC', iergbl, ' ', ierwlg ) RETURN END IF bullok = .true. C C* Decode the header information from this bulletin. C IF ( ifdtyp .eq. 0 ) THEN C C* Decode WMO products. C CALL DC_GHDR ( bull, lenb, seqnum, buhd, cborg, + bulldt, bbb, ibptr, ierghd ) IF ( ierghd .ne. 0 ) THEN CALL DC_WLOG ( 2, 'DC', ierghd, ' ', ierwlg ) bullok = .false. ELSE C C* Start an entry for this bulletin in the decoder log. C logmsg = '####################' // + '####################' CALL DC_WLOG ( 2, 'DC', 2, logmsg, ierwlg ) logmsg = seqnum // buhd // cborg // bulldt // bbb CALL DC_WLOG ( 2, 'DC', 2, logmsg, ierwlg ) END IF ELSE C C* Do not decode AFOS products. C bullok = .false. END IF C IF ( bullok ) THEN C C* Locate the EPA AIRNOW Ozone or particulate matter BUFR C* message within the bulletin, and store it within an C* equivalenced integer array. C ipt1 = INDEX ( bull ( ibptr : lenb ), 'BUFR' ) IF ( ipt1 .ne. 0 ) THEN istart = ibptr + ipt1 - 1 cbull = bull ( istart : lenb ) ELSE bullok = .false. END IF END IF IF ( bullok ) THEN C C* Retrieve the Section 3 descriptors from this EPA C* AIRNOW Ozone or particulate matter BUFR message and C* compare it with the list of expected descriptors. C IF ( ( buhd ( 1:6 ) .eq. 'IUXN10' ) .or. + ( buhd ( 1:6 ) .eq. 'IUXN70' ) .or. + ( buhd ( 1:6 ) .eq. 'IUXV01' ) ) THEN CALL UT_CBS3 ( 2, ibull, cxdescb, NXDESCB, iercs3 ) ELSE IF ( buhd ( 1:6 ) .eq. 'IUXV02' ) THEN CALL UT_CBS3 ( 2, ibull, cxdescc, NXDESCC, iercs3 ) ELSE IF ( buhd ( 1:6 ) .eq. 'IUXV03' ) THEN CALL UT_CBS3 ( 2, ibull, cxdescc, NXDESCC, iercs3 ) CALL PKBS1 ( 32, ibull, 'MSBT' ) ELSE CALL UT_CBS3 ( 2, ibull, cxdesca, NXDESCA, iercs3 ) END IF IF ( iercs3 .ne. 0 ) THEN bullok = .false. logmsg = 'message has unknown format' CALL DC_WLOG ( 2, 'DC', 2, logmsg, ierwlg ) END IF END IF IF ( bullok ) THEN C C* Write the BUFR output to the BUFR output stream. C CALL DBN_BUFR ( mbst, 5, ibull, LMSG ( cbull ( 1:8 ) ), + ierdbf ) C C* Print a count of the length of the BUFR message written. C WRITE ( UNIT = logmsg, FMT = '( A, I6, A )' ) + 'found BUFR message that is ', + IUPBS01 ( ibull, 'LENM' ), ' bytes long' CALL DC_WLOG ( 2, 'DC', 2, logmsg, ierwlg ) END IF END DO C* RETURN END