SUBROUTINE WC_DCOD ( curtim, wcanfl, wcantbl, bufrtb, + nhours, iret ) C************************************************************************ C* WC_DCOD * C* * C* This routine reads Canadian Water Level (WL) and River Gauge (RG) * C* reports and process them into BUFR output. * C* * C* WC_DCOD ( CURTIM, WCANFL, WCANTBL, BUFRTB, NHOURS, IRET ) * C* * C* Input parameters: * C* CURTIM CHAR* Current time for input data * C* WCANFL CHAR* Canadian data file, see STEP 3A * C* WCANTBL CHAR* Station table * C* BUFRTB CHAR* BUFR table * 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* M. Weiss/IMSG 10/20 New routine based on gcdcod.f * C* M. Weiss/IMSG 11/20 Added CALL FL_CLOS to release * C* and then be able to re-use the * C* unit number for iunndf. * C* M. Weiss/IMSG 11/20 At 910 return, added IF block * C* to stop superflous [DC -9] log * C* log messages. * C* M.Weiss/AXIOM 5/23 Added 6 RG stations: 5 BC and * C* 1 QC to wcan.tbl * C* M.Weiss/AXIOM 5/23 Added Case statement block to * C* construct RG ingest file names * C* for any Canadian province. * C* (see new STEP 3AA) * C* M.Weiss/AXIOM 5/23 Added IF block to not call * C* FL_SOPN (see STEP 3B) for WL * C* .txt files. These files are no * C* longer accessible from their * C* originating web-site. Also, the * C* "missing file" log messages * C* for WL files are no longer * C* generated. * C************************************************************************ INCLUDE 'GEMPRM.PRM' INCLUDE 'wccmn.cmn' INCLUDE 'BRIDGE.PRM' C C CHARACTER*(*) curtim, wcanfl, wcantbl, bufrtb C CHARACTER report*(MXRECL), + sysdt*12, rundt*12, errstr*100 CHARACTER wcanfltmp*(DCMXLN), + flds(MXFLDS)*16 INTEGER istarr (5), irptdt (5), jrptdt (5) LOGICAL readwl, readrg, rptok INCLUDE 'ERMISS.FNC' C*----------------------------------------------------------------------- iret = 0 ieread = -9 C C C** STEP 1A. OPEN wcan.tbl C** STEP 1B. OPEN bufrtab.001 C** STEP 1C. OPEN BUFR OUTPUT FILE C** STEP 1D. CONNECT BUFR OUTPUT FILE WITH bufrtab.001 C** STEP 1E. SPECIFY BUFR EDITION 4 C** STEP 1F. CLOSE bufrtab.001 Cccccccccccccccccccccccccccccccccccccccccc C C* STEP 1A. Open and read the WCAN station table file. C CALL WC_STOR ( wcantbl, istatot, kret ) C C* STEP 1B. Open the BUFR tables file (bufrtab.001). 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* STEP 1C. 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* STEP 1D. Connect BUFR output files and BUFR table file. C V V CALL OPENBF ( iunbfo, 'NUL', iunbft ) C C* STEP 1E. Specify the use of BUFR edition 4, to be C* utilized within the BUFR output file. C CALL PKVS01 ( 'BEN', 4 ) C C* STEP 1F. Close the BUFR table file. C CALL FL_CLOS ( iunbft, iercls ) IF ( iercls .ne. 0 ) THEN CALL DC_WLOG ( 0, 'FL', iercls, ' ', ierwlg ) END IF C C C** STEP 2A. GET SYSTEM TIME (sysdt) C** STEP 2B. IN DEV/PROD (rundt=sysdt). C** FOR TESTING rundt IS SPECIFIED INLINE C** STEP 2C. CONVERT rundt TO INTEGER (istarr array) Cccccccccccccccccccccccccccccccccccccccccc C C* STEP 2A. 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 ) RETURN END IF C C* STEP 2B. If a date-time was entered on the command line, then use C* it as the run date-time. Otherwise, use the system time C* as the run date-time. C IF ( curtim .eq. 'SYSTEM' ) THEN rundt = sysdt ELSE CALL TI_STAN ( curtim, sysdt, rundt, ierstn ) IF ( ierstn .ne. 0 ) THEN CALL DC_WLOG ( 2, 'TI', ierstn, ' ', ierwlg ) RETURN END IF END IF C C* STEP 2C. Convert the run date-time to integer. C CALL TI_CTOI ( rundt, istarr, iercto ) IF ( iercto .ne. 0 ) THEN CALL DC_WLOG ( 2, 'TI', iercto, ' ', ierwlg ) RETURN END IF C C** STEP 3. PROCESS ALL FILES (ifile) C C** STEP 3A. CONSTRUCT FILE NAME TO PROCESS BASED ON wcan.tbl C** STEP 3B. OPEN THE .txt OR .csv DATA FILE. Cccccccccccccccccccccccccccccccccccccccccc C C ifile = 0 ! all files C C* STEP 3. PROCESS ALL FILES (ifile) C ------- --- ----- ------- DO WHILE ( ifile .le. istatot - 1 ) ! istatot = total number of .txt & .csv stations ifile = ifile + 1 readrg = .false. readwl = .false. rptok = .true. C C* STEP 3A. Cycle through all possible .txt and .csv files via wcan.tbl C* and construct a file name C SELECT CASE( statyp(ifile) ) CASE( "WL" ) ! sample: 10050.txt readwl = .true. CALL ST_RMBL ( wcanfl, wcanfltmp, iwcanlen, kret ) ibpt = INDEX ( wcanfl ( 1:DCMXLN ), 'canadian_water' ) + + 14 jbpt = ibpt + 9 ! = includes "/" CALL ST_LSTR ( stnid(ifile), lenstnid, ilret ) kbpt = INDEX ( stnid(ifile)( 1:lenstnid+1 ), ' ' ) - 1 wcanfltmp(ibpt:jbpt) = "/" // stnid(ifile)(1:kbpt) // + ".txt" CASE( "RG" ) ! sample: ON_02AB006_hourly_hydrometric.csv readrg = .true. C* Removes spaces and tabs from a string CALL ST_RMBL ( wcanfl, wcanfltmp, iwcanlen, kret ) ibpt = INDEX ( wcanfl ( 1:DCMXLN ), 'canadian_water' ) + + 14 jbpt = ibpt + 33 ! = includes "/" C* Returns the number of characters in a string CALL ST_LSTR ( stnid(ifile), lenstnid, ilret ) kbpt = INDEX ( stnid(ifile)( 1:lenstnid+1 ), ' ' ) - 1 C C* STEP 3AA. Construct RG .csv file name based on C* Canadian Province SELECT CASE( stat(ifile) ) CASE( "AB", "BC", "MB", "NB", "NL", "NS", "NT", "NU", + "ON", "PE", "QC", "SK", "YT" ) wcanfltmp(ibpt:jbpt) = "/" // stat(ifile) // "_" // + stnid(ifile)(1:kbpt) // "_hourly_hydrometric.csv" END SELECT END SELECT C C* AB = Alberta BC = British Columbia C* MB = Manitoba NB = New Brunswick C* NL = Newfoundland and Labrador NS = Nova Scotia C* NT = Northwest Territories NU = Nunavut C* ON = Ontario PE = Prince Edward Island C* QC = Quebec SK = Saskatchewan C* YT = Yukon Territory C C* STEP 3B. Open the .txt or .csv data file. C* UPDATE: .txt files no longer being recieved, no need to open C IF ( statyp(ifile) .eq. "RG" ) THEN CALL FL_SOPN ( wcanfltmp, iunndf, ierspn ) IF ( ierspn .ne. 0 ) THEN WRITE ( UNIT = logmsg, FMT='(A,A)' ) + 'Missing file: ', wcanfltmp CALL DC_WLOG ( 2, 'WC', 2, logmsg(1:150), ierwlg ) IF ( ifile .le. istatot ) CYCLE END IF ELSE CYCLE END IF C C C** STEP 4. PROCESS CONTENTS OF INDIVIDUAL FILE C C** STEP 4A. READ RECORDS: DEPENDENT ON readwl/readwg C** STEP 4B. CALL SUBSTR BREAK RECORD INTO SUBSTRINGS C** STEP 4C. CONVERT REPORT TIME TO UTC C** STEP 4D. CHECK FOR REPORTS > 3 HOURS AFTER RUN TIME C** STEP 4E. CONVERT water level FROM CHAR TO REAL C** STEP 4F. WRITE BUFR OUTPUT TO THE BUFR OUTPUT FILE Cccccccccccccccccccccccccccccccccccccccccc C C* STEP 4. Process contents of indivual file. C ------- ------- -------- -- ------- ----- C IF ( readwl .or. readrg ) THEN ! .txt and .csv type files DO WHILE ( .true. ) ! Read all records C C* STEP 4A. Read records (i.e. line)from the "opened" data file. C READ ( UNIT = iunndf, FMT = '(A)', ERR = 900, END = 910 ) + report IF ( readwl .and. report(1:1).ne.'2') CYCLE ! Skip non data report records IF ( readrg .and. report(1:1).ne.'0') CYCLE ! Skip non data report records C C* STEP 4B. Break the record into an array of substrings (i.e. fields) C* and extract the report date time. C* Sample .txt report 2020/09/01;08:00;0.566 C* Sample .csv report 02HD008,2020-09-28T01:00:00-05:00,2.341,,,1,1.18,,,1 C* Generated on a MAC, the first character is a for .csv files. c* a byte order mark indicating endianess. C CALL ST_LSTR ( report, lenr, ilret ) IF ( lenr .gt. MXRECL ) THEN WRITE ( UNIT = logmsg, FMT='(I4)' ) lenr CALL DC_WLOG ( 2, 'WC', 10, logmsg(1:4), ierwlg ) lenr = MXRECL END IF CALL WC_BKST ( report, lenr, ifile, flds, numfld, + irptdt, rptok, iret ) IF ( iret .ne. 0 ) THEN WRITE ( UNIT = logmsg, FMT='(A,I2)' ) + 'more than ', MXFLDS CALL DC_WLOG ( 2, 'WC', 2, logmsg(1:12), ierwlg ) CYCLE END IF C C* STEP 4C. Convert local time to UTC. C IF ( rptok) THEN ! Report time check#1 CALL WC_GMT ( tmzone(ifile), irptdt, jrptdt, iret ) IF ( iret .ne. 0 ) THEN CALL UT_EMSG ( 2, 'WC_GMT', iret ) rptok = .false. ELSE irptdt = jrptdt END IF END IF C IF ( rptok) THEN ! Report time check#2 C C* STEP 4D. Do not create BUFR output for reports that are C* more than NHOURS before or more than 3 hours C* after the run time. C C* NOTE: Only reports < 24 hours older than C* run-time are processed. C IF ( ( ERMISS ( FLOAT ( irptdt(1) ) ) ) .or. + ( ERMISS ( FLOAT ( irptdt(2) ) ) ) .or. + ( ERMISS ( FLOAT ( irptdt(3) ) ) ) .or. + ( ERMISS ( FLOAT ( irptdt(4) ) ) ) .or. + ( ERMISS ( FLOAT ( irptdt(5) ) ) ) ) THEN iertmk = -1 ELSE ! istarr=system time irptdt = report time CALL DC_TMCK ( 4, istarr, irptdt, nhours, + 180, iertmk ) END IF C IF ( iertmk .eq. 0 ) THEN wlevel = RMISSD wdchg = RMISSD C C* STEP 4E. Convert water level (.txt & .csv) from char to real C* and water discharge (.csv only) from char to real C CALL ST_CRNM ( flds(3), wlevel, ierr ) IF ( readrg ) THEN CALL ST_CRNM ( flds(7), wdchg, ierr ) END IF C C* STEP 4F. Write the BUFR output to the BUFR output stream. C CALL WC_BUFR ( iunbfo, ifile, istarr, irptdt, + report, wlevel, wdchg, lenr, ierbfr ) END IF END IF ! IF ( rptok) THEN "Report time check" END DO ! DO WHILE ( .true. ) "read all records" END IF ! IF (readwl) THEN .txt processing 900 ieread = -5 910 IF ( ieread .eq. -5 ) THEN CALL DC_WLOG ( 0, 'DC', ieread, ' ', ierwlg ) ! ieread when okay? END IF C CALL FL_CLOS ( iunndf, ier ) ! Releases unit number iunndf END DO ! DO WHILE ( ifile .le. istatot - 1 ) C C C* Make sure that all BUFR output has been written before exiting. C CALL UT_WBFR ( iunbfo, 'wcan', 1, ierwbf ) C CALL CLOSBF ( iunbfo ) CALL FL_CLAL ( iercal ) C* RETURN END