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