SUBROUTINE DB_DCOD ( curtim,bufrtb,nhours,iret ) C************************************************************************ C* DB_DCOD * C* * C* This subroutine reads WMO FM18 drifting buoy bulletins from standard * C* input, decodes the bulletin report data, and creates BUFR output. * C* * C* DB_DCOD ( CURTIM, BUFRTB, NHOURS, IRET ) * C* * C* INPUT PARAMETERS: * C* CURTIM CHAR* Date/time from command line * C* BUFRTB CHAR* BUFR tables file * C* NHOURS INTEGER Max number of hours before run * C* time for creating BUFR output * C* * C* Output parameters: * C* IRET INTEGER Return code * C* 0 = Normal return * C* * C** * C* Log: * C* R. Hollern/NCEP 12/99 Separated out the drifting buoy decoding* C* from the marine surface report decoder * C* DCMSFC to create a new drifting buoy * C* decoder DCDRBU * C* C. Caruso Magee/NCEP 03/2000 Print raw report in main only and modify* C* some s/r calls that used to do this * C* C. Caruso Magee/NCEP 03/2000 Remove ref to rpttim (not used). * C* C. Caruso Magee/NCEP 06/2001 Replace calls to STATUS, WRITSA, and * C* DBN_BUFR with new s/r UT_WBFR. * C* C. Caruso Magee/NCEP 02/2002 Replace orign with cborg. * C* J. Ator/NCEP 08/04 SS_GTIM -> CSS_GTIM * C* C. Caruso Magee/NCEP 01/2006 Set irptdt(1) - report year here, using * C* rivals (irydgt) decoded in dbdst0.f. * C************************************************************************ INCLUDE 'GEMPRM.PRM' INCLUDE 'BRIDGE.PRM' INCLUDE 'dbcmn.cmn' INCLUDE 'dbcmn_bufr.cmn' C* CHARACTER*(*) curtim, bufrtb C* INTEGER istarr(5) C CHARACTER bulltn*(DCMXBF), sysdt*12, dattmp*12, + errstr*80, dburpt*(DCMXBF), + cmdif*8, cdate*8, ctime*4, cdattm*15, + 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 DB_IFSP ( rimnem, cimnem, ier ) IF ( ier .ne. 0 ) THEN CALL DC_WLOG ( 0, 'DCDRBU', -8, ' ', ierr ) RETURN END IF C C* Loop until a timeout occurs. C iperr = 0 ibufr = .false. C DO WHILE ( iperr .eq. 0 ) C C* Get the bulletin. C CALL DC_GBUL( bulltn, lenb, ifdtyp, iperr ) IF ( iperr .eq. 0 ) THEN C C* Parse the header info from the bulletin. C more = .true. CALL DC_GHDR ( bulltn, lenb, seqnum, buhd, cborg, + btime, bbb, nchrd, ierr ) IF ( ierr .ne. 0 ) THEN CALL DC_WLOG ( 2, 'DC', ierr, ' ', ier ) CALL ST_UNPR ( bulltn(:72), 72, errstr, len1, ier ) CALL DC_WLOG ( 2, 'DCDRBU', 2, errstr, ier ) more = .false. END IF ELSE C C* Write out timeout message to the log. C CALL DC_WLOG ( 0, 'DC', iperr, ' ' , ier ) more = .false. 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 CALL TI_CTOI ( dattmp, istarr, ier ) C C* Set receipt time significance to 0. C rctim (1) = 0.0 C C* Save receipt time in dbcmn.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. 60 ) THEN C C* Check that the bulletin contains drifting C* buoy reports. C CALL DB_BTYP ( lenb, bulltn, jpos, jret ) IF ( jret .eq. 0 ) THEN C C* Write bulletin header data to decoder log. C logmsg = seqnum // buhd // cborg // btime // bbb CALL DC_WLOG (2, 'DCDRBU', 2, logmsg(1:36),ier) ELSE more = .false. END IF ELSE C C* Reject bulletins less than 60 characters long. C more = .false. END IF END IF C C* Loop through reports. C DO WHILE ( more ) good = .true. C C* Get next report from bulletin. C CALL DB_GRPT ( lenb, bulltn, jpos, mszrpt, dburpt, jret) C nszrpt = mszrpt C IF ( jret .eq. 2 ) THEN C C* No more reports in bulletin. 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 C CALL UT_WBFR ( iunbfo, 'drbu', 1, ierwbf ) C END IF C more = .false. good = .false. ELSE IF ( jret .ne. 0 ) THEN good = .false. ELSE C C* Write raw report to LOG file. C loglvl = 2 CALL DC_WLOG ( loglvl, ' ', 1, dburpt ( 1:mszrpt ), + ierwlg ) C C* Initialize report parameters to missing. C CALL DB_INIT ( jret ) C C* Check length of groups in report. C igrsz = 10 CALL DB_CKRP ( dburpt, igrsz, mszrpt, kret) C IF ( kret .ne. 0 ) THEN good = .false. ELSE C C* Decode section 0 of ZZYY report. C CALL DB_DST0 ( dburpt, ipt, jret ) IF ( jret .ne. 0 ) THEN good = .false. ELSE C C* Create report year by comparing units digit C* of year read in via dbdst0.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 END IF 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 good = .false. errstr = buhd // cborg // btime CALL DC_WLOG ( 2, 'DCDRBU', 3, errstr, ier ) 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, 'DCDRBU', 4, errstr, ier ) C END IF C IF ( good ) THEN C C* Decode the bulletin report and write the data C* to the output file. C CALL DB_DCD1 ( mszrpt, dburpt, ipt, jret ) C C* Output decoded report. C IF ( jret .eq. 0 ) THEN C C* Output decoded report to interface and LOG file C loglvl = 3 logmsg = '<-----BEGIN INTERFACE OUTPUT----->' CALL DC_WLOG ( loglvl, 'DC', 2, * logmsg (1:50), ierwlg ) C CALL DB_IFPT ( rimnem, cimnem, ierr ) 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 DB_BUFR( bufrtb, last, dburpt, + mszrpt, jret ) ibufr = .true. END IF END IF END IF END DO END DO C C* Close BUFR files C IF ( ibufr ) THEN last = .true. CALL DB_BUFR( bufrtb, last, dburpt, mszrpt, jret ) END IF C* RETURN END