SUBROUTINE MN_DCOD ( cldt, mesofl, bufrtb, nhours, iret ) C************************************************************************ C* MN_DCOD * C* * C* This routine decodes Mesonet data files from MADIS into BUFR format. * C* * C* MN_DCOD ( CLDT, MESOFL, BUFRTB, NHOURS, IRET ) * C* * C* Input parameters: * C* CLDT CHAR* Date-time from command line * C* MESOFL CHAR* Mesonet data file from MADIS * 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* J. Ator/NCEP 06/01 * C* J. Ator/NCEP 06/01 Use 'NUL' in call to OPENBF * C* J. Ator/NCEP 09/01 Modify to use FSL MADIS software * C* J. Ator/NCEP 01/02 Check for ierfst=1006 (no data) * C* J. Ator/NCEP 06/02 Add decode of 3, 6, 12, and 18 hour PCP * C* J. Ator/NCEP 08/02 Don't decode MAP data * C* R. Hollern/NCEP 11/02 Modify to save INTERNET subprovider IDs * C* C. Caruso Magee/NCEP 12/02 Decode AWS data. * C* C. Caruso Magee/NCEP 01/03 Modify to save IEM subprovider IDs * C* C. Caruso Magee/NCEP 03/03 Don't decode DDMET data * C* J. Ator/NCEP 11/03 Pass cmsobn string to mnbufr.f * C* J. Ator/NCEP 08/04 SS_GTIM -> CSS_GTIM * C* C. Caruso Magee/NCEP 08/04 Modify to save LSU-JSU subprovider IDs * C* C. Caruso Magee/NCEP 11/04 Correct indices into vcname for DDGUST * C* and FFGUST from 11, 12 to 15,16. * C* C. Caruso Magee/NCEP 03/05 Correct index into vcname for PCPRATE. * C* Add new vars SOILM and SOILT. Modify * C* how subprovider is accessed and saved. * C* C. Caruso Magee/NCEP 04/05 Add time interval check for AWS data * C* (only decode those AWS reports received * C* within specified time intervals). * C* C. Caruso Magee/NCEP 01/06 Check for ierfgs=1005 (variable not in * C* database). Don't fail if this happens. * C* J. Ator/NCEP 07/06 Use MSETSFCPVDR calls to exclude other * C* MADIS surface datasets from processing * C* J. Ator/NCEP 07/06 Turn on DDMET data (and let it go to * C* the b255/xx030 "Other" tank!) * C* C. Caruso Magee/NCEP 09/06 Add roadway variables. * C* J. Ator/NCEP 01/08 Fix bug in storing of roadway levels. * C* S. Guan/NCEP 11/09 Add function to deal with CRN data * C* J. Ator/NCEP 05/10 Turn on MAP data into b255/xx030 tank * C* J. Ator/NCEP 02/11 Add time interval check for APRSWXNET * C* J. Ator/NCEP 04/12 Add decoding of VIS * C* S. Guan/NCEP 11/14 Add function to deal with urbanet data * C* J. Ator/NCEP 01/19 Modify in response to call sequence * C* change for MSFCSTA in MADIS 4.3 * C* M. Weiss/NCEP 08/23 Use new decod_ut library routines, * C* clean up and simplify logic * C* M. Weiss/NCEP 01/24 Added RWIS4 data processing with SDDOT * C* written to new BUFR tank b255/xx034. * C* Also added timing filter function code * C* mnskipt.f (called in mnbufr.f) to * C* reduce the number of duplicate obs in * C* b255/xx030. This same tank reduction * C* logic is now also applied for duplicate * C* obs reduction of tanks xx015 (AWS) and * C* xx004 (APRSWXNET) in mnbufr.f. * C* M. Weiss/NCEP 02/24 In mnbufr.f, added the timing filter * C* function call to BUFR tank b255/xx003. * C* M. Weiss/NCEP 03/24 Filter out RWIS report types that are * C* not to be decoded into BUFR * C* M. Weiss/NCEP 12/24 Increased MXSTNS from 300000 to 400000 * C* and added a RETURN statement when the * C* MXSTNS limit is exceeded * C************************************************************************ INCLUDE 'GEMPRM.PRM' INCLUDE 'BRIDGE.PRM' INCLUDE 'mncmn.cmn' CHARACTER*(*) cldt, mesofl, bufrtb CHARACTER mesodn*(DCMXLN), mesobn*(DCMXLN), + stid(MXSTNS)*10, sprvid(MXSTNS)*11, + prvid(MXSTNS)*10, crpttm(MXSTNS)*9, + cstrtm*9, qcd(MXSTNS,NVAR)*1, vcname(NVAR)*7, + rimnem(NRIMN)*8, cimnem(NCIMN)*8, + cmsobn*18, mesodn2*(DCMXLN), mesobn2*(9) REAL slat ( MXSTNS ), slon ( MXSTNS ), + selv ( MXSTNS ), obs ( MXSTNS, NVAR ), + rtphr ( MXPCP ), rtpmi ( MXSRD ) REAL*8 GETBMISS, r8date (5) INTEGER irundt (5), irptdt (5), istnm ( MXSTNS ), + isrcn ( MXSTNS ), iqca ( MXSTNS, NVAR ), + iqcr ( MXSTNS, NVAR ), itpcp ( MXPCP ), + idfsrd ( MXSRD ), idrsrd ( MXSRD ) INCLUDE 'ERMISS.FNC' DATA rtphr / 1., 24., 0. / DATA rtpmi / 15., 60., 1440. / C* The following variable code names define, in accordance C* with the MADIS table files "static/sfctbl.txt" and C* "static/sfcvcn.txt", the variables that will be read C* from the Mesonet data file. DATA vcname + / 'TD ', 'ALTSE ', 'P ', 'T ', + 'DD ', 'FF ', 'SOILM ', 'SOILT ', + 'PCP1H ', 'PCP24H ', 'PCPUTCM', 'PCPRATE', + 'DDGUST ', 'FFGUST ', + 'RDT1', 'RDT2', 'RDT3', 'RDT4' , + 'RDLFT1', 'RDLFT2', 'RDLFT3', 'RDLFT4' , + 'RDLIP1', 'RDLIP2', 'RDLIP3', 'RDLIP4' , + 'RDLDP1', 'RDLDP2', 'RDLDP3', 'RDLDP4' , + 'RDSTA1', 'RDSTA2', 'RDSTA3', 'RDSTA4' , + 'FSRD15M', 'FSRD1H ', 'FSRD24H', + 'DSRD15M', 'DSRD1H ', 'DSRD24H', + 'VIS' / C* Indices (into vcname) C* total precipitation variable code names. DATA itpcp / 9, 10, 11 / C* diffuse solar radiation variable code names. DATA idfsrd / 35, 36, 37 / C* direct solar radiation variable code names. DATA idrsrd / 38, 39, 40 / C*----------------------------------------------------------------------- iret = 0 C* Extract the basename from the Mesonet data file and write it to C* the decoder log. CALL FL_PATH ( mesofl, mesodn, mesobn, ierpth ) C* Save the Mesonet data file basename in a separate variable C* for later use. cmsobn = mesobn(1:18) C* Extract the directory just before the basename to figure out C* whether data is Mesonet or Urbanet. CALL FL_PATH ( mesodn, mesodn2, mesobn2, ierpth ) logmsg = mesobn2 // 'filename: ' // mesobn CALL DC_WLOG ( 0, 'DC', 2, logmsg, ierwlg ) C* The MADIS (Meteorological Assimilation Data Ingest System) C* library will be used to read the Mesonet data file. C* Initialize this software. CALL MINIT ( 'SFC', 'FSL', .false., ierfin ) IF ( ierfin .ne. 0 ) THEN CALL UT_EMSG ( 0, 'MINIT', ierfin ) RETURN END IF CALL MSETSFCPVDR ( 'ALL-SFC', .false., ierssp1 ) IF ( ierssp1 .ne. 0 ) THEN CALL UT_EMSG ( 0, 'MSETSFCPVDR', ierssp1 ) RETURN END IF SELECT CASE ( mesobn2(1:3) ) CASE ( 'urb' ) CALL MSETSFCPVDR ( 'UrbaNet', .true., ierssp2 ) CASE ( 'rwi' ) CALL MSETSFCPVDR ( 'ALL-RWIS', .true., ierssp2 ) CASE DEFAULT ! mes (mesonet) CALL MSETSFCPVDR ( 'ALL-MESO', .true., ierssp2 ) END SELECT IF ( ierssp2 .ne. 0 ) THEN CALL UT_EMSG ( 0, 'MSETSFCPVDR', ierssp2 ) RETURN END IF C* Using the Mesonet data file basename, C* compute the MADIS date-time. READ ( UNIT = mesobn, 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* Mesonet data file. CALL MSFCSTA ( cstrtm, nstns, stid, istnm, slat, slon, selv, + crpttm, prvid, ierfst, isrcn ) 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, 'MSFCSTA', ierfst ) END IF RETURN ELSE IF ( nstns .gt. MXSTNS) THEN WRITE ( UNIT = logmsg, FMT = '( A, I6, A )' ) + 'contained ', nstns, ' reports EXCEEDS LIMIT' CALL DC_WLOG ( 0, 'DC', 2, logmsg, ierwlg ) RETURN END IF C* Retrieve the subproviders for these stations. SELECT CASE ( mesobn2(1:3) ) CASE ( 'urb', 'crn', 'rwi' ) logmsg = 'no subprovider id' CALL DC_WLOG ( 0, 'DC', 2, logmsg, ierwlg ) CASE DEFAULT CALL MGETSFCC ( cstrtm, 'SUBPVDR', itmp, sprvid, ierfcc ) IF ( ierfcc .ne. 0 ) THEN CALL UT_EMSG ( 0, 'MGETSFCC', ierfcc ) RETURN END IF END SELECT C* Now, retrieve the rest of the data for these stations. DO ii = 1, NVAR CALL MGETSFC ( 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, 'MGETSFC', ierfgs ) RETURN END IF END DO C* Set the pointers for the interface arrays. CALL MN_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 ) r8bfms = GETBMISS() 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* Filter out RWIS report types that are not to be C* decoded into BUFR. IF ( (mesobn2(1:3) .eq. 'rwi' ) .and. + ( prvid (ii) (1:5) .ne. 'SDDOT') ) CYCLE C* Filter out mesonet report types that are not to be C* decoded into BUFR. IF ( prvid (ii) (1:6) .ne. 'GPSMET' ) THEN 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 MN_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, provider, and subprovider IDs. civals ( icsprvid ) = sprvid ( ii ) civals ( icstid ) = stid ( ii ) civals ( icprvid ) = prvid ( ii ) C* Latitude, longitude, and elevation. rivals ( irslat ) = UT_MDRI ( slat ( ii ) ) rivals ( irslon ) = UT_MDRI ( slon ( ii ) ) rivals ( irselv ) = UT_MDRI ( selv ( ii ) ) C* Soil moisture tension and soil temperature. rivals ( irslmt ) = UT_MDRI ( obs ( ii, 7 ) ) rivals ( irsolt ) = UT_MDRI ( obs ( ii, 8 ) ) C* Wind gust direction and speed. rivals ( irgudr ) = UT_MDRI ( obs ( ii, 13 ) ) rivals ( irgums ) = UT_MDRI ( obs ( ii, 14 ) ) C* Roadway data (up to 4 sensors). nrdw = 0 DO kk = 1, 4 C* Road temperature. rdtm = UT_MDRI ( obs ( ii, 14 + kk ) ) C* Road liquid freeze temperature. rlft = UT_MDRI ( obs ( ii, 18 + kk ) ) C* Road liquid ice percent. rlip = UT_MDRI ( obs ( ii, 22 + kk ) ) C* Road liquid depth. rdld = UT_MDRI ( obs ( ii, 26 + kk ) ) C* Road state. rdst = UT_MDRI ( obs ( ii, 30 + kk ) ) IF ( ( .not. ERMISS ( rdtm ) ) .or. + ( .not. ERMISS ( rlft ) ) .or. + ( .not. ERMISS ( rlip ) ) .or. + ( .not. ERMISS ( rdld ) ) .or. + ( .not. ERMISS ( rdst ) ) ) THEN nrdw = nrdw + 1 rivals ( irrdtm ( nrdw ) ) = rdtm rivals ( irrlft ( nrdw ) ) = rlft rivals ( irrlip ( nrdw ) ) = rlip rivals ( irrdld ( nrdw ) ) = rdld rivals ( irrdst ( nrdw ) ) = rdst END IF END DO rivals ( irnrdw ) = nrdw C* Pressure (and associated QC values). CALL UT_MDQI ( ii, 3, obs, qcd, iqca, iqcr, MXSTNS, + prespa, civals ( icpresqd ), + rivals ( irpresqa ), rivals ( irpresqr ), ierf ) rivals ( irpres ) = PR_D100 ( prespa ) C* Altimeter (and associated QC values). CALL UT_MDQI ( ii, 2, obs, qcd, iqca, iqcr, MXSTNS, + altmpa, civals ( icaltmqd ), + rivals ( iraltmqa ), rivals ( iraltmqr ), ierf ) rivals ( iraltm ) = PR_D100 ( altmpa ) C* Temperature (and associated QC values). CALL UT_MDQI ( ii, 4, obs, qcd, iqca, iqcr, MXSTNS, + rivals ( irtmpk ), civals ( ictmpkqd ), + rivals ( irtmpkqa ), rivals ( irtmpkqr ), ierf ) C* Dewpoint temperature (and associated QC values). CALL UT_MDQI ( ii, 1, obs, qcd, iqca, iqcr, MXSTNS, + rivals ( irdwpk ), civals ( icdwpkqd ), + rivals ( irdwpkqa ), rivals ( irdwpkqr ), ierf ) C* Wind direction (and associated QC values). CALL UT_MDQI ( ii, 5, obs, qcd, iqca, iqcr, MXSTNS, + rivals ( irdrct ), civals ( icdrctqd ), + rivals ( irdrctqa ), rivals ( irdrctqr ), ierf ) C* Wind speed (and associated QC values). CALL UT_MDQI ( ii, 6, obs, qcd, iqca, iqcr, MXSTNS, + rivals ( irsped ), civals ( icspedqd ), + rivals ( irspedqa ), rivals ( irspedqr ), ierf ) C* Precipitation rate (and associated QC values). CALL UT_MDQI ( ii, 12, obs, qcd, iqca, iqcr, MXSTNS, + rivals ( irrpcp ), civals ( icrpcpqd ), + rivals ( irrpcpqa ), rivals ( irrpcpqr ), ierf ) C* Horizontal visibility (and associated QC values). CALL UT_MDQI ( ii, 41, obs, qcd, iqca, iqcr, MXSTNS, + rivals ( irhovi ), civals ( ichoviqd ), + rivals ( irhoviqa ), rivals ( irhoviqr ), ierf ) C* Total precipitation amounts (and associated QC values). rtphr ( MXPCP ) = rivals ( irhour ) kk = 0 DO jj = 1, MXPCP CALL UT_MDQI ( ii, itpcp ( jj ), + obs, qcd, iqca, iqcr, MXSTNS, tpcp, + civals ( ictpcpqd ( kk + 1 ) ), + rivals ( irtpcpqa ( kk + 1 ) ), + rivals ( irtpcpqr ( kk + 1 ) ), ierf ) IF ( .not. ERMISS ( tpcp ) ) THEN rivals ( irtphr ( kk + 1 ) ) = rtphr ( jj ) rivals ( irtpcp ( kk + 1 ) ) = tpcp kk = kk + 1 END IF END DO rivals ( irnpcp ) = kk C* Solar radiation. kk = 0 DO jj = 1, MXSRD dfsrd = UT_MDRI ( obs ( ii, idfsrd ( jj ) ) ) drsrd = UT_MDRI ( obs ( ii, idrsrd ( jj ) ) ) IF ( ( .not. ERMISS ( dfsrd ) ) .or. + ( .not. ERMISS ( drsrd ) ) ) THEN rivals ( irtpmi ( kk + 1 ) ) = rtpmi ( jj ) rivals ( irdfsord ( kk + 1 ) ) = dfsrd rivals ( irdrsord ( kk + 1 ) ) = drsrd kk = kk + 1 END IF END DO rivals ( irnsrd ) = kk C* Write the interface output to the decoder log. CALL MN_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 MN_BUFR ( iunbfo, irundt, cmsobn, ierbfr ) END IF END DO C* Make sure that all BUFR output has been written before exiting. CALL UT_WBFR ( iunbfo, 'mesonet', 1, ierwbf ) CALL CLOSBF ( iunbfo ) CALL FL_CLAL ( iercal ) RETURN END