SUBROUTINE SF_DCOD ( cldt, shefpm, sheftb,
+ bufrt000, bufrt001, bufrt255,
+ pestr, npe, nhours, iret )
C************************************************************************
C* SF_DCOD *
C* *
C* This routine reads SHEF bulletins from the LDM and decodes them into *
C* BUFR format. *
C* *
C* SF_DCOD ( CLDT, SHEFPM, SHEFTB, *
C* BUFRT000, BUFRT001, BUFRT255, *
C* PESTR, NPE, NHOURS, IRET ) *
C* *
C* Input parameters: *
C* CLDT CHAR* Date-time from command line *
C* SHEFPM CHAR* SHEFPARM parameter file *
C* SHEFTB CHAR* SHEF station table *
C* BUFRT000 CHAR* BUFR tables file for type 000 *
C* BUFRT001 CHAR* BUFR tables file for type 001 *
C* BUFRT255 CHAR* BUFR tables file for type 255 *
C* PESTR CHAR* String of PE codes for which to *
C* create ASCII output *
C* NPE INTEGER Number of PE codes in PESTR *
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 04/05 *
C* J. Ator/NCEP 10/06 Added PE codes to argument list *
C* J. Ator/NCEP 11/09 Specify BUFR edition 4 for output *
C* J. Ator/NCEP 12/09 Add input of multiple BUFR tables *
C* J. Ator/NCEP 03/19 Add an output BUFR file for afospcp *
C* J. Ator/NCEP 11/21 Skip bulletins containing XML formatting*
C************************************************************************
INCLUDE 'GEMPRM.PRM'
INCLUDE 'BRIDGE.PRM'
INCLUDE 'sfcmn.cmn'
INCLUDE 'sfcmn_pe.cmn'
C*
CHARACTER rundt*12, sysdt*12, cdmyfl*15, peymd*6,
+ pedir*132, pefil*132, pefilst*3,
+ bufrtf(NBUFRO-1)*(DCMXLN)
C*
CHARACTER*(*) cldt, shefpm, sheftb, pestr,
+ bufrt000, bufrt001, bufrt255
C*
INTEGER irptdt (5), iundmy (3)
C*
LOGICAL bullok, exists
C*
REAL*8 GETBMISS
C*
DATA itype / 1 /
C------------------------------------------------------------------------
iret = 0
C
bufrtf(1) = bufrt000
bufrtf(2) = bufrt001
bufrtf(3) = bufrt255
C
r8bfms = GETBMISS()
C
C* Open the SHEFPARM parameter file.
C
CALL FL_SOPN ( shefpm, iunshp, ierspn )
IF ( ierspn .ne. 0 ) THEN
CALL DC_WLOG ( 0, 'FL', ierspn, shefpm, ierwlg )
RETURN
END IF
C
C* Open and read the SHEF station table.
C
CALL SF_STOR ( sheftb, iersto )
IF ( iersto .ne. 0 ) THEN
RETURN
END IF
C
C* Initialize COMMON / PECODES /
C
IF ( npe .gt. MXPECOD ) THEN
WRITE ( UNIT = logmsg, FMT = '( A, I2, 2A, I2, A )' )
+ 'There were ', npe, ' PE codes on the command line,',
+ ' but only the first ', MXPECOD, ' were processed.'
CALL DC_WLOG ( 2, 'DC', 2, logmsg, ierwlg )
npecod = MXPECOD
ELSE
npecod = npe
END IF
C
C* Were there any PE codes on the command line?
C
IF ( npecod .gt. 0 ) THEN
C
C* Copy the PE codes into COMMON / PECODES /
C
DO ii = 1, npecod
pecod (ii) = pestr((2*ii-1):(2*ii))
END DO
C
C* Open the ASCII output file for the PE codes.
C
CALL CSS_GTIM ( itype, sysdt, iergtm )
IF ( iergtm .ne. 0 ) THEN
CALL DC_WLOG ( 0, 'SS', iergtm, ' ', ierwlg )
RETURN
END IF
peymd = sysdt(1:6)
C
CALL SS_ENVR ( '$PEDIR', pedir, ierenv )
CALL ST_LSTR ( pedir, lped, ierstr )
IF ( ( ierenv .ne. 0 ) .or. ( lped .eq. 0 ) ) THEN
logmsg = 'Environment variable $PEDIR is undefined'
CALL DC_WLOG ( 0, 'DC', 2, logmsg, ierwlg )
RETURN
END IF
pefil = pedir(1:lped) // '20' // peymd // '.pe'
C
CALL FL_GLUN ( iunpef, iergln )
IF ( iergln .ne. 0 ) THEN
CALL DC_WLOG ( 0, 'FL', iergln, ' ', ierwlg )
RETURN
END IF
OPEN ( UNIT = iunpef, FILE = pefil,
+ STATUS = 'UNKNOWN', POSITION = 'APPEND' )
END IF
C
C* Open dummy files for use by the OH SHEFLIB parsing software.
C
cdmyfl = '.dummy/dcshef_'
DO ii = 1, 3
WRITE ( UNIT = cdmyfl(15:15), FMT = '(I1.1)') ii
CALL FL_SWOP ( cdmyfl, iundmy (ii), iergln )
IF ( iergln .ne. 0 ) THEN
CALL DC_WLOG ( 0, 'FL', iergln, cdmyfl, ierwlg )
RETURN
END IF
END DO
C
C* Initialize some variables for use by subroutine SF_DFHR.
C
CALL CLO_INIT ( iercit )
IF ( iercit .ne. 0 ) THEN
CALL UT_EMSG ( 2, 'CLO_INIT', iercit )
RETURN
END IF
CALL SF_CLIN
C
DO ii = 1, (NBUFRO-1)
C
C* Open the BUFR tables file.
C
CALL FL_SOPN ( bufrtf (ii), iunbft, ierspn )
IF ( ierspn .ne. 0 ) THEN
CALL DC_WLOG ( 0, 'FL', ierspn, bufrtf (ii), ierwlg )
RETURN
END IF
C
C* Open the BUFR output file.
C
CALL FL_GLUN ( ibufro (ii), iergln )
IF ( iergln .ne. 0 ) THEN
CALL DC_WLOG ( 0, 'FL', iergln, ' ', ierwlg )
RETURN
END IF
C
C* Connect the BUFR tables file to the BUFR output file.
C
CALL OPENBF ( ibufro (ii), '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
END DO
C
C* Open the afospcp BUFR output file using the same BUFR table
C* information used for ibufro(1) (i.e. bufrt000)
C
CALL FL_GLUN ( ibufro (NBUFRO), iergln )
IF ( iergln .ne. 0 ) THEN
CALL DC_WLOG ( 0, 'FL', iergln, ' ', ierwlg )
RETURN
END IF
CALL OPENBF ( ibufro (NBUFRO), 'NUL', ibufro (1) )
C
C* Specify the use of BUFR edition 4, since Table C operator 2-07
C* is being utilized within the BUFR tables files.
C
CALL PKVS01 ( 'BEN', 4 )
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 )
CLOSE ( iunpef )
DO ii = 1, NBUFRO
CALL CLOSBF ( ibufro (ii) )
END DO
CALL FL_CLAL ( iercal )
RETURN
END IF
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 IF ( INDEX ( bull ( ibptr : lenb ),
+ '<?xml version=' ) .ne. 0 ) THEN
logmsg = 'Skipping bulletin ' // buhd // cborg //
+ bulldt // 'which contains XML formatting'
CALL DC_WLOG ( 2, 'DC', 2, logmsg, ierwlg )
bullok = .false.
ELSE
C
C* Initialize some values for processing of this
C* bulletin by the OH SHEFLIB parsing software.
C
CALL SF_IFIV ( ierifi )
ibptr = 1
bullok = .true.
END IF
ELSE
C
C* Do not decode AFOS products.
C
bullok = .false.
END IF
IF ( bullok ) THEN
C
C* Get the system time.
C
CALL CSS_GTIM ( itype, sysdt, iergtm )
IF ( iergtm .ne. 0 ) THEN
CALL DC_WLOG ( 2, 'SS', iergtm, ' ', ierwlg )
bullok = .false.
END IF
END IF
IF ( bullok ) THEN
IF ( ( npecod .gt. 0 ) .and.
+ ( sysdt(1:6) .ne. peymd ) ) THEN
C
C* Start a new PE output file.
C
CLOSE ( iunpef )
peymd = sysdt(1:6)
pefil( lped+3 : lped+8 ) = peymd
OPEN ( UNIT = iunpef, FILE = pefil,
+ STATUS = 'UNKNOWN', POSITION = 'APPEND' )
END IF
C
C* If a date-time was entered on the command line, then
C* use it as the run date-time. Otherwise, use the
C* system time as the run 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 )
bullok = .false.
END IF
END IF
END IF
IF ( bullok ) THEN
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 )
bullok = .false.
END IF
END IF
IF ( bullok ) THEN
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 )
C
C* Is this an AFOS precipitation bulletin?
C
CALL SF_APCP
C
C* Call the OH SHEFLIB parsing software.
C
CALL SHDRIV ( iundmy (1), iundmy (2), iunshp,
+ iundmy (3), iundmy (3) )
C
C* Make sure that any remaining data in the interface
C* arrays has been converted into BUFR and written out
C* before going back to DC_GBUL and waiting for a new
C* bulletin on the input pipe.
C
IF ( nimn .gt. 8 ) THEN
CALL SF_IFPT ( 3, ierifp )
CALL SF_BUFR ( ierbfr )
END IF
DO ii = 1, NBUFRO
CALL UT_WBFR ( ibufro (ii), 'shef', 1, ierwbf )
END DO
END IF
C
END DO
C*
RETURN
END