SUBROUTINE SN_DCOD ( cldt, snowfl, bufrtb, nhours, iret ) C************************************************************************ C* SN_DCOD * C* * C* This routine decodes SNOW data files from FSL into BUFR format. * C* * C* SN_DCOD ( CLDT, SNOWFL, BUFRTB, NHOURS, IRET ) * C* * C* Input parameters: * C* CLDT CHAR* Date-time from command line * C* SNOWFL CHAR* SNOW data file from FSL * 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* 0 = normal return * C* * C** * C* Log: * C* C. Caruso Magee/NCEP 11/04 Modify for SNOW data. * C* M. Weiss/NCEP 08/24 Use new decod_ut library routines, * C* clean up and simplify logic * C************************************************************************ INCLUDE 'GEMPRM.PRM' INCLUDE 'BRIDGE.PRM' INCLUDE 'sncmn.cmn' CHARACTER*(*) cldt, snowfl, bufrtb CHARACTER snowdn*(DCMXLN), snowbn*(DCMXLN), + stnm(MXSTNS)*10, snid(MXSTNS)*8, + crpttm(MXSTNS)*9, cstrtm*9, + qcd(MXSTNS,NVAR)*1, sprvid(MXSTNS)*11, + vcname(NVAR)*7, rimnem(NRIMN)*8, cimnem(NCIMN)*8, + cmsobn*18, cprovdr(MXSTNS)*20 REAL slat ( MXSTNS ), slon ( MXSTNS ), selv (MXSTNS), + obs ( MXSTNS, NVAR ) REAL*8 r8date (5) INTEGER irundt (5), irptdt (5), wmoid (MXSTNS), + iqca ( MXSTNS, NVAR ), iqcr ( MXSTNS, NVAR ) C* The following variable code names define, in accordance C* with the MADIS table files "static/snowtbl.txt" and C* "static/snowvcn.txt", the variables that will be read C* from the SNOW data file. DATA vcname / 'SD ', 'SF6 ', 'SF24 ', 'SWED ', + 'SWE24 ', 'SWE6 ', 'RMK ' / C*---------------------------------------------------------------------- iret = 0 C* Extract the basename from the SNOW data file and write it to C* the decoder log. CALL FL_PATH ( snowfl, snowdn, snowbn, ierpth ) logmsg = 'SNOW filename: ' // snowbn CALL DC_WLOG ( 0, 'DC', 2, logmsg, ierwlg ) C* Save the SNOW data file basename in a separate variable C* for later use. cmsobn = snowbn(1:18) C* The MADIS (Meteorological Assimilation Data Ingest System) C* software from FSL will be used to read the SNOW data file. C* Initialize this software. CALL MINIT ( 'SNOW', 'FSL', .false., ierfin ) IF ( ierfin .ne. 0 ) THEN CALL UT_EMSG ( 0, 'MINIT', ierfin ) RETURN END IF C* Using the SNOW data file basename, C* compute the MADIS date-time. READ ( UNIT = snowbn, FMT = '( I4.4, 2I2.2, 1X, 2I2.2 )', + IOSTAT = ier ) ifyear, ifmnth, ifdays, ifhour, ifminu IF ( ier .ne. 0 ) THEN CALL UT_EMSG ( 0, 'READ', ier ) RETURN END IF CALL MCHRTIM ( ifyear, ifmnth, ifdays, ifhour, ifminu, + cstrtm, ierfct ) IF ( ierfct .ne. 0 ) THEN CALL UT_EMSG ( 0, 'MCHRTIM', ierfct ) RETURN END IF C* Retrieve all of the stations for which there is data in the C* SNOW data file. CALL MSNOWSTA ( cstrtm, nstns, stnm, wmoid, slat, slon, selv, + crpttm, cprovdr, ierfst ) IF ( ierfst .ne. 0 ) THEN IF ( ierfst .eq. 1006 ) THEN logmsg = 'contained no reports' CALL DC_WLOG ( 0, 'DC', 2, logmsg, ierwlg ) ELSE CALL UT_EMSG ( 0, 'MSNOWSTA', ierfst ) END IF RETURN END IF C* Retrieve the subproviders for these stations. CALL MGETSNOWC ( cstrtm, 'SUBPVDR', nstns, sprvid, ierfcc ) IF ( ierfcc .ne. 0 ) THEN CALL UT_EMSG ( 0, 'MGETSNOWC', ierfcc ) RETURN END IF C* Now, retrieve the data for these stations. DO ii = 1, NVAR CALL MGETSNOW ( cstrtm, vcname ( ii ), itmp, nnmsg, + obs ( 1, ii ), qcd ( 1, ii ), + iqca ( 1, ii ), iqcr ( 1, ii ), ierfgs ) IF ( ( ierfgs .ne. 0 ) .and. ( ierfgs .ne. 1006 ) .and. + ( ierfgs .ne. 1005 ) ) THEN CALL UT_EMSG ( 0, 'MGETSNOW', ierfgs ) RETURN END IF END DO C* Set the pointers for the interface arrays. CALL SN_IFSP ( rimnem, cimnem, ierfsp ) IF ( ierfsp .ne. 0 ) RETURN C* Open the BUFR tables file. CALL FL_SOPN ( bufrtb, iunbft, ierspn ) IF ( ierspn .ne. 0 ) THEN CALL DC_WLOG ( 0, 'FL', ierspn, bufrtb, ierwlg ) RETURN END IF C* Open the BUFR output file. CALL FL_GLUN ( iunbfo, iergln ) IF ( iergln .ne. 0 ) THEN CALL DC_WLOG ( 0, 'FL', iergln, ' ', ierwlg ) RETURN END IF C* Connect the BUFR tables and output files to the BUFR interface. CALL OPENBF ( iunbfo, 'NUL', iunbft ) C* Close the BUFR tables file. CALL FL_CLOS ( iunbft, iercls ) IF ( iercls .ne. 0 ) THEN CALL DC_WLOG ( 0, 'FL', iercls, ' ', ierwlg ) END IF C* Get the run date-time. CALL UT_GET_RUNDT ( cldt, irundt, iergrd ) IF ( iergrd .ne. 0 ) RETURN C* Write the number of reports to the decoder log. WRITE ( UNIT = logmsg, FMT = '( A, I6, A )' ) + 'contained ', nstns, ' reports' CALL DC_WLOG ( 0, 'DC', 2, logmsg, ierwlg ) C* Loop on each report. DO ii = 1, nstns C* Start an entry for this report in the decoder log. logmsg = '--------------------' CALL DC_WLOG ( 3, 'DC', 2, logmsg, ierwlg ) C* Initialize the interface values arrays. CALL SN_IFIV ( ierfiv ) C* Compute and store the date-time. CALL MINTTIM ( crpttm ( ii ), ifyear, ifmnth, ifdays, + ifhour, ifminu, ierftm ) IF ( ierftm .ne. 0 ) THEN CALL UT_EMSG ( 2, 'MINTTIM', ierftm ) ELSE rivals ( iryear ) = FLOAT ( 1900 + ifyear ) rivals ( irmnth ) = FLOAT ( ifmnth ) rivals ( irdays ) = FLOAT ( ifdays ) rivals ( irhour ) = FLOAT ( ifhour ) rivals ( irminu ) = FLOAT ( ifminu ) r8date (1) = rivals ( iryear ) r8date (2) = rivals ( irmnth ) r8date (3) = rivals ( irdays ) r8date (4) = rivals ( irhour ) r8date (5) = rivals ( irminu ) END IF C* Station ID. civals ( icsnid ) = stnm ( ii )(1:8) C* Latitude, longitude, and elevation. rivals ( irslat ) = slat ( ii ) rivals ( irslon ) = slon ( ii ) rivals ( irselv ) = selv ( ii ) C* Subprovider ID. civals ( icsprvid ) = sprvid ( ii ) C* Remarks. rivals ( irsrmk ) = UT_MDRI ( obs ( ii, 7 ) ) C* In order, snow depth, snow water equiv., 6 hr snowfall and C* snow water equiv., 24 hr snowfall and snow water equiv. C* (and assoc. qc). CALL UT_MDQI ( ii, 1, obs, qcd, iqca, iqcr, MXSTNS, + rivals ( irtosd ), civals ( ictosdqd ), + rivals ( irtosdqa ), rivals ( irtosdqr ), ierf ) CALL UT_MDQI ( ii, 4, obs, qcd, iqca, iqcr, MXSTNS, + rivals ( irswem ), civals ( icswemqd ), + rivals ( irswemqa ), rivals ( irswemqr ), ierf ) CALL UT_MDQI ( ii, 2, obs, qcd, iqca, iqcr, MXSTNS, + rivals ( irdofs6 ), civals ( icdofs6qd ), + rivals ( irdofs6qa ), rivals ( irdofs6qr ), ierf ) CALL UT_MDQI ( ii, 6, obs, qcd, iqca, iqcr, MXSTNS, + rivals ( irswem6 ), civals ( icswem6qd ), + rivals ( irswem6qa ), rivals ( irswem6qr ), ierf ) CALL UT_MDQI ( ii, 3, obs, qcd, iqca, iqcr, MXSTNS, + rivals ( irdofs24 ), civals ( icdofs24qd ), + rivals ( irdofs24qa ), rivals ( irdofs24qr ), ierf ) CALL UT_MDQI ( ii, 5, obs, qcd, iqca, iqcr, MXSTNS, + rivals ( irswem24 ), civals ( icswem24qd ), + rivals ( irswem24qa ), rivals ( irswem24qr ), ierf ) C* Write the interface output to the decoder log. CALL SN_IFPT ( 3, rimnem, cimnem, ierfpt ) C* Don't create BUFR output for reports that are more than C* NHOURS before or more than 3 hours after the run time. CALL UT_CHECK_BUFRRPTDT ( 2, irundt, r8date(1), + r8date(2), r8date(3), r8date(4), r8date(5), + nhours, 180, irptdt, iercrt ) IF ( iercrt .ne. 0 ) CYCLE C* Convert interface-format data for this report C* into BUFR output and then write the BUFR output C* to the BUFR output stream. CALL SN_BUFR ( iunbfo, irundt, cmsobn, ierbfr ) END DO C* Make sure that all BUFR output has been written before exiting. CALL UT_WBFR ( iunbfo, 'snow', 1, ierwbf ) CALL CLOSBF ( iunbfo ) CALL FL_CLAL ( iercal ) C* RETURN END