SUBROUTINE NX_DCOD ( cldt, stntbl, bufrtb, nhours, iret ) C************************************************************************ C* NX_DCOD * C* * C* This routine decodes NeXRaD RCM bulletins into BUFR format. * C* * C* NX_DCOD ( CLDT, BUFRTB, NHOURS, IRET ) * C* * C* Input parameters: * C* CLDT CHAR* Date-time from command line * C* STNTBL CHAR* NEXRAD station table * 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* * C** * C* Log: * C* D. Kidwell/NCEP 6/96 * C* D. Kidwell/NCEP 1/97 Improved log messages * C* J. Ator/NCEP 4/98 New interface format, style changes * C* R. Hollern/NCEP 1/99 Move init. of mbstr, lmbstr into code, * C* added intf mnemonics to call sequences * C* C. Caruso Magee/NCEP 5/00 Add code to read in NEXRAD stn. table. * C* J. Ator/NCEP 6/00 Delete call to ST_UNPR * C* J. Ator/NCEP 6/01 Use UT_WBFR, use 'NUL' in call to OPENBF* C* J. Ator/NCEP 08/04 SS_GTIM -> CSS_GTIM * C************************************************************************ INCLUDE 'GEMPRM.PRM' INCLUDE 'BRIDGE.PRM' INCLUDE 'nxcmn.cmn' C* CHARACTER*(*) cldt, bufrtb, stntbl C* CHARACTER bull*(DCMXBF), + rawptb*(DCMXBF), rawslc*30, + seqnum*8, buhd*8, cborg*8, bulldt*8, bbb*8, + sysdt*12, rundt*12, + rimnem ( NRIMN )*8, cimnem ( NCIMN )*8 C* INTEGER irundt (5), iptbdt (5) C* LOGICAL bullok C----------------------------------------------------------------------- iret = 0 C C* Set the pointers for the interface arrays. C CALL NX_IFSP ( rimnem, cimnem, ierfsp ) IF ( ierfsp .ne. 0 ) THEN RETURN END IF C C* Open the station table file. C CALL FL_TBOP ( stntbl, 'stns', lunstb, ier ) IF ( ier .ne. 0 ) THEN CALL DC_WLOG ( 0, 'FL', ier, stntbl, ierr ) RETURN END IF C C* Read the NEXRAD station table data, which contains lat/long C* and elevation data for NEXRAD stations. C CALL NX_STBL ( lunstb, kret ) IF ( kret .ne. 0 ) THEN logmsg = 'could not read NEXRAD stations table' CALL DC_WLOG ( 2, 'NX', -1, logmsg, ierwlg ) RETURN END IF 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 file. C CALL FL_GLUN ( iunbfo, 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 C* BUFR interface. C CALL OPENBF ( iunbfo, '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 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 ) CALL CLOSBF ( iunbfo ) CALL FL_CLAL ( iercal ) RETURN END IF bullok = .true. C C* Decode the header information from the 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. 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 itype = 1 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 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* Initialize the interface arrays. C CALL NX_IFIV ( ierifi ) C C* Start an entry for this bulletin in the decoder log. C logmsg = '####################' // + '####################' CALL DC_WLOG ( 2, 'NX', 1, logmsg, ierwlg ) logmsg = seqnum // buhd // cborg // bulldt // bbb CALL DC_WLOG ( 2, 'NX', 1, logmsg, ierwlg ) C C* Locate, decode, and store the station location C* information from within this bulletin. C CALL NX_SLOC ( bull, lenb, ibptr, rawslc, lenslc, + ierslc ) IF ( lenslc .gt. 0 ) THEN C C* Write the raw station location information to the C* decoder log. C CALL DC_WLOG ( 2, ' ', 1, rawslc (1:lenslc), ier ) END IF IF ( ierslc .lt. 0 ) THEN bullok = .false. END IF END IF IF ( bullok ) THEN C C* Locate, decode, and store the part B data from C* within this bulletin. C CALL NX_PRTB ( bull, lenb, ibptr, rawptb, lenptb, + iptbdt, ierptb ) IF ( lenptb .gt. 0 ) THEN C C* Write the raw part B data to the decoder log. C CALL DC_WLOG ( 2, ' ', 1, rawptb (1:lenptb), ier ) END IF IF ( ierptb .ne. 0 ) THEN bullok = .false. END IF END IF IF ( bullok ) THEN C C* Do not create BUFR output for bulletins that are valid C* more than NHOURS before or more than 3 hours after the C* run time. C CALL DC_TMCK ( 2, irundt, iptbdt, nhours, 180, iertmk ) IF ( iertmk .ne. 0 ) THEN bullok = .false. END IF END IF IF ( bullok ) THEN C C* Write data for this bulletin to the decoder log. C CALL NX_IFPT ( rimnem, cimnem, ierfpt ) C C* Convert data for this bulletin to BUFR format and then C* write it to the BUFR output file. C CALL NX_BUFR ( iunbfo, irundt, iptbdt, + seqnum, buhd, cborg, bulldt, bbb, + rawslc, lenslc, rawptb, lenptb, ierbfr ) C C* Make sure all BUFR output for this bulletin C* has been written out before going back to C* DC_GBUL and waiting for a new bulletin on C* the input pipe. C CALL UT_WBFR ( iunbfo, 'nxrdwind', 1, ierwbf ) END IF END DO C* RETURN END