SUBROUTINE BT_DCOD ( curtim, bufrtb, nhours, iret )
C************************************************************************
C* BT_DCOD *
C* *
C* This subroutine will read bathy, tesac, or trackob bulletins from *
C* from standard input, decode the bulletin report data, and create *
C* BUFR output. *
C* *
C* BT_DCOD ( CURTIM, BUFRTB, NHOURS, IRET ) *
C* *
C* INPUT PARAMETERS: *
C* *
C* CURTIM CHAR* Date/time from command line *
C* BUFRTB CHAR* BUFR table file *
C* NHOURS INTEGER Max number of hours before run *
C* time for creating BUFR output *
C* *
C* Output parameters: *
C* *
C* IRET INTEGER Return code *
C* 0 = Normal return *
C* *
C** *
C* Log: *
C* R. Hollern/NCEP 11/98 *
C* R. Hollern/NCEP 1/99 Added code to decode TESAC reports and *
C* added interface mnemonics to call *
C* sequences *
C* R. Hollern/NCEP 1/99 Increased istrp array size to be able to*
C* decode up to 100 reports per bulletin. *
C* Changed the value of nhours to be able *
C* to decode reports up to 180 days old. *
C* R. Hollern/NCEP 3/99 Added code to decode TRACKOB reports *
C* R. Hollern/NCEP 4/00 Modified irptyp logic *
C* R. Hollern/NCEP 8/00 Modified the routine to make it conform *
C* to the NWS/IWT decoders standards. *
C* C. Caruso Magee/NCEP 06/01 Replace calls to STATUS, WRITSA, and *
C* DBN_BUFR with new s/r UT_WBFR. *
C* J. Ator/NCEP 01/02 Remove iuwind initialization *
C* C. Caruso Magee/NCEP 02/02 Rename orign to cborg; BT_BUFA to *
C* BT_BUFR; replace btbufr.cmn with *
C* btcmn_bufr.cmn; rename lunbfr to iunbfo.*
C* C. Caruso Magee/NCEP 01/03 Increased istrp array size to be able to*
C* decode up to 540 reports per bulletin *
C* (roughly the number of obs in a trackob *
C* report for a ship that took obs every 4 *
C* min. for a day and a half). Note: 540 *
C* is set equal to MXRPT by a PARAMETER *
C* statement in btcmn.cmn. *
C* R. Hollern/NCEP 03/04 Increased istgrp array size from 300 to *
C* 1100. Increased MXDLYR from 255 to 1000.*
C* Can now create BUFR messages up to *
C* 20000 bytes. *
C* J. Ator/NCEP 08/04 SS_GTIM -> CSS_GTIM *
C* C. Caruso Magee/NCEP 01/06 Set irptdt(1) - report year here, using *
C* rivals (irydgt) decoded in btobst.f. *
C* J. Ator/NCEP 02/06 Clean up *
C* J. Ator/NCEP 11/12 Increase istgrp size from 1100 to 3000 *
C************************************************************************
INCLUDE 'GEMPRM.PRM'
INCLUDE 'BRIDGE.PRM'
INCLUDE 'btcmn.cmn'
INCLUDE 'btcmn_bufr.cmn'
C*
CHARACTER*(*) curtim, bufrtb
C*
INTEGER istarr(5), istrp(5,MXRPT), istgrp(3000)
C*
CHARACTER bulltn*(DCMXBF), sysdt*12, dattmp*12,
+ errstr*80, report*(DCMXBF),
+ cmdif*8, cdate*8, ctime*4, cdattm*15,
+ logrpt*55, rimnem(NRIMN)*8, cimnem(NCIMN)*8
C*
LOGICAL more, good, ibufr, last
C*
DATA last / .false. /
C-----------------------------------------------------------------------
iret = 0
C
C* Set the pointers for the interface arrays.
C
CALL BT_IFSP ( rimnem, cimnem, ier )
IF ( ier .ne. 0 ) THEN
CALL DC_WLOG ( 0, 'DCBTHY', -8, ' ', ierwlg )
RETURN
END IF
C
C* Loop until a timeout occurs.
C
ibufr = .false.
C
DO WHILE ( .true. )
C
C* Get the next bulletin.
C
CALL DC_GBUL( bulltn, lenb, ifdtyp, iperr )
C
IF ( iperr .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', iperr, ' ' , ierwlg )
C
C* Close BUFR files.
C
IF ( ibufr ) THEN
last = .true.
CALL BT_BUFR( bufrtb, last, report, mszrpt, ierr3)
END IF
C
RETURN
END IF
C
more = .true.
C
IF ( ifdtyp .eq. 0 ) THEN
C
C* Parse the header information from the bulletin.
C
CALL DC_GHDR ( bulltn, lenb, seqnum, buhd, cborg,
+ btime, bbb, nchrd, ierr )
IF ( ierr .ne. 0 ) THEN
CALL DC_WLOG ( 2, 'DC', ierr, ' ', ierwlg )
CALL ST_UNPR ( bulltn(:72), 72, errstr, len1, ier )
CALL DC_WLOG ( 2, 'DCBTHY', 2, errstr, ierwlg )
more = .false.
END IF
END IF
C
IF ( more ) THEN
C
C* Get the system time and make a standard GEMPAK time
C* from the "current" time.
C
itype = 1
CALL CSS_GTIM ( itype, sysdt, ier )
IF ( curtim .eq. 'SYSTEM' ) THEN
dattmp = sysdt
ELSE
CALL TI_STAN ( curtim, sysdt, dattmp, ier )
END IF
C
CALL TI_CTOI ( dattmp, istarr, ier )
C
C* Set receipt time significance to 0.
C
rctim (1) = 0.0
C
C* Save receipt time and pass via btcmn.cmn.
C
DO i = 1, 5
rctim ( i+1 ) = FLOAT ( istarr ( i ) )
END DO
C
C* Remove control characters from bulletin.
C
CALL ST_UNPR ( bulltn, lenb, bulltn, lennew, ier )
lenb = lennew
C
IF ( lenb .ge. 40 ) THEN
C
C* Write bulletin header data to decoder log.
C
logmsg = seqnum // buhd // cborg // btime // bbb
CALL DC_WLOG (2, 'BT', 1, logmsg(1:36),ierwlg)
ELSE
C
C* Reject bulletins less than 60 characters long.
C
more = .false.
END IF
END IF
C
C* Check if this bulletin contains TRACKOB reports and that
C* they are correctly formatted for the decoding routines.
C
CALL BT_BLNX ( report, lenb, bulltn, ier )
IF ( ier .ne. 0 ) THEN
more = .false.
END IF
C
C* Get the report types and their starting locations
C* in bulltin.
C
IF ( more ) THEN
CALL BT_RPTY ( lenb, bulltn, numrpt, istrp, iret )
ELSE
numrpt = 0
END IF
C
C* Loop through reports.
C
DO jrpt = 1, numrpt
C
good = .true.
irptyp = 0
C
C* Initialize report interface variables to missing.
C
CALL BT_IFIV ( kret )
C
C* Get next report from bulletin.
C
CALL BT_GRPT ( lenb, bulltn, jrpt, istrp, mszrpt,
+ report, ngrps, istgrp, jret)
C
IF ( jret .ne. 0 ) THEN
good = .false.
ELSE
C
C* Write raw report to LOG file.
C
loglvl = 2
mm = istrp(3,jrpt)
mmm = MIN ( mm+49, lenb )
IF ( mm .gt. 0 ) THEN
isz = mmm - mm + 1
logrpt(1:isz) = bulltn(mm:mmm)
CALL DC_WLOG ( loglvl, 'BT', 1,
+ logrpt (1:isz), ierwlg )
END IF
C*
IF ( irptyp .eq. 1 .or. irptyp .eq. 4 ) THEN
C
C* Decode bathy report.
C
CALL BT_BSEC ( mszrpt, report, ierr1 )
IF ( ierr1 .ne. 0 ) THEN
good = .false.
ELSE
C
C* Create report year by comparing units digit
C* of year read in via btobst.f to receipt year.
C
iyrdif = NINT ( rivals ( irydgt ) ) -
* MOD ( NINT ( rctim (2) ), 10 )
IF ( iyrdif .gt. 1 ) THEN
irptdt (1) = rctim (2) - 10 + iyrdif
ELSE IF ( iyrdif .eq. -9 ) THEN
irptdt (1) = rctim (2) + 10 + iyrdif
ELSE
irptdt (1) = rctim (2) + iyrdif
END IF
END IF
ELSE IF ( irptyp .eq. 2 .or. irptyp .eq. 5 ) THEN
C
C* Decode tesac report.
C
CALL BT_TSEC ( mszrpt, report, ierr1 )
IF ( ierr1 .ne. 0 ) THEN
good = .false.
ELSE
C
C* Create report year by comparing units digit
C* of year read in via btobst.f to receipt year.
C
iyrdif = NINT ( rivals ( irydgt ) ) -
* MOD ( NINT ( rctim (2) ), 10 )
IF ( iyrdif .gt. 1 ) THEN
irptdt (1) = rctim (2) - 10 + iyrdif
ELSE IF ( iyrdif .eq. -9 ) THEN
irptdt (1) = rctim (2) + 10 + iyrdif
ELSE
irptdt (1) = rctim (2) + iyrdif
END IF
END IF
ELSE IF ( irptyp .eq. 3 ) THEN
C
C* Decode trackob report.
C
CALL BT_KSEC ( mszrpt, report, ngrps, istgrp,
+ ierr1 )
IF ( ierr1 .ne. 0 ) THEN
good = .false.
ELSE
C
C* Create report year by comparing units digit
C* of year read in via btobst.f to receipt year.
C
iyrdif = NINT ( rivals ( irydgt ) ) -
* MOD ( NINT ( rctim (2) ), 10 )
IF ( iyrdif .gt. 1 ) THEN
irptdt (1) = rctim (2) - 10 + iyrdif
ELSE IF ( iyrdif .eq. -9 ) THEN
irptdt (1) = rctim (2) + 10 + iyrdif
ELSE
irptdt (1) = rctim (2) + iyrdif
END IF
END IF
ELSE
good = .false.
END IF
C
END IF
C
IF ( good ) THEN
C
C* Compute difference between observation
C* and system times.
C
CALL TI_MDIF ( irptdt, istarr, imdif, ier1)
C
C* Check that the time is within NHOURS before the
C* system time.
C
C* Report time for BUFR must not be more than nhours
C* before the system time, and not more than
C* 60 minutes after.
C
IF ( ( ier1 .ne. 0 ) .or. ( imdif .gt. 60 ) .or.
+ ( imdif .lt. -60 * nhours ) ) THEN
C
good = .false.
errstr = buhd // cborg // btime
CALL DC_WLOG ( 2, 'DCBTHY', 3, errstr, ierwlg )
CALL ST_INCH ( imdif, cmdif, ier )
idate = irptdt(1) * 10000 + irptdt(2) * 100 +
+ irptdt(3)
itime = irptdt(4)*100 + irptdt(5)
CALL ST_INCH ( idate, cdate, ier )
CALL ST_INCH ( itime, ctime, ier )
cdattm = cdate(3:) // '/' // ctime
errstr = cdattm // dattmp // cmdif
CALL DC_WLOG ( 2, 'DCBTHY', 4, errstr, ierwlg )
C
END IF
C
IF ( good ) THEN
C
C* Output decoded report to LOG file
C
loglvl = 3
logmsg ='<-----BEGIN INTERFACE OUTPUT----->'
CALL DC_WLOG ( loglvl, 'DC', 2,
+ logmsg (1:50), ierwlg )
C
C* Print the raw report.
C
CALL DC_WLOG ( loglvl, 'DC', 2,
+ 'RAW REPORT:', ierwlg )
CALL DC_WLOG ( loglvl, ' ',1, report(1:mszrpt),
+ ierwlg )
C
CALL BT_IFPT ( rimnem, cimnem, ierr2 )
C
logmsg = '<-----END INTERFACE OUTPUT----->'
CALL DC_WLOG ( loglvl, 'DC', 2,
+ logmsg (1:50), ierwlg )
C
C* Convert current report data to BUFR format.
C
CALL BT_BUFR( bufrtb, last, report, mszrpt,
+ ierr2 )
ibufr = .true.
END IF
END IF
C
END DO
C
C* Make sure that all BUFR output for this bulletin
C* has been written out before going back to DC_GBUL
C* and waiting for a new bulletin on the input pipe.
C
IF ( ibufr ) THEN
CALL UT_WBFR ( iunbfo, 'bathy', 1, ierwbf )
END IF
C
END DO
C*
RETURN
END