C$$$  MAIN PROGRAM DOCUMENTATION BLOCK
C
C MAIN PROGRAM: BUFR_LISTDUMPS
C   PRGMMR: DONG             ORG: NP22        DATE: 2020-08-20
C
C ABSTRACT: LISTS CONTENTS OF A TIME-WINDOWED BUFR DATA DUMP FILE.
C   THE STANDARD OUTPUT IS IN AN EASY-TO-READ FORMAT.  NOTE: THIS
C   PROGRAM CAN HANDLE EVERY CURRENT BUFR DATA DUMP FILE EXCEPT
C   FOR RTOVS AND ATOVS.  THE ADPUPA DUMP IS SORTED IN ASCENDING
C   ORDER OF STATION ID.   ALL OTHER DATA TYPES ARE CURRENTLY NOT
C   SORTED.
C
C PROGRAM HISTORY LOG:
C 2000-03-28  D.A. KEYSER -- ORIGINAL AUTHOR
C 2000-06-07  D.A. KEYSER -- ADDED SORTING OF ADPUPA DATA IN ASCENDING
C     ORDER OF STATION ID; USER CAN NOW SPECIFY LAT/LON BOUNDARY FOR
C     LISTING "UPPER-AIR" (ADPUPA, AIRCAR, AIRCFT, SATWND, SPSSMI)
C     REPORTS; CAN NOW LIST SSM/I RAIN RATE REPORTS IN EASY-TO-READ
C     FORMAT; IMPROVED FORMAT FOR LISTING SATWND REPORTS
C 2000-09-22  D.A. KEYSER -- ACCOUNTS FOR WIND PROFILER RAINFALL RATE
C     NOW RETURNED IN PROPER UNITS BY W3UNPKB7; CAN NOW LIST QUIKSCAT
C     SCATTEROMETER WIND REPORTS IN AN EASY-TO-READ FORMAT
C 2000-12-05  D.A. KEYSER -- ACCOUNTS FOR A CHANGE IN CAT. 6 MOISTURE
C     VARIABLE, NOW SPECIFIC HUMIDITY (FLOATING POINT) IN G/KG RATHER
C     THAN DEWPOINT DEPRESSION IN X10 DEG. C
C 2001-04-06  D.A. KEYSER -- CAN NOW LIST SSM/I SURFACE TEMPERATURE
C     REPORTS IN EASY-TO-READ FORMAT; UNITS FOR INPUT SSM/I RAIN
C     RATE CHANGED FROM MM/HR TO MM/SEC (PRECISE TO 10**6) TO ACCOUNT
C     FOR CHANGE IN IW3UNPBF (STILL LISTED IN UNITS OF MM/HR); UNITS
C     FOR INPUT SSM/I WIND SPEED, PWATER AND SFC. TEMP. CHANGED FROM
C     M/S*10, MM*10, K*100, RESP. TO M/S, MM, K WITH FLOATING POINT
C     PRECISON TO 10**1, 10**1, 10**2, RESP. TO ACCOUNT FOR CHANGE IN
C     IW3UNPBF; MEAN AND STD. DEV FOR SSM/I PRODUCTS NOW LISTED TO
C     NEAREST HUNDREDTH UNIT (WAS NEAREST TENTH); CAN NOW PROCESS A
C     WIND PROFILER DATA DUMP FILE CONTAINING BOTH TYPES 002/007
C     (NOAA/FSL) AND 002/009 {THOSE ORIGINATING FROM PILOT (PIBAL)
C     BULLETINS}; UNITS FOR INPUT GOES BRIGHT. TEMPS, LI, PWATER
C     (TOTAL AND LAYERS), SKIN TEMP, ZENITH ANGLE (SOLAR AND
C     SATELLITE), CLOUD TOP TEMP AND CLOUD TOP PRESSURE CHANGED FROM
C     K*100, K*100, MM*100, K*100, DEG*100, K*100, MB*10, RESP. TO K,
C     K, MM, K, DEG, K, MB WITH FLOATING POINT PRECISION TO 10**2,
C     10**2, 10**2, 10**2, 10**2, 10**2, 10**1, RESP. TO ACCOUNT FOR
C     CHANGE IN W3UNPKB7; ACCOUNTS FOR CHANGE IN W3UNPKB7 WHICH
C     RETURNS FULL DATE (YYYYMMDDHH) IN HEADER WORD 5 (WIND PROFILER,
C     VAD WIND AND GOES RADIANCE/SOUNDING/RETREIVAL REPORTS) AND
C     SATELLITE ID IN HEADER WORD 6 (GOES RADIANCE/SOUNDING/RETREIVAL
C     ERS SCATTEROMETER AND QUIKSCAT SCATTEROMETER REPORTS), INCLUDES
C     SATELLITE ID IN LISTING FOR VALID TYPES; ACCOUNTS FOR CHANGE IN
C     IW3UNPBF WHICH RETURNS SATELLITE ID IN HEADER WORD 6 (SATWINDS
C     ONLY), INCLUDES SATELLITE ID IN LISTING FOR SATWINDS; IMPROVED
C     FORMAT FOR LISTING SSM/I BRIGHTNESS TEMPS; NOW INCLUDES SURFACE
C     PRESSURE (MB PRECISE TO 10**1) IN LISTING FOR GOES RETRIEVALS
C     (FROM CAT. 8, CF 262)
C 2001-06-19  D.A. KEYSER -- CAN NOW LIST GOES CLOUD TOP REPORTS
C     CONTAINING CLOUD TOP PRESSURE, CLOUD COVER AND CLOUD TOP
C     TEMPERATURE WHICH CAN NOW BE PART OF THE "GOESND" DATA DUMP FILE
C 2001-08-20  D.A. KEYSER -- ACCOUNTS FOR CHANGE IN W3UNPKB7 WHICH
C     RETURNS NUMBER OF ORIGINAL REPORTS USED TO GENERATE SUPEROB
C     (ACAV) IN HEADER WORD 10 (QUIKSCAT ONLY), INCLUDES THIS IN
C     LISTING FOR QUIKSCAT
C 2002-03-05  D.A. KEYSER -- SUBR. W3UNPKB7 ARGUMENT RDATA MUST BE
C     DIMENSIONED AT LEAST 1200 NOW TO ACCOUNT FOR 64 POSSIBLE WIND
C     PROFILER LEVELS FROM NOAA/FSL, RDATA INCREASED FROM 800 TO 1200
C     IN THIS PROGRAM
C 2002-07-05  D.A. KEYSER -- CAN NOW LIST MESONET REPORTS FROM THE
C     "MSONET" DATA DUMP FILE USING SUBROUTINE LISTSFC AND GPS-IPW
C     REPORTS FROM THE "GPSIPW" DATA DUMP FILE USING NEW SUBROUTINE
C     LISTGPSIPW
C 2004-02-02  KEYSER -- MODIFIED TO LIST ELEVATION Q.M. IN SUBR.
C     LISTSFC SINCE SUBR. IW3UNPBF CAN NOW PROCESS MOBILE SURFACE LAND
C     SYNOPTIC REPORTS OUT OF ADPSFC DUMP FILE;  SUBR. IW3UNPBF CAN NOW
C     PROCESS E-AMDAR AIRCRAFT REPORTS OUT OF THE AIRCFT DUMP FILE;
C     MODIFIED LISTING OF CATEGORY 8 MESONET DATA (MORE VARIABLES NOW
C     RETURNED FROM SUBR. IW3UNPBF); ACCOUNTS FOR TRANSITION OF MESONET
C     REPORTS FROM LOW- TO HIGH-RESOLUTION LAT/LON IN EARLY 2004 (AND
C     LAT/LON LISTING IN LISTSFC NOW CARRIES FOUR SIGNIFICANT DIGITS
C     INSTEAD OF TWO); ARRAY SUBSKP BUMPED UP FROM (0:12,200) TO
C     (0:255,0:200) AND NOW IT CAN ALSO BE READ IN FOR NON-UPA AND NON-
C     SFC TYPES IN NAMELIST PDATA (ADDED AS A NEW INPUT ARGUMENT IN
C     W3UNPKB7); ACARS FLIGHT NUMBER NOW STORED IN RESERVE WORD 2
C     (CHARACTER) BY IW3UNPBF, SO IT IS LISTED; IW3UNPBF CAN SELECT
C     DIFFERENT WIND AND HEIGHT ASSIGN. PRESSURE FOR GOES SATWNDS
C     (ALTHOUGH STILL HARDWIRED TO "FINAL" VALUES); NOW RETURNS NEW
C     ARRAY "ADATA2" OUT OF CALL TO IW3UNPBF, CURRENTLY JUST 2-WORDS
C     WHERE WORD 1 IS "RESTRICTIONS ON REDISTRIBUTION" (BUFR F.T.
C     0-35-200) AND WORD 2 IS "EXPIRATION OF RESTRICTIONS ON
C     REDISTRIBUTION" (HRS), THESE ARE CURRENTLY NOT LISTED; SUBR.
C     W3UNPKB7 ADDED COOPERATIVE AGENCY PROFILER (CAP) (002/011) AND
C     JAPANESE (002/013) PROFILER WINDS TO PROCESSING FOR WIND
C     PROFILERS NOT ORIGINATING FROM PILOT (PIBAL) BULLETINS; NOAA
C     PROFILER NETWORK (NPN) AND COOPERATIVE AGENCY PROFILER (CAP) RASS
C     REPORTS (002/012) NOW PROCESSED FROM "RASSDA" DATA DUMP FILE BY
C     SUBR. W3UNPKB7 AND LISTED HERE USING NEW SUBROUTINE LISTRASS;
C     ADDED LOGIC TO HANDLE FUTURE MODIS (AQUA/TERRA) WINDS IN SUBR.
C     IW3UNPBF
C 2004-09-09  KEYSER -- SUBR. LISTGOESNDGS NO LONGER SELECTS WHAT TO
C     PRINT SIMPLY BY WHETHER REPORT IS A 1x1 ("H" IN 1ST CHAR. OF
C     STNID) OR 5x5 REPORT, THIS IS BECAUSE 1x1 REPORTS COULD NOW
C     CONTAIN BOTH CLOUD REPORTS (AS BEFORE) AND SOUNDING/RADIANCE
C     REPORTS - SUBR. NOW TESTS FOR MISSING CLOUD DATA TO NOT PRINT
C     CLOUD INFO, MISSING PSFC AND TPW TO NOT PRINT RETRIEVAL INFO AND
C     ZERO BRIGHTNESS TEMP LEVELS TO NOT PRINT RADIANCE INFO; NOW
C     RETURNS 41-WORD (RATHER THAN 2-WORD) ARRAY "ADATA2" OUT OF CALL
C     TO IW3UNPBF, WHERE WORDS 3-41 CONTAIN ALTIMETER SETTING, SEA-
C     SURFACE TEMPERATURE, SINGLE-LEVEL SENSIBLE WEATHER ELEMENTS AND
C     SST Q.M.; RETURNS NEW ARGUMENTS "ADATA3" {(5,255,5)} AND "NDATA3"
C     {(5)} OUT OF CALL TO IW3UNPBF WHERE ADATA3 CONTAINS MULTIPLE-
C     LEVEL SENSIBLE WEATHER ELEMENTS AND NDATA3 DEFINES THE NUMBER OF
C     LEVELS OF DATA IN THE ADATA3(X,Y,1), ADATA3(X,Y,2),
C     ADATA3(X,Y,3), ADATA3(X,Y,4) AND ADATA3(X,Y,5) ARRAYS (SEE
C     IW3UNPBF DOCBLOCK FOR MORE INFO) - THESE ARRAYS ARE PRINTED IN
C     LISTUPA AND LISTSFC; INFORMATION THAT HAD BEEN IN CATEGORIES 7,
C     51, 52 AND 8 RETURNED FROM IW3UNPBF BUT IS NOW RETURNED IN ADATA2
C     AND ADATA3 IS NOW IGNORED IN LISTUPA AND LISTSFC (IT IS NOW
C     MISSING - RESERVED);  NO ATTEMPT IS MADE IN LISTUPA TO PRINT DATA
C     IN CATEGORY 7 SINCE IT IS NO LONGER CONSIDERED IN IW3UNPBF; NO
C     ATTEMPT IS MADE IN LISTSFC TO PRINT DATA IN CATEGORY 52 SINCE IT
C     IS LONGER CONSIDERED IN IW3UNPBF
C 2005-03-14  KEYSER -- NOW PRINTS QI W/ FCST AND QI W/O FCST FOR CAT 6
C     SATELLITE WIND REPORTS (READ FROM CAT 8 C.F. 356 AND 357, RESP.)
C     (RFF FROM CAT 8 C.F. 355 STILL PRINTED AS WELL)
C 2006-07-14  D. A. KEYSER -- BUMP UP ARRAY SIZE FOR UNPACKED REPORT
C     FROM IW3UNPBF FROM 2500 TO 3000; CAN NOW LIST WINDSAT
C     SCATTEROMETER REPORTS FROM THE "WDSATR" DATA DUMP FILE USING
C     SUBROUTINE LISTWNDSAT; INCREASED THE MAXIMUM NUMBER OF ADPUPA
C     REPORTS THAT CAN BE SORTED FROM 1200 TO 20000; MODIFIED TO HANDLE
C     RETURN OF NEW ARGUMENT "RDATA2" FROM CALLS TO W3UNPKB7 [1-DIM
C     21-WORD ARRAY WHICH HOLDS ADDITIONAL VALUES DECODED DIRECTLY FROM
C     BUFR (AND NOT IN "RDATA" ARRAY), FOR SOME PARAMETERS REPLACING
C     WHAT HAD BEEN RETURNED IN "RDATA" ARRAY (IN THE HEADER)]; NO
C     LONGER PRINTS EDITION NUMBER IN LISTING OF WIND PROFILER REPORTS
C     (WAS ALWAYS HARDWIRED TO 2)
C 2007-09-14 D. A. KEYSER -- BUMP UP ARRAY SIZE FOR UNPACKED REPORT
C     FROM IW3UNPBF FROM 3000 TO 3500; INCLUDES NESDIS PERCENT
C     CONFIDENCE BASED ON EXPECTED ERROR (Q.C.) (READ FROM CAT. 8 CODE
C     FIGURE 358) IN LISTING FOR CAT. 6 SATELLITE-DERIVED WIND REPORTS;
C     EXPANDED ARRAYS ADATA3 FROM (5,255,5) TO (5,255,7) AND NDATA3
C     FROM (5) TO (7) (RETURNED OUT OF CALL TO IW3UNPBF) TO ACCOUNT FOR
C     PROCESSING/LISTING OF ADDITIONAL MULTIPLE-LEVEL SENSIBLE WEATHER
C     ELEMENTS CONTAINING SEQUENCES OF AIRFRAME ICING, HEIGHT OF BOTTOM
C     AND TOP OF ICING LAYER (IN  RECCOS, PIREPS, E-AMDAR, CANADIAN
C     AMDAR, TAMDAR), AND DEGREE OF TURBULENCE, HEIGHT OF BOTTOM AND
C     TOP OF TURBULENCE LAYER (IN RECCOS AND ALL AIRCRAFT), THE
C     EXPANDED TURBULENCE INFORMATION REPLACES THE SINGLE DEGREE OF
C     TURBULENCE VALUE WHICH HAD BEEN RETURNED FROM IW3UNPBF IN CAT. 8,
C     CODE FIGURE 916; ACCOUNTS FOR GOES 1x1 SNDG/RETR/RADIANCES IN
C     DUMP FILE "GOESFV"; ALL PRINT STATEMENTS NOW FORMATTED TO PRINT
C     OBS TIME TO NEAREST 0.00001 HR (WAS TO NEAREST 0.001 HOUR -
C     CHANGED BECAUSE PREPBUFR NOW ENCODES OBS TIME TO THIS PRECISION);
C     IMPROVED DOCUMENTATION AT TOP OF LISTINGS FOR "ADPUPA", "AIRCFT",
C     "AIRCAR", "SATWND", "ADPSFC", "MSONET", "SFCSHP", "SFCBOG" AND
C     "GOESND" DUMPS; CORRECTED ERROR WHICH PREVENTED "SFCBOG" PMSL
C     FROM BEING LISTED
C 2008-04-10  D. A. KEYSER -- CHANGE IN SUBROUTINE IW3UNPBF TO HANDLE
C     RADIOSONDE TYPES > 99 WHICH WILL SOON BE INTRODUCED INTO THE BUFR
C     DATABASE (BASED ON NOVEMBER 2007 WMO BUFR UPDATE)
C 2008-09-12  D. A. KEYSER -- MODIFIED TO RECOGNIZE THAT TAMDAR REPORTS
C     CAN NOW APPEAR IN "aircft" DUMP MESSAGE TYPES NC004012 (PENAIR)
C     AND NC004013 (CHAUTAUQUA) IN ADDITION TO MESSAGE TYPE NC004008
C     (MESABA)
C 2008-09-25  D. A. KEYSER -- BUMPED UP ARRAY SIZE FOR "ADATA2",
C     RETURNED OUT OF CALL TO IW3UNPBF, FROM 41 TO 42, NEW WORD 42
C     HOLDS ACARS MOISTURE QUALITY WHICH IS NOW LISTED; BUMPED UP ARRAY
C     SIZE FOR "RDATA2", RETURNED OUT OF CALL TO W3UNPKB7, FROM 21 TO
C     24, WHERE NEW WORDS 22-24 HOLD NEW ASCAT VARIABLES WIND VECTOR
C     CELL QUALITY, BACKSCATTER DISTANCE AND LIKELIHOOD COMPUTED FOR
C     SOLUTION; HANDLES "REPROCESSED" ASCAT WINDS IN "ascatw" DUMP
C     FILE
C 2010-06-07  D. A. KEYSER -- ADDED LISTING OF ALTIMETER Q.M. FOR
C     ADPSFC REPORTS SINCE THIS CAN NOW BE PRESENT IN SOME CASES FOR
C     METARS (CURRENTLY WHEN SDMEDIT PRESSURE Q.M. IS 12 OR 14 IN
C     WHICH CASE IW3UNPBF STORES THIS AS ALTIMETER Q.M.)
C 2012-11-27 D. A. KEYSER  -- ALLOW REPORT SEQUENCE NUMBER (CAT. 8,
C     CODE FIG. 21) TO NOW BE AS LARGE AS 999999 IN UPPER-AIR LISTING
C     (ALL OTHER CODE FIGS. UPPER LIMIT REMAINS 99999) (NEEDED BECAUSE
C     THERE CAN NOW BE > 99999 MDCRS REPORTS IN A MONOLITHIC "AIRCAR"
C     DUMP FILE, PRIOR TO THIS VALUE WAS LISTED AS LIMIT OF 99999 FOR
C     ALL REPORTS WITH SEQUENCE NUMBER > 99999)
C 2013-02-14  D. A. KEYSER -- CHANGES TO RUN ON WCOSS; ADDED CALL TO
C     BUFRLIB ROUTINE SETBMISS(10E08_8) TO RESET BMISS TO A VALUE
C     (10E08_8) WHICH WILL NOT CAUSE INTEGER OVERFLOW WHICH CAN BE
C     UNPREDICTABLE (PRIOR BMISS VALUE WAS 10E10_8); PASS BMISS VIA
C     COMMON BLOCK RATHER THAN HARDWIRING IT TO 10E08_8 IN MANY
C     DIFFERENT SUBROUTINES; USE FORMATTED PRINT STATEMENTS WHERE
C     PREVIOUSLY UNFORMATTED PRINT WAS USED (WCOSS SPLITS UNFORMATTED
C     PRINT AT 80 CHARACTERS)
C 2014-04-22  D. A. KEYSER -- BUMPED UP ARRAY SIZE FOR "ADATA2",
C     RETURNED OUT OF CALL TO IW3UNPBF, FROM 42 TO 43, NEW WORD 43
C     HOLDS SATELLITE ZENITH ANGLE (DEGREES, SATWND TYPES ONLY) WHICH
C     IS NOW LISTED; ADDED OPTION TO SORT LISTING OF "ADPSFC" DUMP BY
C     REPORT ID AND WITHIN REQUESTED OBS TIME (HARDWIRED TO NOT DO
C     SORTING).  ABORTS WITH RC=65 IF > 40000 ADPSFC REPORTS (EXCEEDS
C     SORT LIMIT). PRINTING FORMAT CHANGED FOR SOME TYPES TO SQUEEZE
C     MORE INFORMATION ON A LINE.  CHANGES TO ALLOW FOR LISTING OF NEW
C     VAD WIND REPORTS FROM LEVEL 2 DECODER.  ARRAY RDATA RETURNED FROM
C     W3UNPKB7 INCREASED FROM 1200 TO 2500 WORDS (IDATA WHICH IS
C     EQUIVALENCED TO RDATA INCREASED AS WELL).
C 2015-01-30  D. A. KEYSER -- In subr. LISTUPA, the key of SATWND data
C     listed updated to include new instrument type 19 {IR (short-wave)
C     imager automated winds (high density)}.
C 2015-03-09  D. A. KEYSER -- In subr. LISTUPA, for aircraft report
C     types (only), CBULL (new variable returned from IW3UNPBF) is now
C     listed (contains WMO bulletin header and originator) in place of
C     header character reserve word 1 (which only contained WMO
C     bulletin originator in characters 1-4) (key for AIRCAR and AIRCFT
C     data updated).
C 2015-04-16 D. A. KEYSER -- In subr. LISTGOESNDGS, now correctly lists
C     total cloud cover from GOES cloud reports in dump file "goesnd"
C     as the value of TOCC from RDATA2(25) passed from W3UNPKB7 (had
C     looked for it in cat 8 c.f. 258 passed in from W3UNPKB7 in RDATA
C     array but this was changed long ago to hold cloud amount and not
C     total cloud cover, and the former is missing in GOES cloud
C     reports). RDATA2 is expanded to size 25 in W3UNPKB7 in order to
C     store TOCC, and this is accounted for here in listdumps.f
C 2015-12-18 D. A. Keyser -- Listing of total zenith delay from "gpsipw"
C     dump in whole cm is now rounded rather than truncated. Listing of
C     hydrostatic delay from "gpsipw" dump in whole cm is now rounded
C     rather than truncated. Listing from "gpsipw" dump now denotes
C     total zenith delay as "ZTD" rather than "TDEL" and error in total
C     zenith delay as "eZTD" rather than as "ETDL".
C 2016-08-28 D. A. Keyser -- In subr. LISTGPSIPW, now lists lat and lon
C     to nearest 0.00001 degree rather than to nearest 0.01 degree.  New
C     WMO format GNSS ground-based data (in dump file "gpsipw" under
C     subset 'NC012004) stores CLATH/CLONH rather than CLAT/CLON as with
C     previous production non-standard BUFR format GPS ground-based data
C     from GSD (had been in dump file "gpsipw" under subset 'NC012003).
C 2016-02-09 S. MELCHIOR -- Adjusted code to accommodate the processing
C     of three new aircraft data types: Korean AMDAR (BUFR), Catch-All
C     AMDAR (BUFR) and TAMDAR (Panasonic/AirDAT BUFR).  Latitude,
C     longitude, and moisture are available in higher precision in new
C     version 7 BUFR format (for Catch-All AMDAR, MDCRS and E-AMDAR) so
C     print statements for dumps from "aircar", "aircft" and "adpupa"
C     (latter for future) in subr. LISTUPA were modified to account for
C     increased precision (only lat/lon for "adpupa") (lat/lon format
C     changed to list 5 significant digits instead of 2; moisture format
C     changed to list 6 significant digits instead of 3).  All
C     references to E-ADAS have been changed to E-AMDAR.
C 2016-11-25  D. A. KEYSER -- All in subr. LISTUPA: Correct info in "KEY
C     FOR DATA LISTED" printout for AIRCFT types.  For TAMDAR from
C     Panasonic or AirDAT only, lists "observer identification" (OBSVR,
C     returned from IW3UNPBF in bytes 1-4 of header reserve character
C     word 1) (due to change in both this code and in subr. IW3UNPBF),
C     lists "type of commercial aircraft" (ACTP, returned from IW3UNPBF
C     in header reserve character word 2) (due solely to change in subr.
C     IW3UNPBF), and lists instantaneous altitude rate (IALR, returned
C     from IW3UNPBF in cat.8 c.f. 932) (due solely to change in subr.
C     IW3UNPBF).  For AMDAR types other than European, Canadian and
C     Korean originating from BUFR (referred to as "Catch-all" AMDAR)
C     lists "aircraft flight number" (ACID, returned from IW3UNPBF in
C     header reserve character word 2) (due solely to change in subr.
C     IW3UNPBF).
C 2016-11-30  D. A. KEYSER -- Reads new output real, double-precision
C     argument arrays ADATA_8 and RDATA8_8, both of length 2, in calls
C     to IW3UNPBF and W3UNPKB7, resp.  This returns latitude and
C     longitude for each report which is then stored in R*8 variables
C     ALAT_8 and ALON_8 prior to listing for the following dump types:
C     AIRCFT, AIRCAR and ADPUPA in subr. LISTUPA; ADPSFC, SFCSHP and
C     MSONET in subr. LISTSFC (also here format changed to list 5
C     significant digits instead of 4); ASCATW in subr. LISTQKSWND (also
C     here format changed to list 5 significant digits instead of 2);
C     and GPSIPW in subr. LISTGPSIPW (already lists to 5 significant
C     digits).
C     BENEFIT: Replaces lat/lon returned in ADATA(1:2) and RDATA(1:2) in
C              calls to IW3UNPBF and W3UNPKB7, resp. for these types,
C              which are just at machine precison (normally R*4).  Now
C              that reports in these dumps can store lat/lon at 0.00001
C              degree precision (e.g., AIRCFT and AIRCAR dumps with
C              switch to v7 BUFR), this change will ensure that lat/lon
C              is always accurate to 0.00001 degrees in these listings.
C 2017-10-13  D. A. KEYSER -- Added minutes to every print statement
C     that includes the central dump time.  Central dump time minutes is
C     obtained from Section 1 of first (dummy) message of input dump
C     file via call to BUFRLIB routine IUPVS01.
C     BENEFIT: Until now, central dump time minutes was always zero.
C              However, with the implementation of the new RTMA_RU,
C              central dump time can now also have minutes = 15, 30
C              or 45 (since the RTMA_RU runs 4 times per hour). This
C              change allows the print statements to reflect this new
C              center dump time format.
C 2018-03-28  D. A. KEYSER -- In subr. LISTUPA: For SATWND types, prints
C     lat and lon to nearest 0.00001 degree for GOES-16 and up reports
C     since these have high-res lat/lon in their tanks.  All other
C     SATWND types continue to print lat and lon to nearest 0.01 degree
C     since they still have low-res lat/lon in their tanks (however the
C     format statement is modified to add three blanks after the lat and
C     lon to keep the alignment correct between GOES-16 and up reports
C     and all other wind reports).
C 2020-08-20  S. MELCHIOR -- In subr. LISTSFC, accommodate BUFR format 
C     buoy data.
C 2021-06-24  S. MELCHIOR -- In subr. LISTSFC, accommodate BUFR format 
C     ship and cman data.
C
C USAGE:
C   INPUT FILES:
C     UNIT 05  - INPUT DATA CARDS IN THE FORM OF A NAMELIST (SEE
C              - REMARKS)
C     UNIT 21  - BUFR DATA SET
C
C   OUTPUT FILES:
C     UNIT 06  - STANDARD OUTPUT PRINT
C
C   SUBPROGRAMS CALLED:
C     UNIQUE:    - LISTUPA      LISTSFC      LISTPROFILER
C                - LISTVADWIND  LISTGOESNDGS LISTERSCAT
C                - LISTQKSWND   LISTGPSIPW   LISTRASS
C                - LISTWNDSAT   INDEXC       IW3UNPBF
C                - W3UNPKB7     WORDLENGTH
C     LIBRARY:
C       W3NCO    - W3TAGB   W3TAGE   ERREXIT
C       W3EMC    - ORDERS
C       BUFR     - UPFTBV   SETBMISS GETBMISS iupvs01 readmg openbf
C                  clospf
C
C   EXIT STATES:
C     COND =   0 - SUCCESSFUL RUN
C          =  33 - A REPORT RETURNED FROM IW3UNPBF CONTAINS DATA IN
C                  AN UNPACKED CATEGORY NOT RECOGNIZED BY THIS PROGRAM
C          =  44 - A REPORT RETURNED FROM IW3UNPBF CONTAINS MORE THAN
C                  ONE LEVEL OF DATA (NOT POSSIBLE FOR SURFACE DATA)
C          =  55 - .GT. 20000 ADPUPA REPORTS, EXCEEDS SORT LIMIT
C          =  65 - .GT. 40000 ADPSFC REPORTS, EXCEEDS SORT LIMIT
C          =  88 - INPUT BUFR DATA DUMP DATA SET NAME NOT RECOGNIZED
C          =  99 - ERROR RETURNING A PARTICULAR REPORT FROM THE BUFR
C                  FILE VIA IW3UNPBF
C
C REMARKS:
C
C
C   VARIABLES READ IN NAMELIST "RDATA":
C
C    DSNAME_LC - CHARACTER*8 DATA SET NAME (E.G, "adpupa", "sfcshp")
C
C
C   VARIABLES READ IN NAMELIST "UDATA" (APPLIES ONLY FOR CALLS TO
C    LISTUPA):
C
C    ITWINB - TIME WINDOW RELATIVE TO CYCLE TIME FOR ACCEPTING EARLIEST
C              REPORTS; UNITS ARE HUNDREDTHS OF AN HOUR (E.G., -150
C              MEANS EARLIEST POSSIBLE TIME FOR ACCEPTING REPORTS IS
C              1.5-HOURS PRIOR TO CYCLE TIME).            (DEFAULT=-600)
C    ITWINA - TIME WINDOW RELATIVE TO CYCLE TIME FOR ACCEPTING LATEST
C              REPORTS; UNITS ARE HUNDREDTHS OF AN HOUR (E.G., +400
C              MEANS LATEST POSSIBLE TIME FOR ACCEPTING REPORTS IS
C              4.0-HOURS AFTER CYCLE TIME).               (DEFAULT=+600)
C     NOTE: THE LIMITS FOR "ITWINB" AND "ITWINA" ARE -600 AND +600,
C            RESP.  IF THESE VALUES ARE USED, THEN IT IS ASSUMED
C            THAT ALL REPORTS IN THE FILE ARE TO BE PROCESSED
C            REGARDLESS OF THEIR TIME.
C    LATS  - SOUTHERNMOST LATITUDE FOR ACCEPTING REPORTS; UNITS ARE
C              HUNDREDTHS OF DEGREE SOUTH (E.G., -4578 MEANS
C              SOUTHERNMOST LATITUDE IS 45.78 DEG. S)    (DEFAULT=-9001)
C    LATN  - NORTHERNMOST LATITUDE FOR ACCEPTING REPORTS; UNITS ARE
C              HUNDREDTHS OF DEGREE NORTH (E.G., 5051 MEANS
C              NORTHERNMOST LATITUDE IS 50.51 DEG. N)    (DEFAULT= 9001)
C    LONW  - WESTERNMOST LONGITUDE FOR ACCEPTING REPORTS; UNITS ARE
C              HUNDREDTHS OF DEGREE EAST (E.G., 21534 MEANS
C              WESTERNMOST LONGITUDE IS 215.34 DEG. E)  (DEFAULT= -0001)
C    LONE  - EASTERNMOST LONGITUDE FOR ACCEPTING REPORTS; UNITS ARE
C              HUNDREDTHS OF DEGREE EAST (E.G., 33034 MEANS
C              EASTERNMOST LONGITUDE IS 330.34 DEG. E)  (DEFAULT= 36001)
C    SUBSKP - LOGICAL (0:255,0:200) THAT IDENTIFIES THOSE BUFR TYPES/
C              SUBTYPES FOR WHICH THE BUFR MESSAGES SHOULD BE SKIPPED
C              OVER (WITHOUT DECODING REPORTS) IF TRUE (DEFAULT=.FALSE.)
C
C
C   VARIABLES READ IN NAMELIST "SDATA" (APPLIES ONLY FOR CALLS TO
C    LISTSFC):
C
C    LATS  - SOUTHERNMOST LATITUDE FOR ACCEPTING REPORTS; UNITS ARE
C              HUNDREDTHS OF DEGREE SOUTH (E.G., -4578 MEANS
C              SOUTHERNMOST LATITUDE IS 45.78 DEG. S)    (DEFAULT=-9001)
C    LATN  - NORTHERNMOST LATITUDE FOR ACCEPTING REPORTS; UNITS ARE
C              HUNDREDTHS OF DEGREE NORTH (E.G., 5051 MEANS
C              NORTHERNMOST LATITUDE IS 50.51 DEG. N)    (DEFAULT= 9001)
C    LONW  - WESTERNMOST LONGITUDE FOR ACCEPTING REPORTS; UNITS ARE
C              HUNDREDTHS OF DEGREE EAST (E.G., 21534 MEANS
C              WESTERNMOST LONGITUDE IS 215.34 DEG. E)  (DEFAULT= -0001)
C    LONE  - EASTERNMOST LONGITUDE FOR ACCEPTING REPORTS; UNITS ARE
C              HUNDREDTHS OF DEGREE EAST (E.G., 33034 MEANS
C              EASTERNMOST LONGITUDE IS 330.34 DEG. E)  (DEFAULT= 36001)
C    CHAR1 - ONLY REPORTS WITH STNID BEGINNING WITH THIS CHARACTER ARE
C              ACCEPTED (E.G., "K" MEANS ONLY U.S. METARS ARE ACCEPTED,
C              "C" MEANS ONLY CANADIAN METARS ARE EXCEPTED) (DEFAULT IS
C              "*" WHICH MEANS ALL METARS ARE ACCEPTED)
C              NOTE: THIS FILTER IS INVOKED AFTER LAT/LON FILTER
C              ABOVE
C    SUBSKP - LOGICAL (0:255,0:200) THAT IDENTIFIES THOSE BUFR TYPES/
C              SUBTYPES FOR WHICH THE BUFR MESSAGES SHOULD BE SKIPPED
C              OVER (WITHOUT DECODING REPORTS) IF TRUE (DEFAULT=.FALSE.)
C
C
C   VARIABLES READ IN NAMELIST "PDATA" (APPLIES ONLY FOR CALLS TO
C    LISTPROFILER, LISTVADWIND, LISTGOESNDGS, LISTERSCAT, LISTQKSWND,
C    LISTGPSIPW, LISTRASS AND LISTWNDSAT):
C
C    IDAT10 - "CENTRAL" DATE FOR PROCESSING BUFR MESSAGES IN FORM
C              YYYYMMDDHH (NOTE: IF FILE IS A DATA DUMP, THIS MUST
C              AGREE WITH CENTER DATE OF BUFR DUMP FILE) (FOR CALLS TO
C              W3UNPKB7 ONLY)
C              Note: Currently this does not include minutes for RTMA_RU
C                    runs.  It might be a good idea to update this
C                    someday!
C    IWINDE - NUMBER OF WHOLE HOURS RELATIVE TO "IDAT10" FOR DATE OF
C              EARLIEST BUFR MESSAGE THAT IS TO BE DECODED; EARLIEST
C              DATE IS "IDAT10" + "IWINDE" HOURS (IF "IWINDE" IS
C              POSITIVE, EARLIEST MESSAGE DATE IS AFTER "IDAT10"; IF
C              "IWINDE" IS NEGATIVE, EARLIEST MESSAGE DATE IS PRIOR TO
C              "IDAT10") - EXAMPLE: IF IWINDE=1, THEN EARLIEST DATE IS
C              1-HR AFTER IDAT10; IF IWINDE=-3, THEN EARLIEST DATE IS
C              3-HR PRIOR TO IWINDE
C    IWINDL - NUMBER OF WHOLE HOURS RELATIVE TO "IDAT10" FOR DATE OF
C              LATEST BUFR MESSAGE THAT IS TO BE DECODED; LATEST
C              DATE IS "IDAT10" + ("IWINDL" HOURS PLUS 59 MIN) IF
C              "IWINDL" IS POSITIVE (LATEST MESSAGE DATE IS AFTER
C              "IDAT10"), AND "IDAT10" + ("IWINDL"+1 HOURS MINUS 1 MIN)
C              IF "IWINDL" IS NEGATIVE (LATEST MESSAGE DATE IS PRIOR
C              TO "IDAT10") - EXAMPLE: IF IWINDL=3, THEN LATEST DATE IS
C              3-HR 59-MIN AFTER IDAT10; IF IWINDL=-2, THEN LATEST DATE
C              IS 1-HR 1-MIN PRIOR TO IDAT10
C     NOTE: THE LIMITS FOR "IWINDE" AND "IWINDL" ARE -6 AND +6, RESP.
C            IF THESE VALUES ARE USED, THEN IT IS ASSUMED THAT ALL
C            BUFR MESSAGES IN THE FILE ARE TO BE PROCESSED REGARDLESS
C            OF THEIR TIME.
C    IPRINT - CONTROLS THE AMOUNT OF PRINTOUT ASSOCIATED WITH THE
C              LISTINGS
C                IPRINT = -2 - ALL POSSIBLE PRINTOUT
C                IPRINT = -1 - SOME ADDITIONAL PRINTOUT
C                IPRINT =  0 - NORMAL PRINTOUT
C              NOTE: NORMALLY IPRINT=0 IS USED; IF THERE ARE PROBLEMS
C                     THAT NEED DIAGNOSING, THEN THE OTHER OPTIONS MAY
C                     BE NEEDED
C    SUBSKP - LOGICAL (0:255,0:200) THAT IDENTIFIES THOSE BUFR TYPES/
C              SUBTYPES FOR WHICH THE BUFR MESSAGES SHOULD BE SKIPPED
C              OVER (WITHOUT DECODING REPORTS) IF TRUE (DEFAULT=.FALSE.)
C
C    THE FOLLOWING 3 SWITCHES APPLY ONLY TO CALLS TO LISTGOESNDGS:
C     (TRUE OR FALSE)
C    SNDG   - PRINT VERTICAL SOUNDING DATA IN A GOES REPORT?
C    RETR   - PRINT RETRIEVAL DATA IN A GOES REPORT?
C    RADN   - PRINT RADIANCE DATA IN A GOES REPORT?
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE:  NCEP WCOSS
C
C$$$

      PROGRAM BUFR_LISTDUMPS

      CHARACTER*8  DSNAME_LC,DSNAMX,SUBSET

      INTEGER(8)  IDSDMP_8

      REAL(8)     BMISS,GETBMISS

      NAMELIST/RDATA/DSNAME_LC

      COMMON/TYPE/DSNAME_LC
      COMMON/BUFRLIB_MISSING/BMISS

      DATA NUNIT/21/

      CALL W3TAGB('BUFR_LISTDUMPS',2021,0175,0062,'NP22')

      PRINT 100
  100 FORMAT(//36X,'*****  PROGRAM BUFR_LISTDUMPS - WCOSS VERSION ',
     $ '06-24-2021  *****'//)

C  On WCOSS should always set BUFRLIB missing (BMISS) to 10E8 to avoid
C   overflow when either an INTEGER*4 variable is set to BMISS or a
C   REAL*8 (or REAL*4) variable that is missing is NINT'd
C  -------------------------------------------------------------------
ccccc CALL SETBMISS(10E10_8)
      CALL SETBMISS(10E8_8)
      BMISS=GETBMISS()
      print'(1X)'
      print'(" BUFRLIB value for missing is: ",G0)', bmiss
      print'(1X)'

      READ(5,RDATA)

      IF(DSNAME_LC.EQ.'adpupa  '.OR.DSNAME_LC.EQ.'aircar  '.OR.
     $   DSNAME_LC.EQ.'aircft  '.OR.DSNAME_LC.EQ.'satwnd  '.OR.
     $   DSNAME_LC.EQ.'spssmi  ')  THEN
         IOPENED = 0
         KNTRPT  = 0
         DSNAMX  = 'ZZZZZZZZ'
         IDSDAT  = 0
         IDSDMP_8  = 0
         SUBSET  = 'XXXXXXXX'
         CALL LISTUPA(IOPENED,KNTRPT,DSNAMX,IDSDAT,IDSDMP_8,SUBSET)
         GO TO 7000
      ELSE IF(DSNAME_LC.EQ.'adpsfc  '.OR.DSNAME_LC.EQ.'sfcshp  '.OR.
     $        DSNAME_LC.EQ.'sfcbog  '.OR.DSNAME_LC.EQ.'msonet  ')  THEN
         CALL LISTSFC
         GO TO 7000
      ELSE IF(DSNAME_LC.EQ.'proflr  ')  THEN
         CALL LISTPROFILER
         GO TO 7000
      ELSE IF(DSNAME_LC.EQ.'vadwnd  ')  THEN
         CALL LISTVADWIND
         GO TO 7000
      ELSE IF(DSNAME_LC.EQ.'goesnd  '.or. DSNAME_LC.EQ.'goesfv')  THEN
         CALL LISTGOESNDGS
         GO TO 7000
      ELSE IF(DSNAME_LC.EQ.'erscat  ')  THEN
         CALL LISTERSCAT
         GO TO 7000
      ELSE IF(DSNAME_LC.EQ.'qkswnd  ')  THEN
         CALL LISTQKSWND(1)
         GO TO 7000
      ELSE IF(DSNAME_LC.EQ.'ascatw  ')  THEN
         CALL LISTQKSWND(2)
         GO TO 7000
      ELSE IF(DSNAME_LC.EQ.'gpsipw  ')  THEN
         CALL LISTGPSIPW
         GO TO 7000
      ELSE IF(DSNAME_LC.EQ.'rassda  ')  THEN
         CALL LISTRASS
         GO TO 7000
      ELSE IF(DSNAME_LC.EQ.'wdsatr  ')  THEN
         CALL LISTWNDSAT
         GO TO 7000
      ELSE
         PRINT 567, DSNAME_LC
  567    FORMAT('**BUFR_LISTDUMPS: INPUT BUFR DATA DUMP DATA SET ',
     $    'NAME (',A8,') NOT RECOGNIZED!!')
         CALL W3TAGE('BUFR_LISTDUMPS')
         CALL ERREXIT(88)
      END IF

 7000 CONTINUE

      CALL W3TAGE('BUFR_LISTDUMPS')

      STOP

      END
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    LISTUPA
C   PRGMMR: D. A. KEYSER     ORG: NP22       DATE: 2018-03-28
C
C ABSTRACT: LISTS CONTENTS OF AN TIME-WINDOWED UPPER-AIR BUFR DATA
C   DUMP FILE.  THE STANDARD OUTPUT IS IN AN EASY-TO-READ FORMAT.
C   NOTE: THIS SUBROUTINE CAN HANDLE THE FOLLOWING BUFR DATA DUMP
C   FILE TYPES: ADPUPA, AIRCAR, AIRCFT, SATWND, SPSSMI, PROFLR
C   {FOR "PROFLR" ONLY WIND PROFILERS ORIGINATING FROM PILOT
C   (PIBAL) FORMAT BULLETINS ARE PROCESSED HERE, REMAINDER OF
C   PROFILERS ARE PROCESSED BY SUBROUTINE "LISTPROFILER"}.  THE
C   ADPUPA DUMP (ONLY) IS NOW SORTED IN ASCENDING ORDER OF STATION
C   ID.
C
C PROGRAM HISTORY LOG:
C 2000-03-28  D.A. KEYSER -- ORIGINAL AUTHOR
C 2000-06-07  D.A. KEYSER -- ADDED SORTING OF ADPUPA DATA IN ASCENDING
C     ORDER OF STATION ID; USER CAN NOW SPECIFY LAT/LON BOUNDARY FOR
C     LISTING "UPPER-AIR" (ADPUPA, AIRCAR, AIRCFT, SATWND, SPSSMI)
C     REPORTS; CAN NOW LIST SSM/I RAIN RATE REPORTS IN EASY-TO-READ
C     FORMAT; IMPROVED FORMAT FOR LISTING SATWND REPORTS
C 2001-04-06  D.A. KEYSER -- CAN NOW LIST SSM/I SURFACE TEMPERATURE
C     REPORTS IN EASY-TO-READ FORMAT; UNITS FOR INPUT SSM/I RAIN
C     RATE CHANGED FROM MM/HR TO MM/SEC (PRECISE TO 10**6) TO ACCOUNT
C     FOR CHANGE IN IW3UNPBF (STILL LISTED IN UNITS OF MM/HR); UNITS
C     FOR INPUT SSM/I WIND SPEED, PWATER AND SFC. TEMP. CHANGED FROM
C     M/S*10, MM*10, K*100, RESP. TO M/S, MM, K WITH FLOATING POINT
C     PRECISON TO 10**1, 10**1, 10**2, RESP. TO ACCOUNT FOR CHANGE IN
C     IW3UNPBF; MEAN AND STD. DEV FOR SSM/I PRODUCTS NOW LISTED TO
C     NEAREST HUNDREDTH UNIT (WAS NEAREST TENTH); NEW INPUT ARGUMENT
C     IOPENED NOW INDICATES (WHEN = 1) THAT THE INPUT FILE HAS ALREADY
C     BEEN OPENED BY ANOTHER LISTER SUBR. IN THIS PROGRAM AND THIS
C     SUBR. WILL PICK UP WHERE THE OTHER SUBR. LEFT OFF (OTHER NEW
C     INPUT ARGS. "KOUNT", "DSNAME", "IDSDAT", "IDSDMP_8" AND "SUBSET"
C     ARE THEN NEEDED); ACCOUNTS FOR CHANGE IN IW3UNPBF WHICH RETURNS
C     SATELLITE ID IN HEADER WORD 6 (SATWINDS ONLY), INCLUDES SATELLITE
C     ID IN LISTING FOR SATWINDS; IMPROVED FORMAT FOR LISTING SSM/I
C     BRIGHTNESS TEMPS
C 2004-09-09  KEYSER -- NOW PRINTS SST AND SINGLE-LEVEL SENSIBLE
C     WEATHER ELEMENTS FROM ADATA2 AND MULTIPLE-LEVEL SENSIBLE WEATHER
C     ELEMENTS FROM ADATA3 RETURNED FROM IW3UNPBF; INFORMATION THAT
C     HAD BEEN PRINTED FROM CATEGORIES 7 AND 8 RETURNED FROM IW3UNPBF
C     THAT IS NOW RETURNED IN ADATA2 AND ADATA3 IS NOW IGNORED; NO
C     ATTEMPT IS MADE TO PRINT DATA IN CATEGORY 7 SINCE IT IS NO
C     LONGER CONSIDERED IN IW3UNPBF
C 2005-03-14  KEYSER -- NOW PRINTS QI W/ FCST AND QI W/O FCST FOR CAT 6
C     SATELLITE WIND REPORTS (READ FROM CAT 8 C.F. 356 AND 357, RESP.)
C     (RFF FROM CAT 8 C.F. 355 STILL PRINTED AS WELL)
C 2007-09-14 D. A. KEYSER -- BUMP UP ARRAY SIZE FOR UNPACKED REPORT
C     FROM IW3UNPBF FROM 3000 TO 3500; INCLUDES NESDIS PERCENT
C     CONFIDENCE BASED ON EXPECTED ERROR (Q.C.) (READ FROM CAT. 8 CODE
C     FIGURE 358) IN LISTING FOR CAT. 6 SATELLITE-DERIVED WIND REPORTS;
C     EXPANDED ARRAYS ADATA3 FROM (5,255,5) TO (5,255,7) AND NDATA3
C     FROM (5) TO (7) (RETURNED OUT OF CALL TO IW3UNPBF) TO ACCOUNT FOR
C     PROCESSING/LISTING OF ADDITIONAL MULTIPLE-LEVEL SENSIBLE WEATHER
C     ELEMENTS CONTAINING SEQUENCES OF AIRFRAME ICING, HEIGHT OF BOTTOM
C     AND TOP OF ICING LAYER (IN  RECCOS, PIREPS, E-AMDAR, CANADIAN
C     AMDAR, TAMDAR), AND DEGREE OF TURBULENCE, HEIGHT OF BOTTOM AND
C     TOP OF TURBULENCE LAYER (IN RECCOS AND ALL AIRCRAFT), THE
C     EXPANDED TURBULENCE INFORMATION REPLACES THE SINGLE DEGREE OF
C     TURBULENCE VALUE WHICH HAD BEEN RETURNED FROM IW3UNPBF IN CAT. 8,
C     CODE FIGURE 916; IMPROVED DOCUMENTATION AT TOP OF LISTINGS FOR
C     "ADPUPA", "AIRCFT", "AIRCAR" AND "SATWND" DUMPS
C 2008-09-12  D. A. KEYSER -- MODIFIED TO RECOGNIZE THAT TAMDAR REPORTS
C     CAN NOW APPEAR IN "aircft" DUMP MESSAGE TYPES NC004012 (PENAIR)
C     AND NC004013 (CHAUTAUQUA) IN ADDITION TO MESSAGE TYPE NC004008
C     (MESABA)
C 2008-09-25 D. A. KEYSER -- ACARS MOISTURE QUALITY IS NOW LISTED
C 2012-11-27 D. A. KEYSER -- ALLOW REPORT SEQUENCE NUMBER (CAT. 8,
C     CODE FIG. 21) TO NOW BE AS LARGE AS 999999 (ALL OTHER CODE FIGS.
C     UPPER LIMIT REMAINS 99999) (NEEDED BECAUSE THERE CAN NOW BE >
C     99999 MDCRS REPORTS IN A MONOLITHIC "AIRCAR" DUMP FILE, PRIOR TO
C     THIS VALUE WAS LISTED AS LIMIT OF 99999 FOR ALL REPORTS WITH
C     SEQUENCE NUMBER > 99999)
C 2014-04-22  D. A. KEYSER -- BUMPED UP ARRAY SIZE FOR "ADATA2",
C     RETURNED OUT OF CALL TO IW3UNPBF, FROM 42 TO 43, NEW WORD 43
C     HOLDS SATELLITE ZENITH ANGLE (DEGREES, SATWND TYPES ONLY) WHICH
C     IS NOW LISTED.  PRINTING FORMAT CHANGED FOR SOME TYPES TO SQUEEZE
C     MORE INFORMATION ON A LINE.  
C 2015-01-30  D. A. KEYSER -- The key of SATWND data listed updated to
C     include new instrument type 19 {IR (short-wave) imager automated
C     winds (high density)}.
C 2015-03-09  D. A. KEYSER -- For aircraft report types (only), CBULL
C     (new variable returned from IW3UNPBF) is now listed (contains WMO
C     bulletin header and originator) in place of header character
C     reserve word 1 (which only contained WMO bulletin originator in
C     characters 1-4) (key for AIRCAR and AIRCFT data updated).
C 2016-02-09 S. MELCHIOR -- Adjusted code to accommodate the processing
C     of three new aircraft data types: Korean AMDAR (BUFR), Catch-All
C     AMDAR (BUFR) and TAMDAR (Panasonic/AirDAT BUFR).  Latitude,
C     longitude, and moisture are available in higher precision in new
C     version 7 BUFR format (for Catch-All AMDAR, MDCRS and E-AMDAR) so
C     print statements for dumps from "aircar", "aircft" and "adpupa"
C     (latter for future) were modified to account for increased
C     precision (only lat/lon for "adpupa") (lat/lon format changed to
C     list 5 significant digits instead of 2; moisture format changed to
C     list 6 significant digits instead of 3).
C 2016-11-25  D. A. KEYSER -- Correct info in "KEY FOR DATA LISTED"
C     printout for AIRCFT types.  For TAMDAR from Panasonic or AirDAT
C     only, lists "observer identification" (OBSVR, returned from
C     IW3UNPBF in bytes 1-4 of header reserve character word 1) (due to
C     change in both this code and in subr. IW3UNPBF), lists "type of
C     commercial aircraft" (ACTP, returned from IW3UNPBF in header
C     reserve character word 2) (due solely to change in subr.
C     IW3UNPBF), and lists instantaneous altitude rate (IALR, returned
C     from IW3UNPBF in cat.8 c.f. 932) (due solely to change in subr.
C     IW3UNPBF).  For AMDAR types other than European, Canadian and
C     Korean originating from BUFR (referred to as "Catch-all" AMDAR)
C     lists "aircraft flight number" (ACID, returned from IW3UNPBF in
C     header reserve character word 2) (due solely to change in subr.
C     IW3UNPBF).
C 2016-11-30  D. A. KEYSER -- Reads new output real, double-precision
C     argument array ADATA_8 of length 2 in call to IW3UNPBF.  This
C     returns latitude and longitude for each report which is then
C     stored in R*8 variables ALAT_8 and ALON_8 prior to listing for the
C     following dump types: AIRCFT, AIRCAR and ADPUPA.
C     BENEFIT: Replaces lat/lon returned in ADATA(1:2) in call to
C              IW3UNPBF for these types which are just at machine
C              precison (normally R*4).  Now that reports in these dumps
C              can store lat/lon at 0.00001 degree precision (e.g.,
C              AIRCFT and AIRCAR dumps with switch to v7 BUFR), this
C              change will ensure that lat/lon is always accurate to
C              0.00001 degrees in these listings.
C 2017-10-13  D. A. KEYSER -- Added minutes to every print statement
C     that includes the central dump time.  Central dump time minutes is
C     obtained from Section 1 of first (dummy) message of input dump
C     file via call to BUFRLIB routine IUPVS01.
C     BENEFIT: Until now, central dump time minutes was always zero.
C              However, with the implementation of the new RTMA_RU,
C              central dump time can now also have minutes = 15, 30
C              or 45 (since the RTMA_RU runs 4 times per hour). This
C              change allows the print statements to reflect this new
C              center dump time format.
C 2018-03-28  D. A. KEYSER -- For SATWND types, prints lat and lon to
C     nearest 0.00001 degree for GOES-16 and up reports since these have
C     high-res lat/lon in their tanks.  All other SATWND types continue
C     to print lat and lon to nearest 0.01 degree since they still have
C     low-res lat/lon in their tanks (however the format statement is
C     modified to add three blanks after the lat and lon to keep the
C     alignment correct between GOES-16 and up reports and all other
C     satellite wind reports).
C
C USAGE:    CALL LISTUPA(IOPENED,KOUNT,DSNAME,IDSDAT,IDSDMP_8,SUBSET)
C   INPUT ARGUMENT LIST:
C     IOPENED  - INDICATOR AS TO WHETHER INPUT FILE HAS ALREADY
C              - BEEN OPENED BY ANOTHER LISTER SUBROUTINE IN THIS
C              - PROGRAM (=0 - HAS NOT ALREADY BEEN OPENED; =1 -
C              - HAS ALREADY BEEN OPENED)
C     KOUNT    - IN THIS CASE ON IOPENED = 1, THE NUMBER OF REPORTS
C              - THAT HAVE ALREADY BEEN PROCESSED BY ANOTHER LISTER
C              - SUBROUTINE IN THIS PROGRAM (IF IOPENED IS INPUT AS
C              - 0, THEN KOUNT SHOULD ALSO BE INPUT AS 0)
C     DSNAME   - CHARACTER*8 DATA SET NAME (IF IOPENED IS INPUT AS
C              - 0, THEN DSNAME IS NOT READ AND CAN BE INPUT AS
C              - 'ZZZZZZZZ')
C     IDSDAT   - CENTER TIME FOR DUMP DATA SET IN FORM YYYYMMDDHH (IF
C              - IOPENED IS INPUT AS 0, THEN IDSDAT IS NOT READ AND
C              - CAN BE INPUT AS ZERO)
C                Note: Currently this does not include minutes for
C                      RTMA_RU runs.  It might be a good idea to update
C                      this someday!
C     IDSDMP_8 - INTEGER*8 DUMP TIME FOR DUMP DATA SET IN FORM
C              - YYYYMMDDHHMM (IF IOPENED IS INPUT AS 0, THEN IDSDMP_8
C              - IS NOT READ AND CAN BE INPUT AS ZERO)
C     SUBSET   - CHARACTER*8  BUFR MESSAGE TYPE (IF IOPENED IS INPUT
C              - AS 0, THEN SUBSET IS NOT READ AND CAN BE INPUT AS
C              - 'XXXXXXXX')
C
C   INPUT FILES: 
C     UNIT 05  - INPUT DATA CARDS IN THE FORM OF A NAMELIST (SEE
C              - REMARKS IN MAIN PROGRAM DOCBLOCK)
C     UNIT 21  - BUFR DATA SET
C
C   OUTPUT FILES:
C     UNIT 06  - STANDARD OUTPUT PRINT
C
C REMARKS: NONE.
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE:  NCEP WCOSS
C
C$$$

      SUBROUTINE LISTUPA(IOPENED,KOUNT,DSNAME,IDSDAT,IDSDMP_8,SUBSET)

      PARAMETER (MAXOBS = 3500)

      CHARACTER*1  C1,C2,c1_8,c2_8
      CHARACTER*2  CIND1,CIND2,CIND3,CIND4,CQM(5,7)
      CHARACTER*4  CUNITS,CCAT1(8)
      CHARACTER*5  CCAT2(75),CCAT3(75),CCAT4(75)
      CHARACTER*6  CDATUM
      CHARACTER*8  STNID,CRES1,CRES2,DSNAME,STNID_S(20000),
     $ CRES1_S(20000),CRES2_S(20000),KEY_S(20000),SUBSET,SUBSET_S(20000)
      CHARACTER*9  CRES
      CHARACTER*10 CCAT5(60)
      CHARACTER*11 CCAT8(105),CBULL

      LOGICAL  GLOBAL,SUBSKP(0:255,0:200),SORTID

      REAL  ADATA(MAXOBS),ADATA_S(MAXOBS,20000),SRAD(7),ADATA2(43),
     $ ADATA2_S(43,20000),ADATA3(5,255,7),ADATA3_S(5,255,7,20000)

      REAL(8) BMISS,adata8_8(2),adata8_8_s(2,20000),alat_8,alon_8

      INTEGER  IDATA(MAXOBS),ICAT(9),INDX(20000),NDATA3(7),
     $ NDATA3_S(7,20000)
      INTEGER(8) IDSDMP_8

      COMMON/BUFRLIB_MISSING/BMISS

      EQUIVALENCE  (ADATA,IDATA)

      DATA NUNIT/21/
      DATA CCAT1/'MAND',7*'    '/
      DATA CCAT2/'SIG-T',74*'     '/
      DATA CCAT3/'WND-P',74*'     '/
      DATA CCAT4/'WND-Z',74*'     '/
      DATA CCAT5/'TROPOPAUSE',59*'          '/
      DATA CCAT8/'ADDIT-DATA ',104*'           '/
      DATA ICAT/51,-99,-99,10,11,12,13,14,15/

      DATA KTIMCH/0/,XMISS/99999./,IMISS/99999/

      NAMELIST/UDATA/ITWINB,ITWINA,LATS,LATN,LONW,LONE,SUBSKP

      IADPUP = 0
      KNTTIM = 0
      KNTLAT = 0
      KNTLON = 0

      SORTID = .FALSE.

      ITWINB = -600
      ITWINA =  600
      LATS = -9001
      LATN =  9001
      LONW = -0001
      LONE = 36001
      SUBSKP = .FALSE.
      IER  = 0

      IF(IOPENED.EQ.1)  THEN
         IER = -1
         PRINT 892, NUNIT
  892 FORMAT(/'##BUFR_LISTDUMPS/LISTUPA: ABOUT TO UNPACK REPORTS FROM ',
     $ 'A FILE (UNIT',I3,') WHICH HAS ALREADY BEEN OPENED BY ANOTHER ',
     $ 'LISTER'/26X,'SUBROUTINE IN THIS PROGRAM'/)
      END IF

      READ(5,UDATA,END=1905)

 1905 CONTINUE

      GLOBAL = (LATS.LE.-09000.AND.LATN.GE.09000.AND.
     $          LONW.LE. 00000.AND.LONE.GE.36000)

  905 CONTINUE

      IF(IW3UNPBF(NUNIT,ADATA,STNID,CRES1,CRES2,CBULL,ADATA2,ADATA3,
     $ NDATA3,adata8_8,DSNAME,IDSDAT,IDSDMP_8,SUBSET,SUBSKP,IER).EQ.0)
     $ GO TO 950
      IF(IER.EQ.1)  GO TO 910
      IF(IER.EQ.2)  GO TO 920
      IF(IER.EQ.3)  GO TO 920
      IF(IER.EQ.999)  GO TO 999

C-----------------------------------------------------------------------

  910 CONTINUE

      IF(DSNAME.EQ.'ADPUPA  ')  THEN
         PRINT 101
  101 FORMAT(//5X,'KEY FOR DATA LISTED IN EACH REPORT BELOW:'/
     $/10X,'BUFR mnemonics:'
     $/15X,'RSRD ..... Restrictions on redistribution, Flag Table 0-35',
     $ '-200 ('
     $/32X,' 16 - can redistribute to any U.S. government agency ',
     $ 'within NOAA,'
     $/32X,'128 - can redistribute to any U.S. government agency,'
     $/32X,'160 - can redistribute to any U.S. government agency or ',
     $ 'educational institution,'
     $/32X,'192 - can redistribute to any U.S. government agency or ',
     $ 'research group,'
     $/32X,'224 - can redistribute to any U.S. government agency, ',
     $ 'research group or educational institution,'
     $/32X,'256 - no redistribution allowed,'
     $/28X,'Missing - no retrictions on redistribution)'
     $/15X,'EXPRSRD .. Expiration of restrictions on redistribution ',
     $ '(hours), 0-35-201'
     $/15X,'SST1 ..... Sea temperature (K), 0-22-043'
     $/15X,'SSTQM .... Sea temperature quality marker, Code Table 0-22',
     $ '-246'
     $/27X,'(see http://www.emc.ncep.noaa.gov/mmb/data_processing/',
     $ 'prepbufr.doc/table_7.htm)'
     $/15X,'HBLCS .... Height above surface of the base of the lowest ',
     $ 'cloud seen, Code Table 0-20-201'
     $/27X,'(see http://www.emc.ncep.noaa.gov/mmb/data_processing/',
     $ 'table_local_await-val.htm#0-20-201)'
     $/15X,'WDIR1..... Surface wind direction (degrees), 0-11-200'
     $/15X,'WSPD1..... Surface wind speed (m/sec), 0-11-201'
     $/15X,'PRWE ..... Present weather, Code Table 0-20-003'
     $/27X,'(see http://www.emc.ncep.noaa.gov/mmb/data_processing/',
     $ 'table_20.htm#0-20-003)'
     $/15X,'CLAM ..... Cloud amount, Code Table 0-20-011'
     $/27X,'(see http://www.emc.ncep.noaa.gov/mmb/data_processing/',
     $ 'table_20.htm#0-20-011)'
     $/15X,'CLTP ..... Cloud type, Code Table 0-20-012'
     $/27X,'(see http://www.emc.ncep.noaa.gov/mmb/data_processing/',
     $ 'table_20.htm#0-20-012)'
     $/15X,'HOCB ..... Height of base of cloud (meters), 0-20-013'
     $/15X,'HOCT ..... Height of top  of cloud (meters), 0-20-014'
     $/15X,'AFIC ..... Airframe icing, Code Table 0-20-041'
     $/27X,'(see http://www.emc.ncep.noaa.gov/mmb/data_processing/',
     $ 'table_20.htm#0-20-041)'
     $/15X,'HBOI ..... Height of base of icing (meters), 0-24-194'
     $/15X,'HTOI ..... Height of top  of icing (meters), 0-24-195'
     $/15X,'DGOT ..... Degree of turbulence, Code Table 0-11-031'
     $/27X,'(see http://www.emc.ncep.noaa.gov/mmb/data_processing/',
     $ 'table_9-19.htm#0-11-031)'
     $/15X,'HBOT ..... Height of base of turbulence (meters), 0-11-032'
     $/15X,'HTOT ..... Height of top  of turbulence (meters), 0-11-033'/
     $/10X,'ADDIT-DATA (Category 8) "Levels", each of form "wwwww xxx ',
     $ 'yyyyy zzzzz" where xxx is code figure defined as follows:'
     $/15X,'xxx = 104 - wwwww = release time (in 0.01 hours)'
     $/15X,'xxx = 105 - wwwww = receipt time (in 0.01 hours)'
     $/30x,'- yyyyy = radiosonde part (00004 - TTAA, 00005 - TTBB, ',
     $ '00006- TTCC, 00007 - TTDD, 00008 - PPAA,'
     $/40X,'00009 - PPBB, 00010 - PPCC, 00011 - PPDD)'
     $/15X,'xxx = 351 - wwwww = geopotential height (in meters)'
     $/30X,'- yyyyy = pressure level (mb)'
     $/30X,'- zzzzz = geopotential quality marker (00000 - monitor ',
     $ 'keep, 00001 - good, 00002 - neutral/not'
     $/40X,'checked, 00003 - suspect, 00012 - toss, on reject list, ',
     $'00013 - toss, failed automatic q.c.'
     $/40X,'tests, 00014 - toss, monitor purge)'
     $/15X,'xxx = 353 - wwwww = solar and infrared radiation ',
     $ 'correction indicator (BUFR Code Table 0-02-013,'
     $/35X,'see http://www.emc.ncep.noaa.gov/mmb/data_processingtable/',
     $ '_1-2.htm#0-02-013)'
     $/15X,'xxx = 354 - wwwww = tracking technique/status of system ',
     $ 'used indicator (BUFR Code Table 0-02-014,'
     $/35X,'see http://www.emc.ncep.noaa.gov/mmb/data_processing/',
     $ 'common_tbl_c6-c7.htm#c-7)'//)

      ELSE IF(DSNAME.EQ.'AIRCFT  ')  THEN
         PRINT 102
  102 FORMAT(//5X,'KEY FOR DATA LISTED IN EACH REPORT BELOW:'/
     $/10X,'Field  1 ....... AIREP, TAMDAR(MADIS): Flight number'
     $/10X,'                 PIREP: Constructed id'
     $/10X,'                 All AMDAR types, TAMDAR(Panasonic or ',
     $ 'AirDAT) : Tail number'
     $/10X,'Field  2 ....... Observation time (UTC)'
     $/10X,'Field  3 ....... Latitude (N,S)'
     $/10X,'Field  4 ....... Longitude (E,W)'
     $/10X,'Field  5 ....... Pressure (x 10 mb)'
     $/10X,'Field  6 ....... Pressure altitude (meters)'
     $/10X,'Field  7 ....... Temperature (x 10 degrees C)'
     $/10X,'Field  8 ....... Specific humidity (g/kg)'
     $/10X,'Field  9 ....... Wind direction (degrees) / wind speed (x ',
     $ '10 m/sec)'
     $/10X,'Field 10 ....... Quality markers in form AABBCCDDEE, where',
     $ ' AA = pressure, BB = pressure altitude, CC = temperature,'
     $/28X,'DD = specific humidity, EE = wind (00 - monitor keep, 01 -',
     $ ' good, 02 - neutral/not checked, 03 - suspect,'
     $/28X,'12 - toss, on reject list, 13 - toss, failed automatic ',
     $ 'q.c. tests, 14 - toss, monitor purge)'
     $/28X,'Note: If quality marker is default value of 02 then "--" ',
     $ 'is stamped out here rather than "02"'
     $/10X,'RCT ............ Receipt time (UTC)'
     $/10X,'Next field ..... 20 character string enclosed in quotes:',
     $/27x,'   - Characters  1-6: WMO bulletin header (all types ',
     $ 'except TAMDAR from Panasonic or AirDAT)',
     $/27x,'   - Characters 8-11: WMO bulletin originator (all types ',
     $ 'except TAMDAR from Panasonic or AirDAT)',
     $/27x,'   - Characters  1-4: Observer identification (TAMDAR from',
     $ ' Panasonic or AirDAT only)',
     $/27x,'   - Character    13: Indicator for bulletin source ',
     $ '{AIREP, PIREP, AMDAR (from AMDAR format) only}:',
     $/32x,'        - "C" - AWFA',
     $/32x,'        - " " - WMO',
     $/27x,'   - Characters 13-20: Type of commercial aircraft (TAMDAR',
     $ ' from Panasonic or AirDAT only)',
     $/27x,'   - Characters 13-20: Flight number (encrypted)',
     $ ' {AMDAR (from BUFR) only}',
     $/27x,'   (all other characters are blanks)',
     $/10X,'RT ............. Dump report type / report subtype (report',
     $ ' type always 041 - aircraft; report subtype: 1 - AIREP,'
     $/28X,'2 - PIREP, 3 - AMDAR, 6 - E-AMDAR, 8 - TAMDAR-Mesaba, 9 - ',
     $ 'Canadian AMDAR, 11 - Korean AMDAR, ',
     $/28X,'12 - TAMDAR-PenAir, 13 - TAMDAR-Chautauqua, 103 - ',
     $ 'Catch-all AMDAR)'
     $/10X,'IT ............. Instrument type (97 - Inertial navigation',
     $ ' system, 98 - OMEGA)'/
     $/10X,'BUFR mnemonics:'
     $/15X,'RSRD ..... Restrictions on redistribution, Flag Table 0-35',
     $ '-200 ('
     $/32X,' 16 - can redistribute to any U.S. government agency ',
     $ 'within NOAA,'
     $/32X,'128 - can redistribute to any U.S. government agency,'
     $/32X,'160 - can redistribute to any U.S. government agency or ',
     $ 'educational institution,'
     $/32X,'192 - can redistribute to any U.S. government agency or ',
     $ 'research group,'
     $/32X,'224 - can redistribute to any U.S. government agency, ',
     $ 'research group or educational institution,'
     $/32X,'256 - no redistribution allowed,'
     $/28X,'Missing - no retrictions on redistribution)'
     $/15X,'EXPRSRD .. Expiration of restrictions on redistribution ',
     $ '(hours), 0-35-201'
     $/15X,'PRWE ..... Present weather, Code Table 0-20-003'
     $/27X,'(see http://www.emc.ncep.noaa.gov/mmb/data_processing/',
     $ 'table_20.htm#0-20-003)'
     $/15X,'CLAM ..... Cloud amount, Code Table 0-20-011'
     $/27X,'(see http://www.emc.ncep.noaa.gov/mmb/data_processing/',
     $ 'table_20.htm#0-20-011)'
     $/15X,'CLTP ..... Cloud type, Code Table 0-20-012'
     $/27X,'(see http://www.emc.ncep.noaa.gov/mmb/data_processing/',
     $ 'table_20.htm#0-20-012)'
     $/15X,'HOCB ..... Height of base of cloud (meters), 0-20-013'
     $/15X,'HOCT ..... Height of top  of cloud (meters), 0-20-014'
     $/15X,'AFIC ..... Airframe icing, Code Table 0-20-041'
     $/27X,'(see http://www.emc.ncep.noaa.gov/mmb/data_processing/',
     $ 'table_20.htm#0-20-041)'
     $/15X,'HBOI ..... Height of base of icing (meters), 0-24-194'
     $/15X,'HTOI ..... Height of top  of icing (meters), 0-24-195'
     $/15X,'DGOT ..... Degree of turbulence, Code Table 0-11-031'
     $/27X,'(see http://www.emc.ncep.noaa.gov/mmb/data_processing/',
     $ 'table_9-19.htm#0-11-031)'
     $/15X,'HBOT ..... Height of base of turbulence (meters), 0-11-032'
     $/15X,'HTOT ..... Height of top  of turbulence (meters), 0-11-033'/
     $/10X,'ADDIT-DATA (Category 8) "Levels", each of form "Swwwww xxx',
     $ ' yyyyy zzzzz" where S is the sign (+/-) and '
     $/11X,'xxx is code figure defined as follows:'
     $/15X,'xxx = 914 - wwwww = phase of aircraft flight {00002 - ',
     $ 'unsteady, 00003 - level flight (routine), 00004 - level flight'
     $/35X,'(highest wind encountered), 00005 - ascending, 00006 - ',
     $ 'descending, 00007 - missing}'
     $/15X,'xxx = 915 - wwwww = precision of temperature observation ',
     $ '(in 0.01 K)'
     $/15X,'xxx = 930 - wwwww = aircraft turbulence index (BUFR Code ',
     $ 'Table 0-11-235,'
     $/35X,'see http://www.emc.ncep.noaa.gov/mmb/data_processing/table',
     $ '_local_await-val.htm#0-11-235)'
     $/30X,'- zzzzz = turbulence index quality marker (00000 - monitor',
     $ ' keep, 00001 - good, 00002 - neutral/not'
     $/40X,'checked, 00003 - suspect, 00012 - toss, on reject list, ',
     $ '00013 - toss, failed automatic q.c.'
     $/40X,'tests, 00014 - toss, monitor purge)'
     $/15X,'xxx = 931 - wwwww = aircraft roll angle flag (00000 - roll',
     $ ' > 5 degrees, 00001 - roll </= 5 degrees, 00002 - not'
     $/35X,'reported, 00007 - missing)'
     $/15X,'xxx = 932 - Swwwww = instantaneous altitude rate (in 0.001',
     $ ' m/sec, + or -)'//)

      ELSE IF(DSNAME.EQ.'AIRCAR  ')  THEN
         PRINT 103
  103 FORMAT(//5X,'KEY FOR DATA LISTED IN EACH REPORT BELOW:'/
     $/10X,'Field  1 ....... ARINC MDCRS-ACARS: Tail number (encrypted)'
     $/10X,'                 AFWA  MDCRS-ACARS: Flight number'
     $/10X,'Field  2 ....... Observation time (UTC)'
     $/10X,'Field  3 ....... Latitude (N,S)'
     $/10X,'Field  4 ....... Longitude (E,W)'
     $/10X,'Field  5 ....... Pressure (x 10 mb)'
     $/10X,'Field  6 ....... Pressure altitude (meters)'
     $/10X,'Field  7 ....... Temperature (x 10 degrees C)'
     $/10X,'Field  8 ....... Specific humidity (g/kg)'
     $/10X,'Field  9 ....... Wind direction (degrees) / wind speed (x ',
     $ '10 m/sec)'
     $/10X,'Field 10 ....... Quality markers in form AABBCCDDEE, where',
     $ ' AA = pressure, BB = pressure altitude, CC = temperature,'
     $/28X,'DD = specific humidity, EE = wind (00 - monitor keep, 01 -',
     $ ' good, 02 - neutral/not checked, 03 - suspect,'
     $/28X,'12 - toss, on reject list, 13 - toss, failed automatic ',
     $ 'q.c. tests, 14 - toss, monitor purge)'
     $/28X,'Note: If quality marker is default value of 02 then "--" ',
     $ 'is stamped out here rather than "02"'
     $/10X,'RCT ............ Receipt time (UTC)'
     $/10X,'Next field ..... 20 character string enclosed in quotes:',
     $/27x,'   - Characters   1-6: WMO bulletin header',
     $/27x,'   - Characters  8-11: WMO bulletin originator',
     $/27x,'   - Characters 13-20: Flight number (encrypted)',
     $ ' (ARINC only)',
     $/10X,'RT ............. Dump report type / report subtype (report',
     $ ' type always 041 - aircraft; report subtype: 4 - ARINC'
     $/28X,'MDCRS-ACARS, 7 - AFWA MDCRS-ACARS)'
     $/10X,'IT ............. Instrument type (97 - Inertial navigation',
     $ ' system, 98 - OMEGA)'/
     $/10X,'BUFR mnemonics:'
     $/15X,'RSRD ..... Restrictions on redistribution, Flag Table 0-35',
     $ '-200 ('
     $/32X,' 16 - can redistribute to any U.S. government agency ',
     $ 'within NOAA,'
     $/32X,'128 - can redistribute to any U.S. government agency,'
     $/32X,'160 - can redistribute to any U.S. government agency or ',
     $ 'educational institution,'
     $/32X,'192 - can redistribute to any U.S. government agency or ',
     $ 'research group,'
     $/32X,'224 - can redistribute to any U.S. government agency, ',
     $ 'research group or educational institution,'
     $/32X,'256 - no redistribution allowed,'
     $/28X,'Missing - no retrictions on redistribution)'
     $/15X,'EXPRSRD .. Expiration of restrictions on redistribution ',
     $ '(hours), 0-35-201'
     $/15X,'MSTQ ..... Moisture quality, Code Table 0-33-026 ('
     $/32X,'  0 - normal operations - measurement mode,'
     $/32X,'  1 - normal operations - non-measurement mode,'
     $/32X,'  2 - small RH,'
     $/32X,'  3 - humidity element is wet,'
     $/32X,'  4 - humidity element contaminated,'
     $/32X,'  5 - heater fail,'
     $/32X,'  6 - heater fail and wet/contaminated humidity element,'
     $/32X,'  7 - at least one of the input parameters used in the ',
     $ 'calculation of mixing ratio is invalid,'
     $/32X,'  8 - numeric error,'
     $/32X,'  9 - sensor not installed,'
     $/30X,'10-62 - Reserved,'
     $/32X,' 63 - missing value)'/
     $/10X,'ADDIT-DATA (Category 8) "Levels", each of form "wwwww xxx ',
     $ 'yyyyy zzzzz" where xxx is code figure defined as follows:'
     $/15X,'xxx = 021 - wwwww = report sequence number (numeric)'
     $/15X,'xxx = 914 - wwwww = phase of aircraft flight {00002 - ',
     $ 'unsteady, 00003 - level flight (routine), 00004 - level flight'
     $/35X,'(highest wind encountered), 00005 - ascending, 00006 - ',
     $ 'descending, 00007 - missing}'
     $/15X,'xxx = 915 - wwwww = precision of temperature observation ',
     $ '(in 0.01 K)'
     $/15X,'xxx = 926 - wwwww = aircraft turbulence index for period ',
     $ 'T-1 minute to T-0 minute  (BUFR Code Table 0-11-236,'
     $/35X,'see http://www.emc.ncep.noaa.gov/mmb/data_processing/table',
     $ '_local_await-val.htm#0-11-236)'
     $/15X,'xxx = 927 - wwwww = aircraft turbulence index for period ',
     $ 'T-2 minute to T-1 minute  (BUFR Code Table 0-11-237,'
     $/35X,'see http://www.emc.ncep.noaa.gov/mmb/data_processing/table',
     $ '_local_await-val.htm#0-11-237)'
     $/15X,'xxx = 928 - wwwww = aircraft turbulence index for period ',
     $ 'T-3 minute to T-2 minute  (BUFR Code Table 0-11-238,'
     $/35X,'see http://www.emc.ncep.noaa.gov/mmb/data_processing/table',
     $ '_local_await-val.htm#0-11-238)'
     $/15X,'xxx = 929 - wwwww = aircraft turbulence index for period ',
     $ 'T-4 minute to T-3 minute  (BUFR Code Table 0-11-239,'
     $/35X,'see http://www.emc.ncep.noaa.gov/mmb/data_processing/table',
     $ '_local_await-val.htm#0-11-239)'//)

      ELSE IF(DSNAME.EQ.'SATWND  ')  THEN
         PRINT 104
  104 FORMAT(//5X,'KEY FOR DATA LISTED IN EACH REPORT BELOW:'/
     $/10X,'Field 1 ....... Report id'
     $/10X,'Field 2 ....... Observation time (UTC)'
     $/10X,'Field 3 ....... Latitude (N,S)'
     $/10X,'Field 4 ....... Longitude (E,W)'
     $/10X,'Field 5 ....... Pressure (x 10 mb)'
     $/10X,'Field 6 ....... Pressure altitude (meters)'
     $/10X,'Field 7 ....... Temperature (x 10 degrees C)'
     $/10X,'Field 8 ....... Wind direction (degrees) / wind speed (x ',
     $ '10 m/sec)'
     $/10X,'Field 9 ....... Quality markers in form AABBCCDD, where',
     $ ' AA = pressure, BB = pressure altitude, CC = temperature,'
     $/27X,'DD = wind (00 - monitor keep, 01 -',
     $ ' good, 02 - neutral/not checked, 03 - suspect,'
     $/27X,'12 - toss, on reject list, 13 - toss, failed automatic ',
     $ 'q.c. tests, 14 - toss, monitor purge)'
     $/27X,'Note: If quality marker is default value of 02 then "--" ',
     $ 'is stamped out here rather than "02"'
     $/10X,'RCT ........... Receipt time (UTC)'
     $/10X,'RES ........... Reserve characters 1 {Satellite ',
     $ 'wind producer ("1" - USA/NOAA/NESDIS, "4" - USA/NOAA/NWS, "5"',
     $ ' - USA/'
     $/27X,'university, "6" - USA/commercial, "7" - USA/DOD/NAVY, "8" ',
     $ '- USA/DOD/USAF, "9" - USA/NASA, "C" - '
     $/27X,'EUMETSAT, "D" - GMS (Japan), "E" - India)} and 3 ',
     $ '{Satellite wind deep layer moisture flag ("1" - deep'
     $/27X,'layer, "2" or blank - cloud top)} (Note: Reserve character',
     $ ' 2 is always blank and is not listed here)'
     $/10X,'RF ............ Percent confidence based on NESDIS ',
     $ 'Recursive Filter Function (numeric 0-100)'
     $/10X,'QI ............ Percent confidence based on EUMETSAT ',
     $ 'Quality Index with forecast (numeric 0-100)'
     $/10X,'QIn ........... Percent confidence based on EUMETSAT ',
     $ 'Quality Index without forecast (numeric 0-100)'
     $/10X,'EE ............ Percent confidence based on NESDIS ',
     $ 'Expected Error (numeric 0-100)'
     $/10X,'RT ............ Dump report type (report type always 41 -',
     $ ' satellite-derived wind)'
     $/10X,'IT ............ Instrument type:',
     $/29X,'01 - IR (long-wave) automated winds (low density),',
     $/29X,'02 - IR (long-wave) manual winds,',
     $/29X,'03 - Picture triplet (low density),',
     $/29X,'04 - Water vapor automated (low density),',
     $/29X,'05 - Visible manual,',
     $/29X,'06 - Visible automated (low density),',
     $/29X,'07 - Gradient winds,',
     $/29X,'08 - Picture pair (low density),',
     $/29X,'10 - AMSU/SSMI microwave winds,',
     $/29X,'11 - Scatterometer,',
     $/29X,'12 - Altimeter,',
     $/29X,'13 - LAWS,',
     $/29X,'14 - Water vapor sounder (high density), channel 10,',
     $/29X,'15 - Water vapor sounder (high density), channel 11,',
     $/29X,'16 - IR (long-wave) imager automated winds (high density),',
     $/29X,'17 - Visible imager automated winds (high density),',
     $/29X,'18 - Water vapor imager winds (high density),',
     $/29X,'19 - IR (short-wave) imager automated winds (high density)}'
     $/10X,'Last field .... Satellite id, BUFR Code Table 0-01-007'
     $/27X,'(see http://www.emc.ncep.noaa.gov/mmb/data_processing/',
     $ 'common_tbl_c1-c5.htm#c-5)'//)

      END IF

cpppppppppp
cc    PRINT'(" RETURN CODE =",I0,"; DATA SET INFORMATION RETURNED")',
cc   $ IER
cpppppppppp
c  1st dummy message in file is open, call iupvs01 to get iminu
      iminu = iupvs01(nunit,'MINU')
      IF(.NOT.GLOBAL)  THEN
         PRINT 6997, DSNAME,IDSDAT,iminu,IDSDMP_8,LATS/100.,LATN/100.,
     $       LONW/100.,LONE/100.
 6997 FORMAT(//22X,'--> DATA SET INFORMATION: NAME: ',A8,'; DATE: ',
     $ I10.10,i2.2,'; DUMP TIME: ',I12.12,' <--'//10X,'-- SELECTED ',
     $ 'DOMAIN FOR PROCESSING REPORTS: LATITUDE:',F7.2,' TO ',F7.2,
     $ ' N; LONGITUDE:',F8.2,' TO ',F8.2,' E --'//)
      ELSE
         PRINT 7997, DSNAME,IDSDAT,iminu,IDSDMP_8
 7997 FORMAT(//22X,'--> DATA SET INFORMATION: NAME: ',A8,'; DATE: ',
     $ I10.10,i2.2,'; DUMP TIME: ',I12.12,' <--'//10X,'-- SELECTED ',
     $ 'DOMAIN FOR PROCESSING REPORTS: ALL REPORTS IN DATA SET ',
     $ 'REGARDLESS OF LOCATION'//)
      END IF
      SORTID = (DSNAME.EQ.'ADPUPA  ')
      IF(ITWINB.LE.-600.AND.ITWINA.GE.600)  THEN
         KTIMCH = 0
         PRINT 6998
 6998 FORMAT(34X,'-- NO TIME WINDOW CONSTRAINT FOR PROCESSING REPORTS'/)
      ELSE
         KTIMCH = 1
         PRINT 6999, ITWINB,ITWINA
 6999 FORMAT(34X,'-- SELECTED TIME WINDOW FOR PROCESSING REPORTS:',2I6,
     $ ' --'/)
      END IF
      IFIND = 0
      DO  I = 0,255
         DO  J = 0,200
            IF(SUBSKP(I,J))  THEN
               IF(IFIND.EQ.0)  PRINT 7000
 7000 FORMAT(34X,'-- THE FOLLOWING BUFR MESSAGE TYPES/SUBTYPES WILL BE',
     $ ' SKIPPED:')
               PRINT 7001, I,J
 7001 FORMAT(45X,'BUFR TYPE ',I3.3,', SUBTYPE ',I3.3)
               IFIND = 1
            END IF
         ENDDO
      ENDDO
      IF(IFIND.EQ.0)  PRINT 7002
 7002 FORMAT(34X,'-- ALL BUFR MESSAGE TYPES/SUBTYPES IN DATA DUMP FILE',
     $ ' WILL BE PROCESSED')
      IF(SORTID)  PRINT 8002
 8002 FORMAT(/34X,'-- REPORTS WILL BE LISTED IN ORDER OF ASCENDING ',
     $ 'STATION ID,'/37X,'BUT FIRST A LISTING OF DIAGNOSTIC ',
     $ 'INFORMATION FROM BUFR DECODER (IW3UNPBF SUBROUTINE)'///130('+')
     $ //43X,'READING IN REPORTS AND STORING FOR LATER SORT'/)
      PRINT 7003
 7003 FORMAT(//)

      IF(KTIMCH.EQ.1)  THEN
         ICHR = MOD(IDSDAT,100)
cpppppppppp
cc       print'(" the cycle hour here is ")', ICHR
cpppppppppp

         ITMIN = (ICHR * 100) + ITWINB
         ITMAX = (ICHR * 100) + ITWINA
cpppppppppp
cc       print'(" ITMIN = ",I0,"; ITMAX = ",I0)', itmin,itmax
cpppppppppp
      END IF

      IF(IOPENED.EQ.1)  THEN
         IOPENED = 0
         GO TO 950
      END IF

      GO TO 905

C-----------------------------------------------------------------------

  920 CONTINUE
      PRINT 566, IER
  566 FORMAT('RETURN CODE =',I3,'; PHYSICAL END-OF-FILE - DONE')
      IF(SORTID)  THEN
         PRINT 8003
 8003 FORMAT(//130('+')//23X,'ALL REPORTS HAVE BEEN READ IN AND STORED',
     $ ' - NEXT SORT BY STATION ID AND BEGIN LISTING'//)
         GO TO 7050
      END IF

      GO TO 906

C-----------------------------------------------------------------------

  950 CONTINUE

      IF(IOPENED.EQ.1)  GO TO 910

      IF(KTIMCH.EQ.1)  THEN

C  DO A TIME CHECK IF TIME WINDOW CONSTRAINT INVOKED
C  -------------------------------------------------

         IDATA4 = NINT(ADATA(4) * 100.)
         IF(ICHR.EQ.18.AND.IDATA4.LE.0600)  THEN
            IDATA4 = IDATA4 + 2400
         ELSE IF(ICHR.EQ.00.AND.IDATA4.GE.1800)  THEN
            IDATA4 = IDATA4 - 2400
         ENDIF
cpppppppppp
cc       print'(" FOR THIS RPT, IDATA4 = ")', IDATA4
cpppppppppp
         IF(IDATA4.LT.ITMIN.OR.IDATA4.GT.ITMAX)  THEN
            KNTTIM = KNTTIM + 1
            PRINT 234, STNID,IDATA4,ITMIN,ITMAX
  234       FORMAT(/'####> Report ',A8,' SKIPPED - obs time ',I4.4,
     $       ' UTC is outside time window of ',I4.4,' to ',I4.4,' UTC'/)
            GO TO 905
         END IF

      END IF

      IDATA1 = NINT(ADATA(1) * 100.)
      IDATA2 = NINT(ADATA(2) * 100.)

      IF(.NOT.GLOBAL)  THEN

C  DO A DOMAIN CHECK IF GLOBAL DOMAIN NOT SELECTED
C  -----------------------------------------------

cpppppppppp
cc       print'(" FOR THIS RPT, IDATA1 = ",I0,"; IDATA2 = ",I0)',
cc   $    IDATA1,IDATA2
cpppppppppp
         IF(IDATA1.LT.LATS.OR.IDATA1.GT.LATN)  THEN
            KNTLAT = KNTLAT + 1
            GO TO 905
         END IF
         IF(IDATA2.LT.LONW.OR.IDATA2.GT.LONE)  THEN
            KNTLON = KNTLON + 1
            GO TO 905
         END IF

      END IF

      JJ = 0
      DO I = 29,45,2
         JJ = JJ + 1
         IF(IDATA(I).GT.0)  THEN

C-----------------------------------------------------------------------

            PRINT 998, ICAT(JJ)
            CALL W3TAGE('BUFR_LISTDUMPS')
            CALL ERREXIT(33)

C-----------------------------------------------------------------------

         END IF
      END DO
  998 FORMAT('**BUFR_LISTDUMPS/LISTUPA: CANNOT PROCESS DATA IN CAT.',I4,
     $ ' - STOP 33')

      KOUNT = KOUNT + 1

      IF(.NOT.SORTID)  GO TO 7060

C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C    ADPUPA REPORTS COME HERE FOR STORAGE BECAUSE THEY WILL BE SORTED
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

      IF(KOUNT.GT.20000)  THEN
         PRINT 8014
 8014 FORMAT('**BUFR_LISTDUMPS/LISTUPA: THERE ARE MORE THAN 20000 ',
     $ 'ADPUPA REPORTS - THIS EXCEEDS THE SORT LIMIT - STOP 55'/)
         CALL W3TAGE('BUFR_LISTDUMPS')
         CALL ERREXIT(55)
      END IF

      ADATA_S(:,KOUNT) = ADATA
      ADATA2_S(:,KOUNT) = ADATA2
      ADATA3_S(:,:,:,KOUNT) = ADATA3
      NDATA3_S(:,KOUNT) = NDATA3
      adata8_8_s(:,kount) = adata8_8
      STNID_S(KOUNT)  = STNID
      CRES1_S(KOUNT) = CRES1
      CRES2_S(KOUNT) = CRES2
      SUBSET_S(KOUNT) = SUBSET
      KEY_S(KOUNT) = STNID
C IF THIS IS A RECCO/DROP REPORT, FOOL SORT INTO PUTTING AT END OF FILE
      IF(IDATA(9).EQ.31)
     $ KEY_S(KOUNT) = 'ZZ'//STNID(1:6)
      GO TO 905
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

 7050 CONTINUE

C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C    ALL ADPUPA REPORTS HAVE BEEN STORED, TIME TO SORT BY STATION ID
C          AND THEN BEGIN PROCESS OF LISTING SORTED REPORTS
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

      CALL INDEXC(KOUNT,KEY_S,INDX)
      KNTOUT = 0

 8000 CONTINUE

      KNTOUT = KNTOUT + 1
      IF(KNTOUT.GT.KOUNT)  GO TO 906
      ADATA  = ADATA_S(:,INDX(KNTOUT))
      ADATA2 = ADATA2_S(:,INDX(KNTOUT))
      ADATA3 = ADATA3_S(:,:,:,INDX(KNTOUT))
      NDATA3 = NDATA3_S(:,INDX(KNTOUT))
      adata8_8 = adata8_8_s(:,INDX(KNTOUT))
      STNID  = STNID_S(INDX(KNTOUT))
      CRES1  = CRES1_S(INDX(KNTOUT))
      CRES2  = CRES2_S(INDX(KNTOUT))
      SUBSET  = SUBSET_S(INDX(KNTOUT))

C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

 7060 CONTINUE

C  CHANGE MISSING TO "BMISS" (REAL) OR 99999999 (INTEGER)
C   {MISSING DEFINED AS VALUE OF XMISS (99999.) FOR ALL PARMAMETERS
C   EXCEPT SEQUENCE NUMBER IN CAT. 8, CODE FIG. 21 WHERE IT IS DEFINED
C   AS 999999}
C  ---------------------------------------------------------------

C  Determine index pointing to sequence number in cat. 8, code fig. 21
C   if it is present (ISEQ_INDEX)
C  -------------------------------------------------------------------
      ISEQ_INDEX = 2*MAXOBS !initialize it as an unrealistically large #
      IF(IDATA(27).GT.0)  THEN
         L = IDATA(28) - 4
         DO I = 1,IDATA(27)
            L = L + 4
            IF(NINT(ADATA(L+1)).EQ.21)  THEN
               ISEQ_INDEX = L
               EXIT
            END IF
         END DO
      END IF

      DO I = 1,MAXOBS
         IF(I.EQ.ISEQ_INDEX) THEN

C  Come here if index points to the sequence # in cat. 8, code fig. 21
C  -------------------------------------------------------------------
            IF(ADATA(I).EQ.999999.)  ADATA(I) = BMISS
            IF(IDATA(I).EQ.999999)   IDATA(I) = 99999999
         ELSE

C  Otherwise come here
C  -------------------
            IF(ADATA(I).EQ.XMISS)  ADATA(I) = BMISS
            IF(IDATA(I).EQ.IMISS)  IDATA(I) = 99999999
         END IF
      END DO

      C1 = 'N'
      C2 = 'E'
      c1_8 = 'N'
      c2_8 = 'E'

      ALAT = ADATA(1)
      IF(NINT(ADATA(1)*100.).LT.0)  THEN
         ALAT = -ALAT
         C1 = 'S'
      END IF
      ALON = ADATA(2)
      IF(NINT(ADATA(2)*100.).GT.18000)  THEN
         ALON = 360.00 - ALON
         C2 = 'W'
      END IF
      alat_8 = adata8_8(1)
      if(adata8_8(1).lt.0.)  then
         alat_8 = -alat_8
         c1_8 = 'S'
      end if
      alon_8 = adata8_8(2)
      if(adata8_8(2).lt.0.)  then
         alon_8 = -alon_8
         c2_8 = 'W'
      end if

      IF(DSNAME.EQ.'SPSSMI  ')  THEN
         IF(IDATA(9).EQ.68)  THEN
            IF(IDATA(27).GT.0)  THEN

C  SSM/I 7-CHANNEL BRIGHTNESS TEMPERATURES IN CAT. 8
C  -------------------------------------------------

               IF(STNID(1:1).EQ.'S')  THEN
                  CRES = '# WRT AVG'
               ELSE
                  CRES = '         '
               END IF
               READ(CRES1(1:3),'(I3)') NUM
               N = IDATA(28) - 4
               DO NLVL = 1,IDATA(27)
                  N = N + 4
                  KNDX = -188 + NINT(ADATA(N+1))
                  IF(KNDX.GT.7)  EXIT
                  IF(ADATA(N).LT.99998.)  SRAD(KNDX) = ADATA(N)
               ENDDO
               PRINT 9777, STNID,ADATA(4),ALAT,C1,ALON,C2,
     $          NINT(ADATA(7)),CRES,NUM,IDATA(9),IDATA(8)
 9777 FORMAT(1X,A8,2X,F8.5,'Z',F7.2,A1,F8.2,A1,4X,'ELV',I4,3X,A9,1X,I3,
     $ 4X,'RPT TYP  ',I3.3,3X,'INST TYPE ',I2.2)
               PRINT 961, SRAD
  961 FORMAT(5X,'CHN.  1 -- BTEMP=',F8.2,'K;  CHN.  2 -- BTEMP=',F8.2,
     $ 'K;  CHN.  3 -- BTEMP=',F8.2,'K;  CHN.  4 -- BTEMP=',F8.2,'K'/5X,
     $ 'CHN.  5 -- BTEMP=',F8.2,'K;  CHN.  6 -- BTEMP=',F8.2,'K;  CHN.',
     $ '  7 -- BTEMP=',F8.2,'K')
            END IF

         ELSE  IF(IDATA(27).GT.0)  THEN

C  SSM/I WIND SPEED, PRECIP. WATER, RAIN RATE OR SFC TEMP DATA IN CAT. 8
C  ---------------------------------------------------------------------

            CDATUM = '??????'
            CUNITS = '????'
            N = IDATA(28) - 4
            SCALE  = 1.0
            DO NLVL = 1,IDATA(27)
               N = N + 4
               IF(NINT(ADATA(N+1)).EQ.196)  THEN
                  CDATUM = 'WSPD  '
                  CUNITS = 'M/S '
                  EXIT
               ELSE  IF(NINT(ADATA(N+1)).EQ.197)  THEN
                  CDATUM = 'PWATER'
                  CUNITS = 'MM  '
                  EXIT
               ELSE  IF(NINT(ADATA(N+1)).EQ.198)  THEN
                  CDATUM = 'RRATE '
                  CUNITS = 'MM/H'
                  SCALE  = 3600.
                  EXIT
               ELSE  IF(NINT(ADATA(N+1)).EQ.199)  THEN
                  CDATUM = 'SFTEMP'
                  CUNITS = 'K   '
                  EXIT
               END IF
            END DO
            IF(CDATUM.EQ.'??????')  THEN
               GO TO 5689
            ELSE
               IF(STNID(1:1).EQ.'S')  THEN
                  CRES = '# WRT AVG'
               ELSE
                  CRES = 'RAIN FLAG'
               END IF
               IF(ADATA(N).LT.XMISS)   ADATA(N) = ADATA(N)*SCALE
               IF(ADATA(N+2).LT.XMISS) ADATA(N+2) = ADATA(N+2)*SCALE
               READ(CRES1(1:3),'(I3)') NUM
               PRINT 777, STNID,ADATA(4),ALAT,C1,ALON,C2,
     $          NINT(ADATA(7)),CDATUM,ADATA(N),CUNITS,ADATA(N+2),CUNITS,
     $          CRES,NUM,IDATA(9),IDATA(8)
  777 FORMAT(1X,A8,2X,F8.5,'Z',F7.2,A1,F8.2,A1,4X,'ELV',I4,3X,A6,1X,
     $ F6.2,A4,2X,'STDV ',F6.2,A4,3X,A9,1X,I3,4X,'RPT TYP  ',I3.3,3X,
     $ 'INST TYPE ',I2.2)
            END IF
         END IF

         GO TO 905

      END IF

      IF(DSNAME.EQ.'SATWND  ')  THEN
         IF(IDATA(23).GT.0)  THEN

C  SATWND (CAT. 6) DATA WITH RFF, QI (W/ FCST), QI (W/O FCST) IN CAT. 8
C  --------------------------------------------------------------------

            IRFF = 99999999
            IQI  = 99999999
            IQIN = 99999999
            IEEF = 99999999

            IF(IDATA(27).GT.0)  THEN
               N = IDATA(28) - 4
               DO NLVL = 1,IDATA(27)
                  N = N + 4
                  IF(NINT(ADATA(N+1)).EQ.355) THEN
                     IRFF = NINT(ADATA(N))
                     CYCLE
                  ELSE IF(NINT(ADATA(N+1)).EQ.356) THEN
                     IQI  = NINT(ADATA(N))
                     CYCLE
                  ELSE IF(NINT(ADATA(N+1)).EQ.357) THEN
                     IQIN = NINT(ADATA(N))
                     CYCLE
                  ELSE IF(NINT(ADATA(N+1)).EQ.358) THEN
                     IEEF = NINT(ADATA(N))
                     CYCLE
                  END IF
               ENDDO
            END IF

            IALT = 99999999
            N = IDATA(24)
            CQM = '--'
            DO  II=1,5
               IF(NINT(ADATA(N+5+II)).NE.2)
     $          WRITE(CQM(II,1),'(I2.2)') NINT(ADATA(N+5+II))
            ENDDO

            if(subset(6:7).eq.'03') then
            print 878, stnid,adata(4),alat,c1,alon,c2,nint(adata(n)),
     $       (nint(adata(n+ii)),ii=1,2),(nint(adata(n+ii)),ii=4,5),
     $       (cqm(ii,1),ii=1,3),cqm(5,1),adata(11),cres1(1:1),
     $       cres1(3:3),irff,iqi,iqin,ieef,adata2(43),idata(9),idata(8),
     $       idata(6)
  878 FORMAT(A8,1X,F5.2,F9.5,A1,F10.5,A1,1X,I5.5,I6.5,1X,I4.3,1X,
     $ I3.3,'/',I4.4,1X,4A2,' RCT ',F5.2,' RES ',2A1,' RF',I3.2,
     $ ' QI',I3.2,' QIn',I3.2,' EE',I3.2,' ZA',F7.2,' RT',I3,' IT',I3.2,
     $ ' ',I3)
            else
            PRINT 877, STNID,ADATA(4),ALAT,C1,ALON,C2,NINT(ADATA(N)),
     $       (NINT(ADATA(N+II)),II=1,2),(NINT(ADATA(N+II)),II=4,5),
     $       (CQM(II,1),II=1,3),CQM(5,1),ADATA(11),CRES1(1:1),
     $       CRES1(3:3),IRFF,IQI,IQIN,IEEF,ADATA2(43),IDATA(9),IDATA(8),
     $       IDATA(6)
  877 FORMAT(A8,1X,F5.2,F6.2,3x,A1,F7.2,3x,A1,1X,I5.5,I6.5,1X,I4.3,1X,
     $ I3.3,'/',I4.4,1X,4A2,' RCT ',F5.2,' RES ',2A1,' RF',I3.2,
     $ ' QI',I3.2,' QIn',I3.2,' EE',I3.2,' ZA',F7.2,' RT',I3,' IT',I3.2,
     $ ' ',I3)
            end if

            GO TO 905

         END IF

      END IF

 5689 CONTINUE

      IF(IDATA(23).GT.0)  THEN

C  CATEGORY 6
C  ----------

         IALT = 99999999
         N = IDATA(24)
         CQM = '--'
         DO  II=1,5
            IF(NINT(ADATA(N+5+II)).NE.2)
     $       WRITE(CQM(II,1),'(I2.2)') NINT(ADATA(N+5+II))
         ENDDO

C SPECIAL PROCESSING FOR CAT. 6 DATA

         IF(DSNAME.EQ.'AIRCFT  '.OR.DSNAME.EQ.'AIRCAR  ') THEN
            if(subset.eq.'NC004010') cbull = cres1//'   '
            PRINT 977, STNID,ADATA(4),alat_8,c1_8,alon_8,c2_8,
     $       NINT(ADATA(N)),(NINT(ADATA(N+II)),II=1,2),ADATA(N+3),
     $       (NINT(ADATA(N+II)),II=4,5),(CQM(II,1),II=1,5),ADATA(11),
     $       CBULL,CRES2,IDATA(9),IDATA(10),IDATA(8)
  977 FORMAT(1X,A8,2X,F8.5,'Z',F10.5,A1,F11.5,A1,1X,I5.5,1X,I6.5,1X,
     $ I4.3,1X,F9.6,1X,I3.3,'/',I4.4,1X,5A2,' RCT ',F5.2,'Z',' "',A11,
     $ 1X,A8,'" RT',I3,'/',I3,' IT',I3.2)
         ELSE
            PRINT 77, STNID,ADATA(4),alat_8,c1_8,alon_8,c2_8,
     $       NINT(ADATA(N)),(NINT(ADATA(N+II)),II=1,2),ADATA(N+3),
     $       (NINT(ADATA(N+II)),II=4,5),(CQM(II,1),II=1,5),ADATA(11),
     $       CRES1,CRES2,IDATA(9),IDATA(10),IDATA(8)
   77 FORMAT(1X,A8,2X,F8.5,'Z',F10.5,A1,F11.5,A1,1X,I5.5,1X,I6.5,1X,
     $ I4.3,1X,F9.6,1X,I3.3,'/',I4.4,1X,5A2,' RCT ',F5.2,'Z','  RES "',
     $ 2A8,'" RT',I3,'/',I3,' IT',I3.2)
         END IF


      ELSE
         PRINT 7, STNID,ADATA(4),alat_8,c1_8,alon_8,c2_8,NINT(ADATA(7)),
     $    IDATA(8),IDATA(9)
    7 FORMAT(1X,A8,1X,F9.5,'Z',3X,F11.5,A1,2X,F11.5,A1,'    ELEVATION',
     $3X,I6.5,'M',10X,'INST TYPE   ',I5.3,12X,'RPT TYPE',I4.3)
      END IF

      IF(IDATA(13).GT.0)  THEN

C  CATEGORY 1
C  ----------

         IADPUP = 1
         N = IDATA(14) - 33
         J = 0
         DO NLVL = 1,IDATA(13),3
            J = J + 1
            N = N + 33
            IF(NLVL+1.GT.IDATA(13))  THEN
               CQM = '--'
               DO  II=1,5
                  IF(NINT(ADATA(N+5+II)).NE.2)
     $             WRITE(CQM(II,1),'(I2.2)') NINT(ADATA(N+5+II))
               ENDDO
               PRINT 7051, CCAT1(J),NINT(ADATA(N)*.1),
     $          (NINT(ADATA(N+II)),II=1,5),(CQM(II,1),II=1,5)
 7051          FORMAT(4X,A4,1X,2X,I4,1X,I5.4,1X,I4.3,1X,I3.3,1X,I3.3,
     $          '/',I4.4,1X,5A2)
            ELSE  IF(NLVL+2.GT.IDATA(13))  THEN
               CQM = '--'
               DO  II=1,5
                  IF(NINT(ADATA(N+5+II)).NE.2)
     $             WRITE(CQM(II,1),'(I2.2)') NINT(ADATA(N+5+II))
               ENDDO
               DO  II=1,5
                  IF(NINT(ADATA(N+11+5+II)).NE.2)
     $             WRITE(CQM(II,2),'(I2.2)') NINT(ADATA(N+11+5+II))
               ENDDO
               PRINT 7052, CCAT1(J),NINT(ADATA(N)*.1),
     $          (NINT(ADATA(N+II)),II=1,5),(CQM(II,1),II=1,5),
     $          NINT(ADATA(N+11)*.1),(NINT(ADATA(N+11+II)),II=1,5),
     $          (CQM(II,2),II=1,5)
 7052          FORMAT(4X,A4,1X,2(2X,I4,1X,I5.4,1X,I4.3,1X,I3.3,1X,I3.3,
     $          '/',I4.4,1X,5A2))
            ELSE
               CQM = '--'
               DO  II=1,5
                  IF(NINT(ADATA(N+5+II)).NE.2)
     $             WRITE(CQM(II,1),'(I2.2)') NINT(ADATA(N+5+II))
               ENDDO
               DO  II=1,5
                  IF(NINT(ADATA(N+11+5+II)).NE.2)
     $             WRITE(CQM(II,2),'(I2.2)') NINT(ADATA(N+11+5+II))
               ENDDO
               DO  II=1,5
                  IF(NINT(ADATA(N+22+5+II)).NE.2)
     $             WRITE(CQM(II,3),'(I2.2)') NINT(ADATA(N+22+5+II))
               ENDDO
               PRINT 7053, CCAT1(J),NINT(ADATA(N)*.1),
     $          (NINT(ADATA(N+II)),II=1,5),(CQM(II,1),II=1,5),
     $          NINT(ADATA(N+11)*.1),(NINT(ADATA(N+11+II)),II=1,5),
     $          (CQM(II,2),II=1,5),NINT(ADATA(N+22)*.1),
     $          (NINT(ADATA(N+22+II)),II=1,5),(CQM(II,3),II=1,5)
 7053          FORMAT(4X,A4,1X,3(2X,I4,1X,I5.4,1X,I4.3,1X,I3.3,1X,I3.3,
     $          '/',I4.4,1X,5A2))
            END IF
         END DO
      END IF

      IF(IDATA(15).GT.0)  THEN

C  CATEGORY 2
C  ----------

         IADPUP = 1
         N = IDATA(16) - 28
         J = 0
         DO NLVL = 1,IDATA(15),4
            J = J + 1
            N = N + 28
            IF(NLVL+1.GT.IDATA(15))  THEN
               WRITE(CIND1,'(I2.2)') NINT(ADATA(N+6))
               IF(CIND1.EQ.'00')  CIND1 = '  '
               CQM = '--'
               DO  II=1,3
                  IF(NINT(ADATA(N+2+II)).NE.2)
     $             WRITE(CQM(II,1),'(I2.2)') NINT(ADATA(N+2+II))
               ENDDO
               PRINT 7061, CCAT2(J),CIND1,NINT(ADATA(N)),
     $          (NINT(ADATA(N+II)),II=1,2),(CQM(II,1),II=1,3)
 7061          FORMAT(4X,A5,3X,A2,1X,I5.5,1X,I4.3,1X,I3.3,1X,3A2,1X)
            ELSE  IF(NLVL+2.GT.IDATA(15))  THEN
               WRITE(CIND1,'(I2.2)') NINT(ADATA(N+6))
               IF(CIND1.EQ.'00')  CIND1 = '  '
               WRITE(CIND2,'(I2.2)') NINT(ADATA(N+7+6))
               IF(CIND2.EQ.'00')  CIND2 = '  '
               CQM = '--'
               DO  II=1,3
                  IF(NINT(ADATA(N+2+II)).NE.2)
     $             WRITE(CQM(II,1),'(I2.2)') NINT(ADATA(N+2+II))
               ENDDO
               DO  II=1,3
                  IF(NINT(ADATA(N+2+7+II)).NE.2)
     $             WRITE(CQM(II,2),'(I2.2)') NINT(ADATA(N+2+7+II))
               ENDDO
               PRINT 7062, CCAT2(J),CIND1,NINT(ADATA(N)),
     $          (NINT(ADATA(N+II)),II=1,2),(CQM(II,1),II=1,3),CIND2,
     $          NINT(ADATA(N+7)),(NINT(ADATA(N+7+II)),II=1,2),
     $          (CQM(II,2),II=1,3)
 7062          FORMAT(4X,A5,2(3X,A2,1X,I5.5,1X,I4.3,1X,I3.3,1X,3A2,
     $          1X))
            ELSE  IF(NLVL+3.GT.IDATA(15))  THEN
               WRITE(CIND1,'(I2.2)') NINT(ADATA(N+6))
               IF(CIND1.EQ.'00')  CIND1 = '  '
               WRITE(CIND2,'(I2.2)') NINT(ADATA(N+7+6))
               IF(CIND2.EQ.'00')  CIND2 = '  '
               WRITE(CIND3,'(I2.2)') NINT(ADATA(N+14+6))
               IF(CIND3.EQ.'00')  CIND3 = '  '
               CQM = '--'
               DO  II=1,3
                  IF(NINT(ADATA(N+2+II)).NE.2)
     $             WRITE(CQM(II,1),'(I2.2)') NINT(ADATA(N+2+II))
               ENDDO
               DO  II=1,3
                  IF(NINT(ADATA(N+2+7+II)).NE.2)
     $             WRITE(CQM(II,2),'(I2.2)') NINT(ADATA(N+2+7+II))
               ENDDO
               DO  II=1,3
                  IF(NINT(ADATA(N+2+14+II)).NE.2)
     $             WRITE(CQM(II,3),'(I2.2)') NINT(ADATA(N+2+14+II))
               ENDDO
               PRINT 7063, CCAT2(J),CIND1,NINT(ADATA(N)),
     $          (NINT(ADATA(N+II)),II=1,2),(CQM(II,1),II=1,3),CIND2,
     $          NINT(ADATA(N+7)),(NINT(ADATA(N+7+II)),II=1,2),
     $          (CQM(II,2),II=1,3),CIND3,NINT(ADATA(N+14)),
     $          (NINT(ADATA(N+14+II)),II=1,2),(CQM(II,3),II=1,3)
 7063          FORMAT(4X,A5,3(3X,A2,1X,I5.5,1X,I4.3,1X,I3.3,1X,3A2,
     $          1X))
            ELSE
               WRITE(CIND1,'(I2.2)') NINT(ADATA(N+6))
               IF(CIND1.EQ.'00')  CIND1 = '  '
               WRITE(CIND2,'(I2.2)') NINT(ADATA(N+7+6))
               IF(CIND2.EQ.'00')  CIND2 = '  '
               WRITE(CIND3,'(I2.2)') NINT(ADATA(N+14+6))
               IF(CIND3.EQ.'00')  CIND3 = '  '
               WRITE(CIND4,'(I2.2)') NINT(ADATA(N+21+6))
               IF(CIND4.EQ.'00')  CIND4 = '  '
               CQM = '--'
               DO  II=1,3
                  IF(NINT(ADATA(N+2+II)).NE.2)
     $             WRITE(CQM(II,1),'(I2.2)') NINT(ADATA(N+2+II))
               ENDDO
               DO  II=1,3
                  IF(NINT(ADATA(N+2+7+II)).NE.2)
     $             WRITE(CQM(II,2),'(I2.2)') NINT(ADATA(N+2+7+II))
               ENDDO
               DO  II=1,3
                  IF(NINT(ADATA(N+2+14+II)).NE.2)
     $             WRITE(CQM(II,3),'(I2.2)') NINT(ADATA(N+2+14+II))
               ENDDO
               DO  II=1,3
                  IF(NINT(ADATA(N+2+21+II)).NE.2)
     $             WRITE(CQM(II,4),'(I2.2)') NINT(ADATA(N+2+21+II))
               ENDDO
               PRINT 7064, CCAT2(J),CIND1,NINT(ADATA(N)),
     $          (NINT(ADATA(N+II)),II=1,2),(CQM(II,1),II=1,3),CIND2,
     $          NINT(ADATA(N+7)),(NINT(ADATA(N+7+II)),II=1,2),
     $          (CQM(II,2),II=1,3),CIND3,NINT(ADATA(N+14)),
     $          (NINT(ADATA(N+14+II)),II=1,2),(CQM(II,3),II=1,3),CIND4,
     $          NINT(ADATA(N+21)),(NINT(ADATA(N+21+II)),II=1,2),
     $          (CQM(II,4),II=1,3)
 7064          FORMAT(4X,A5,4(3X,A2,1X,I5.5,1X,I4.3,1X,I3.3,1X,3A2,
     $          1X))
            END IF
         END DO
      END IF

      IF(IDATA(17).GT.0)  THEN

C  CATEGORY 3
C  ----------

         IADPUP = 1
         N = IDATA(18) - 24
         J = 0
         DO NLVL = 1,IDATA(17),4
            J = J + 1
            N = N + 24
            IF(NLVL+1.GT.IDATA(17))  THEN
               WRITE(CIND1,'(I2.2)') NINT(ADATA(N+5))
               IF(CIND1.EQ.'00')  CIND1 = '  '
               CQM = '--'
               DO  II=1,2
                  IF(NINT(ADATA(N+2+II)).NE.2)
     $             WRITE(CQM(II,1),'(I2.2)') NINT(ADATA(N+2+II))
               ENDDO
               PRINT 7071, CCAT3(J),CIND1,NINT(ADATA(N)),
     $          (NINT(ADATA(N+II)),II=1,2),(CQM(II,1),II=1,2)
 7071          FORMAT(4X,A5,3X,A2,1X,I5.5,1X,I3.3,'/',I4.4,1X,2A2,3X)
            ELSE  IF(NLVL+2.GT.IDATA(17))  THEN
               WRITE(CIND1,'(I2.2)') NINT(ADATA(N+5))
               IF(CIND1.EQ.'00')  CIND1 = '  '
               WRITE(CIND2,'(I2.2)') NINT(ADATA(N+6+5))
               IF(CIND2.EQ.'00')  CIND2 = '  '
               CQM = '--'
               DO  II=1,2
                  IF(NINT(ADATA(N+2+II)).NE.2)
     $             WRITE(CQM(II,1),'(I2.2)') NINT(ADATA(N+2+II))
               ENDDO
               DO  II=1,2
                  IF(NINT(ADATA(N+2+6+II)).NE.2)
     $             WRITE(CQM(II,2),'(I2.2)') NINT(ADATA(N+2+6+II))
               ENDDO
               PRINT 7072, CCAT3(J),CIND1,NINT(ADATA(N)),
     $          (NINT(ADATA(N+II)),II=1,2),(CQM(II,1),II=1,2),CIND2,
     $          NINT(ADATA(N+6)),(NINT(ADATA(N+6+II)),II=1,2),
     $          (CQM(II,2),II=1,2)
 7072          FORMAT(4X,A5,2(3X,A2,1X,I5.5,1X,I3.3,'/',I4.4,1X,
     $          2A2,3X))
            ELSE  IF(NLVL+3.GT.IDATA(17))  THEN
               WRITE(CIND1,'(I2.2)') NINT(ADATA(N+5))
               IF(CIND1.EQ.'00')  CIND1 = '  '
               WRITE(CIND2,'(I2.2)') NINT(ADATA(N+6+5))
               IF(CIND2.EQ.'00')  CIND2 = '  '
               WRITE(CIND3,'(I2.2)') NINT(ADATA(N+12+5))
               IF(CIND3.EQ.'00')  CIND3 = '  '
               CQM = '--'
               DO  II=1,2
                  IF(NINT(ADATA(N+2+II)).NE.2)
     $             WRITE(CQM(II,1),'(I2.2)') NINT(ADATA(N+2+II))
               ENDDO
               DO  II=1,2
                  IF(NINT(ADATA(N+2+6+II)).NE.2)
     $             WRITE(CQM(II,2),'(I2.2)') NINT(ADATA(N+2+6+II))
               ENDDO
               DO  II=1,2
                  IF(NINT(ADATA(N+2+12+II)).NE.2)
     $             WRITE(CQM(II,3),'(I2.2)') NINT(ADATA(N+2+12+II))
               ENDDO
               PRINT 7073, CCAT3(J),CIND1,NINT(ADATA(N)),
     $          (NINT(ADATA(N+II)),II=1,2),(CQM(II,1),II=1,2),CIND2,
     $          NINT(ADATA(N+6)),(NINT(ADATA(N+6+II)),II=1,2),
     $          (CQM(II,2),II=1,2),CIND3,NINT(ADATA(N+12)),
     $          (NINT(ADATA(N+12+II)),II=1,2),(CQM(II,3),II=1,2)
 7073          FORMAT(4X,A5,3(3X,A2,1X,I5.5,1X,I3.3,'/',I4.4,1X,
     $          2A2,3X))
            ELSE
               WRITE(CIND1,'(I2.2)') NINT(ADATA(N+5))
               IF(CIND1.EQ.'00')  CIND1 = '  '
               WRITE(CIND2,'(I2.2)') NINT(ADATA(N+6+5))
               IF(CIND2.EQ.'00')  CIND2 = '  '
               WRITE(CIND3,'(I2.2)') NINT(ADATA(N+12+5))
               IF(CIND3.EQ.'00')  CIND3 = '  '
               WRITE(CIND4,'(I2.2)') NINT(ADATA(N+18+5))
               IF(CIND4.EQ.'00')  CIND4 = '  '
               CQM = '--'
               DO  II=1,2
                  IF(NINT(ADATA(N+2+II)).NE.2)
     $             WRITE(CQM(II,1),'(I2.2)') NINT(ADATA(N+2+II))
               ENDDO
               DO  II=1,2
                  IF(NINT(ADATA(N+2+6+II)).NE.2)
     $             WRITE(CQM(II,2),'(I2.2)') NINT(ADATA(N+2+6+II))
               ENDDO
               DO  II=1,2
                  IF(NINT(ADATA(N+2+12+II)).NE.2)
     $             WRITE(CQM(II,3),'(I2.2)') NINT(ADATA(N+2+12+II))
               ENDDO
               DO  II=1,2
                  IF(NINT(ADATA(N+2+18+II)).NE.2)
     $             WRITE(CQM(II,4),'(I2.2)') NINT(ADATA(N+2+18+II))
               ENDDO
               PRINT 7074, CCAT3(J),CIND1,NINT(ADATA(N)),
     $          (NINT(ADATA(N+II)),II=1,2),(CQM(II,1),II=1,2),CIND2,
     $          NINT(ADATA(N+6)),(NINT(ADATA(N+6+II)),II=1,2),
     $          (CQM(II,2),II=1,2),CIND3,NINT(ADATA(N+12)),
     $          (NINT(ADATA(N+12+II)),II=1,2),(CQM(II,3),II=1,2),CIND4,
     $          NINT(ADATA(N+18)),(NINT(ADATA(N+18+II)),II=1,2),
     $          (CQM(II,4),II=1,2)
 7074          FORMAT(4X,A5,4(3X,A2,1X,I5.5,1X,I3.3,'/',I4.4,1X,
     $          2A2,3X))
            END IF
         END DO
      END IF

      IF(IDATA(19).GT.0)  THEN

C  CATEGORY 4
C  ----------

         IADPUP = 1
         N = IDATA(20) - 20
         J = 0
         DO NLVL = 1,IDATA(19),4
            J = J + 1
            N = N + 20
            IF(NLVL+1.GT.IDATA(19))  THEN
               CQM = '--'
               DO  II=1,2
                  IF(NINT(ADATA(N+2+II)).NE.2)
     $             WRITE(CQM(II,1),'(I2.2)') NINT(ADATA(N+2+II))
               ENDDO
               PRINT 7101, CCAT4(J),NINT(ADATA(N)),
     $          (NINT(ADATA(N+II)),II=1,2),(CQM(II,1),II=1,2)
 7101          FORMAT(4X,A5,6X,I5.5,1X,I3.3,'/',I4.4,1X,2A2,3X)
            ELSE  IF(NLVL+2.GT.IDATA(19))  THEN
               CQM = '--'
               DO  II=1,2
                  IF(NINT(ADATA(N+2+II)).NE.2)
     $             WRITE(CQM(II,1),'(I2.2)') NINT(ADATA(N+2+II))
               ENDDO
               DO  II=1,2
                  IF(NINT(ADATA(N+2+5+II)).NE.2)
     $             WRITE(CQM(II,2),'(I2.2)') NINT(ADATA(N+2+5+II))
               ENDDO
               PRINT 7102, CCAT4(J),NINT(ADATA(N)),
     $          (NINT(ADATA(N+II)),II=1,2),(CQM(II,1),II=1,2),
     $          NINT(ADATA(N+5)),(NINT(ADATA(N+5+II)),II=1,2),
     $          (CQM(II,2),II=1,2)
 7102          FORMAT(4X,A5,2(6X,I5.5,1X,I3.3,'/',I4.4,1X,2A2,3X))
            ELSE  IF(NLVL+3.GT.IDATA(19))  THEN
               CQM = '--'
               DO  II=1,2
                  IF(NINT(ADATA(N+2+II)).NE.2)
     $             WRITE(CQM(II,1),'(I2.2)') NINT(ADATA(N+2+II))
               ENDDO
               DO  II=1,2
                  IF(NINT(ADATA(N+2+5+II)).NE.2)
     $             WRITE(CQM(II,2),'(I2.2)') NINT(ADATA(N+2+5+II))
               ENDDO
               DO  II=1,2
                  IF(NINT(ADATA(N+2+10+II)).NE.2)
     $             WRITE(CQM(II,3),'(I2.2)') NINT(ADATA(N+2+10+II))
               ENDDO
               PRINT 7103, CCAT4(J),NINT(ADATA(N)),
     $          (NINT(ADATA(N+II)),II=1,2),(CQM(II,1),II=1,2),
     $          NINT(ADATA(N+5)),(NINT(ADATA(N+5+II)),II=1,2),
     $          (CQM(II,2),II=1,2),NINT(ADATA(N+10)),
     $          (NINT(ADATA(N+10+II)),II=1,2),(CQM(II,3),II=1,2)
 7103          FORMAT(4X,A5,3(6X,I5.5,1X,I3.3,'/',I4.4,1X,2A2,3X))
            ELSE
               CQM = '--'
               DO  II=1,2
                  IF(NINT(ADATA(N+2+II)).NE.2)
     $             WRITE(CQM(II,1),'(I2.2)') NINT(ADATA(N+2+II))
               ENDDO
               DO  II=1,2
                  IF(NINT(ADATA(N+2+5+II)).NE.2)
     $             WRITE(CQM(II,2),'(I2.2)') NINT(ADATA(N+2+5+II))
               ENDDO
               DO  II=1,2
                  IF(NINT(ADATA(N+2+10+II)).NE.2)
     $             WRITE(CQM(II,3),'(I2.2)') NINT(ADATA(N+2+10+II))
               ENDDO
               DO  II=1,2
                  IF(NINT(ADATA(N+2+15+II)).NE.2)
     $             WRITE(CQM(II,4),'(I2.2)') NINT(ADATA(N+2+15+II))
               ENDDO
               PRINT 7104, CCAT4(J),NINT(ADATA(N)),
     $          (NINT(ADATA(N+II)),II=1,2),(CQM(II,1),II=1,2),
     $          NINT(ADATA(N+5)),(NINT(ADATA(N+5+II)),II=1,2),
     $          (CQM(II,2),II=1,2),NINT(ADATA(N+10)),
     $          (NINT(ADATA(N+10+II)),II=1,2),(CQM(II,3),II=1,2),
     $          NINT(ADATA(N+15)),(NINT(ADATA(N+15+II)),II=1,2),
     $          (CQM(II,4),II=1,2)
 7104          FORMAT(4X,A5,4(6X,I5.5,1X,I3.3,'/',I4.4,1X,2A2,3X))
            END IF
         END DO
      END IF

      IF(IDATA(21).GT.0)  THEN

C  CATEGORY 5
C  ----------

         IADPUP = 1
         N = IDATA(22) - 27
         J = 0
         DO NLVL = 1,IDATA(21),3
            J = J + 1
            N = N + 27
            IF(NLVL+1.GT.IDATA(21))  THEN
               CQM = '--'
               DO  II=1,4
                  IF(NINT(ADATA(N+4+II)).NE.2)
     $             WRITE(CQM(II,1),'(I2.2)') NINT(ADATA(N+4+II))
               ENDDO
               PRINT 7081, CCAT5(J),NINT(ADATA(N)),
     $          (NINT(ADATA(N+II)),II=1,4),(CQM(II,1),II=1,4)
 7081          FORMAT(4X,A10,1X,I5.5,1X,I4.3,1X,I3.3,1X,I3.3,'/',I4.4,
     $          1X,4A2,3X)
            ELSE  IF(NLVL+2.GT.IDATA(21))  THEN
               CQM = '--'
               DO  II=1,4
                  IF(NINT(ADATA(N+4+II)).NE.2)
     $             WRITE(CQM(II,1),'(I2.2)') NINT(ADATA(N+4+II))
               ENDDO
               DO  II=1,4
                  IF(NINT(ADATA(N+4+9+II)).NE.2)
     $             WRITE(CQM(II,2),'(I2.2)') NINT(ADATA(N+4+9+II))
               ENDDO
               PRINT 7082, CCAT5(J),NINT(ADATA(N)),
     $          (NINT(ADATA(N+II)),II=1,4),(CQM(II,1),II=1,4),
     $          NINT(ADATA(N+9)),(NINT(ADATA(N+9+II)),II=1,4),
     $          (CQM(II,2),II=1,4)
 7082          FORMAT(4X,A10,1X,2(I5.5,1X,I4.3,1X,I3.3,1X,I3.3,'/',I4.4,
     $          1X,4A2,3X))
            ELSE
               CQM = '--'
               DO  II=1,4
                  IF(NINT(ADATA(N+4+II)).NE.2)
     $             WRITE(CQM(II,1),'(I2.2)') NINT(ADATA(N+4+II))
               ENDDO
               DO  II=1,4
                  IF(NINT(ADATA(N+4+9+II)).NE.2)
     $             WRITE(CQM(II,2),'(I2.2)') NINT(ADATA(N+4+9+II))
               ENDDO
               DO  II=1,4
                  IF(NINT(ADATA(N+4+18+II)).NE.2)
     $             WRITE(CQM(II,3),'(I2.2)') NINT(ADATA(N+4+18+II))
               ENDDO
               PRINT 7083, CCAT5(J),NINT(ADATA(N)),
     $          (NINT(ADATA(N+II)),II=1,4),(CQM(II,1),II=1,4),
     $          NINT(ADATA(N+9)),(NINT(ADATA(N+9+II)),II=1,4),
     $          (CQM(II,2),II=1,4),NINT(ADATA(N+18)),
     $          (NINT(ADATA(N+18+II)),II=1,4),(CQM(II,3),II=1,4)
 7083          FORMAT(4X,A10,1X,3(I5.5,1X,I4.3,1X,I3.3,1X,I3.3,'/',I4.4,
     $          1X,4A2,3X))
            END IF
         END DO
      END IF

      IF(IDATA(27).GT.0)  THEN

C  CATEGORY 8
C  ----------

         N = IDATA(28) - 16
         J = 0
         DO NLVL = 1,IDATA(27),4
            J = J + 1
            N = N + 16
            IF(NLVL+1.GT.IDATA(27))  THEN
               IF(ADATA(N+1).EQ.21)  THEN
C  Allow report sequence number (code fig. 21) to be as large as 999999
C  --------------------------------------------------------------------
                  ADATA(N) = MIN(ADATA(N),999999.)
               ELSE
C  All other cat. 8 parameters can only be as large as XMISS (99999.)
C  ------------------------------------------------------------------
                  ADATA(N) = MIN(ADATA(N),XMISS)
               END IF
               PRINT 7091,CCAT8(J),NINT(ADATA(N)),
     $          (NINT(ADATA(N+II)),II=1,3)
 7091          FORMAT(4X,A11,I6.5,1X,I3.3,2(1X,I5.5),3X)
            ELSE  IF(NLVL+2.GT.IDATA(27))  THEN
               DO II = 4,8,4
                  IF(ADATA(N-4+II+1).EQ.21)  THEN
C  Allow report sequence number (code fig. 21) to be as large as 999999
C  --------------------------------------------------------------------
                     ADATA(N-4+II) = MIN(ADATA(N-4+II),999999.)
                  ELSE
C  All other cat. 8 parameters can only be as large as XMISS (99999.)
C  ------------------------------------------------------------------
                     ADATA(N-4+II) = MIN(ADATA(N-4+II),XMISS)
                  END IF
               ENDDO
               PRINT 7092,CCAT8(J),NINT(ADATA(N)),
     $          (NINT(ADATA(N+II)),II=1,3),NINT(ADATA(N+4)),
     $          (NINT(ADATA(N+4+II)),II=1,3)
 7092          FORMAT(4X,A11,2(I6.5,1X,I3.3,2(1X,I5.5),3X))
            ELSE  IF(NLVL+3.GT.IDATA(27))  THEN
               DO II = 4,12,4
                  IF(ADATA(N-4+II+1).EQ.21)  THEN
C  Allow report sequence number (code fig. 21) to be as large as 999999
C  --------------------------------------------------------------------
                     ADATA(N-4+II) = MIN(ADATA(N-4+II),999999.)
                  ELSE
C  All other cat. 8 parameters can only be as large as XMISS (99999.)
C  ------------------------------------------------------------------
                     ADATA(N-4+II) = MIN(ADATA(N-4+II),XMISS)
                  END IF
               ENDDO
               PRINT 7093,CCAT8(J),NINT(ADATA(N)),
     $          (NINT(ADATA(N+II)),II=1,3),NINT(ADATA(N+4)),
     $          (NINT(ADATA(N+4+II)),II=1,3),NINT(ADATA(N+8)),
     $          (NINT(ADATA(N+8+II)),II=1,3)
 7093          FORMAT(4X,A11,3(I6.5,1X,I3.3,2(1X,I5.5),3X))
            ELSE
               DO II = 4,16,4
                  IF(ADATA(N-4+II+1).EQ.21)  THEN
C  Allow report sequence number (code fig. 21) to be as large as 999999
C  --------------------------------------------------------------------
                     ADATA(N-4+II) = MIN(ADATA(N-4+II),999999.)
                  ELSE
C  All other cat. 8 parameters can only be as large as XMISS (99999.)
C  ------------------------------------------------------------------
                     ADATA(N-4+II) = MIN(ADATA(N-4+II),XMISS)
                  END IF
               ENDDO
               PRINT 7094,CCAT8(J),NINT(ADATA(N)),
     $          (NINT(ADATA(N+II)),II=1,3),NINT(ADATA(N+4)),
     $          (NINT(ADATA(N+4+II)),II=1,3),NINT(ADATA(N+8)),
     $          (NINT(ADATA(N+8+II)),II=1,3),NINT(ADATA(N+12)),
     $          (NINT(ADATA(N+12+II)),II=1,3)
 7094          FORMAT(4X,A11,4(I6.5,1X,I3.3,2(1X,I5.5),3X))
            END IF
         END DO
      END IF

C  DATA RETURNED DIRECTLY FROM BUFR DUMP FILE (ADATA2 & ADATA3 ARRAYS)
C   {applies only to BUFR types 002 (all) & 004 (all)
C  -------------------------------------------------------------------

      IF(SUBSET(1:5).EQ.'NC002'.OR.SUBSET(1:5).EQ.'NC004') THEN
         IF(MIN(ADATA2(1),ADATA2(2),ADATA2(4),ADATA2(41),ADATA2(24),
     $    ADATA2(42)).LT.BMISS) THEN
            IF(MIN(ADATA2(4),ADATA2(41),ADATA2(24)).LT.BMISS) THEN
               PRINT 1134, (NINT(ADATA2(I)),I=1,2),ADATA2(4),
     $          NINT(ADATA2(41)),NINT(ADATA2(24))
 1134 FORMAT(4X,'RSRD ',I3,', EXPRSRD ',I3,', SST1 ',F6.2,', SSTQM ',I2,
     $    ', HBLCS ',I2)
            ELSE IF(ADATA2(42).LT.BMISS.OR.SUBSET.EQ.'NC004004') THEN
               PRINT 1138, (NINT(ADATA2(I)),I=1,2),NINT(ADATA2(42))
 1138 FORMAT(4X,'RSRD ',I3,', EXPRSRD ',I3,', MSTQ ',I2)
            ELSE
cc             PRINT 1135, (NINT(ADATA2(I)),I=1,2) ! strange compiler
                                                   ! error! (use below)
               i_ADATA2_1 = NINT(ADATA2(1))
               i_ADATA2_2 = NINT(ADATA2(2))
               PRINT 1135, i_ADATA2_1,i_ADATA2_2
 1135 FORMAT(4X,'RSRD ',I3,', EXPRSRD ',I3)
            END IF
         END IF
         IF(MIN(ADATA2(27),ADATA2(28)).LT.BMISS)
     $     PRINT 1154, NINT(ADATA2(27)),ADATA2(28)
 1154 FORMAT(4X,'WDIR1 ',I3,', WSPD1 ',F5.1)
cpppppppppp
cc       print'(1X)'
cc       print'(" NDATA3 = ",7(I0,1X))', ndata3
cpppppppppp
         if(ndata3(2).gt.0) then
            if(ndata3(2).eq.1) then
               if(adata3(1,1,2).ge.bmiss) go to 402
            end if
cpppppppppp
cc          print'(1X)'
cc          print'(" ADATA3(*,*,2):")'
cpppppppppp
            IF(NDATA3(2).EQ.1) THEN
               JNDX = 1
               PRINT 1136, (J,NINT(ADATA3(1,J,2)),J=1,1)
            ELSE
               DO K = 1,NDATA3(2),8
                  DO L = 8,2,-1
                     IF(K+(L-1).LE.NDATA3(2))  THEN
                        JNDX = L
                        PRINT 1136, (J,NINT(ADATA3(1,J,2)),J=K,K+(L-1))
                        EXIT
                     END IF
                  ENDDO
               ENDDO
            END IF
 1136 FORMAT(3X,<JNDX>(' L',I1,': PRWE ',I3,' |'))
         end if
  402    continue
         if(ndata3(3).gt.0) then
            if(ndata3(3).eq.1) then
               if(min(adata3(2,1,3),adata3(3,1,3),adata3(4,1,3),
     $          adata3(5,1,3)).ge.bmiss) go to 403
            end if
cpppppppppp
cc          print'(1X)'
cc          print'(" ADATA3(*,*,3):")'
cpppppppppp
            DO K = 1,NDATA3(3),2
               IF(K+1.LE.NDATA3(3))  THEN
                  JNDX = 2
                  PRINT 1137, (J,(NINT(ADATA3(I,J,3)),I=2,5),J=K,K+1)
               ELSE
                  JNDX = 1
                  PRINT 1137, (J,(NINT(ADATA3(I,J,3)),I=2,5),J=K,K)
               END IF
 1137 FORMAT(3X,<JNDX>(' L',I1,': CLAM ',I2,', CLTP ',I2,', HOCB ',I5,
     $ ', HOCT ',I5,' |'))
            ENDDO
         end if
  403    continue
         if(ndata3(6).gt.0) then
            if(ndata3(6).eq.1) then
               if(min(adata3(1,1,6),adata3(2,1,6),adata3(3,1,6)).ge.
     $          bmiss) go to 405
            end if
cpppppppppp
cc          print'(1X)'
cc          print'(" ADATA3(*,*,6):")'
cpppppppppp
            IF(NDATA3(6).EQ.1) THEN
               JNDX = 1
               PRINT 4135, (J,NINT(ADATA3(1,J,6)),NINT(ADATA3(2,J,6)),
     $          NINT(ADATA3(3,J,6)),J=1,1)
            ELSE
               DO K = 1,NDATA3(6),3
                  DO L = 3,2,-1
                     IF(K+(L-1).LE.NDATA3(6))  THEN
                        JNDX = L
                        PRINT 4135, (J,NINT(ADATA3(1,J,6)),
     $                   NINT(ADATA3(2,J,6)),NINT(ADATA3(3,J,6)),
     $                   J=K,K+(L-1))
                        EXIT
                     END IF
                  ENDDO
               ENDDO
            END IF
 4135 FORMAT(3X,<JNDX>(' L',I1,': AFIC=',I2,', HBOI=',I6,', HTOI=',I6,
     $ ' |'))
         end if
  405    continue
         if(ndata3(7).gt.0) then
            if(ndata3(7).eq.1) then
               if(min(adata3(1,1,7),adata3(2,1,7),adata3(3,1,7)).ge.
     $          bmiss) go to 406
            end if
cpppppppppp
cc          print'(1X)'
cc          print'(" ADATA3(*,*,7):")'
cpppppppppp
            IF(NDATA3(7).EQ.1) THEN
               JNDX = 1
               PRINT 4136, (J,NINT(ADATA3(1,J,7)),NINT(ADATA3(2,J,7)),
     $          NINT(ADATA3(3,J,7)),J=1,1)
            ELSE
               DO K = 1,NDATA3(7),3
                  DO L = 3,2,-1
                     IF(K+(L-1).LE.NDATA3(7))  THEN
                        JNDX = L
                        PRINT 4136, (J,NINT(ADATA3(1,J,7)),
     $                   NINT(ADATA3(2,J,7)),NINT(ADATA3(3,J,7)),
     $                   J=K,K+(L-1))
                        EXIT
                     END IF
                  ENDDO
               ENDDO
            END IF
 4136 FORMAT(3X,<JNDX>(' L',I1,': DGOT=',I2,', HBOT=',I6,', HTOT=',I6,
     $ ' |'))
         end if
  406    continue
         IF(SUBSET(1:5).NE.'NC004') THEN
            print'(1X)'
            print'(1X)'
         END IF
      END IF

      IF(IADPUP.EQ.1)  PRINT 993
  993 FORMAT(' ')

      IF(SORTID)  GO TO 8000

      GO TO 905

C-----------------------------------------------------------------------

  906 CONTINUE
      PRINT 9004, NUNIT,KOUNT
 9004 FORMAT(//45X,'--> ALL REPORTS IN FILE',I3,' PROCESSED <--'//48X,
     $ '*** ',I6,' REPORTS LISTED HERE ***'/)
      IF(KNTTIM.GT.0)  PRINT 9005, KNTTIM
 9005 FORMAT(' --> ',I5,' REPORTS OUTSIDE OF SELECTED TIME WINDOW AND ',
     $ 'NOT LISTED HERE <--'/)
      IF(KNTLAT.GT.0)  PRINT 9006, KNTLAT
 9006 FORMAT(' --> ',I6,' REPORTS OUTSIDE OF SELECTED LATITUDE  BAND ',
     $ 'AND NOT LISTED HERE <--'/)
      IF(KNTLON.GT.0)  PRINT 9007, KNTLON
 9007 FORMAT(' --> ',I6,' REMAINING REPORTS OUTSIDE OF SELECTED ',
     $ 'LONGITUDE BAND AND NOT LISTED HERE <--'/)
      PRINT 9008
 9008 FORMAT(/38X,'>>>  SUCCESSFUL COMPLETION OF PROGRAM ',
     $ 'BUFR_LISTDUMPS  <<<'/)

      RETURN

C-----------------------------------------------------------------------

  999 CONTINUE
      PRINT 567, IER
  567 FORMAT('**BUFR_LISTDUMPS/LISTUPA: RETURN CODE =',I3,'; SOME TYPE',
     $ ' OF ERROR IN DECODING REPORT FROM INPUT BUFR FILE - STOP 99')
      CALL W3TAGE('BUFR_LISTDUMPS')
      CALL ERREXIT(99)

C-----------------------------------------------------------------------

      END
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    LISTSFC
C   PRGMMR: D. A. KEYSER     ORG: NP22       DATE: 2017-10-13
C
C ABSTRACT: LISTS CONTENTS OF A TIME-WINDOWED SURFACE BUFR DATA DUMP
C   FILE.  THE STANDARD OUTPUT IS IN AN EASY-TO-READ FORMAT.  NOTE:
C   THIS SUBROUTINE CAN HANDLE THE FOLLOWING BUFR DATA DUMP FILE
C   TYPES: ADPSFC, SFCSHP, SFCBOG, MSONET.
C
C PROGRAM HISTORY LOG:
C 2000-03-28  D.A. KEYSER -- ORIGINAL AUTHOR
C 2002-05-22  D.A. KEYSER -- CAN NOW LIST MESONET REPORTS FROM THE
C     "MSONET" DATA DUMP FILE
C 2004-02-02  D.A. KEYSER -- MODIFIED TO LIST ELEVATION Q.M. SINCE
C     SUBR. IW3UNPBF CAN NOW PROCESS MOBILE SURFACE LAND SYNOPTIC
C     REPORTS OUT OF ADPSFC DUMP FILE; MODIFIED LISTING OF CATEGORY 8
C     MESONET DATA (MORE VARIABLES NOW RETURNED FROM SUBR. IW3UNPBF);
C     LAT/LON LISTING NOW CARRIES FOUR SIGNIFICANT DIGITS (WAS TWO)
C 2004-09-09  KEYSER -- NOW PRINTS ALTIMETER SETTING, SST AND SINGLE-
C     LEVEL SENSIBLE WEATHER ELEMENTS FROM ADATA2 AND MULTIPLE-LEVEL
C     SENSIBLE WEATHER ELEMENTS FROM ADATA3 RETURNED FROM IW3UNPBF;
C     INFORMATION THAT HAD BEEN PRINTED FROM CATEGORIES 51, 52 AND 8
C     RETURNED FROM IW3UNPBF THAT IS NOW RETURNED IN ADATA2 AND ADATA3
C     IS NOW IGNORED; NO ATTEMPT IS MADE TO PRINT DATA IN CATEGORY 52
C     SINCE IT IS LONGER CONSIDERED IN IW3UNPBF
C 2007-09-14 D. A. KEYSER -- BUMP UP ARRAY SIZE FOR UNPACKED REPORT
C     FROM IW3UNPBF FROM 3000 TO 3500; IMPROVED DOCUMENTATION AT TOP OF
C     LISTINGS FOR "ADPSFC", "MSONET", "SFCSHP" AND "SFCBOG" DUMPS;
C     CORRECTED ERROR WHICH PREVENTED "SFCBOG" PMSL FROM BEING LISTED
C 2010-06-07  D. A. KEYSER -- ADDED LISTING OF ALTIMETER Q.M. FOR
C     ADPSFC REPORTS SINCE THIS CAN NOW BE PRESENT IN SOME CASES FOR
C     METARS (CURRENTLY WHEN SDMEDIT PRESSURE Q.M. IS 12 OR 14 IN
C     WHICH CASE IW3UNPBF STORES THIS AS ALTIMETER Q.M.)
C 2014-04-22  D. A. KEYSER -- BUMPED UP ARRAY SIZE FOR "ADATA2",
C     RETURNED OUT OF CALL TO IW3UNPBF, FROM 42 TO 43, NEW WORD 43
C     HOLDS SATELLITE ZENITH ANGLE (DEGREES, SATWND TYPES ONLY); ADDED
C     OPTION TO SORT LISTING OF "ADPSFC" DUMP BY REPORT ID AND WITHIN
C     REQUESTED OBS TIME (HARDWIRED TO NOT DO SORTING).  ABORTS WITH
C     RC=65 IF > 40000 ADPSFC REPORTS (EXCEEDS SORT LIMIT).
C 2016-11-30  D. A. KEYSER -- Reads new output real, double-precision
C     argument array ADATA_8 of length 2 in call to IW3UNPBF.  This
C     returns latitude and longitude for each report which is then
C     stored in R*8 variables ALAT_8 and ALON_8 prior to listing for the
C     following dump types: ADPSFC, SFCSHP and MSONET.
C     BENEFIT: Replaces lat/lon returned in ADATA(1:2) in call to
C              IW3UNPBF for these types which are just at machine
C              precison (normally R*4).  Now that reports in these dumps
C              can store lat/lon at 0.00001 degree precision this change
C              will ensure that lat/lon is always accurate to 0.00001
C              degrees in these listings.
C 2017-10-13  D. A. KEYSER -- Added minutes to every print statement
C     that includes the central dump time.  Central dump time minutes is
C     obtained from Section 1 of first (dummy) message of input dump
C     file via call to BUFRLIB routine IUPVS01.
C     BENEFIT: Until now, central dump time minutes was always zero.
C              However, with the implementation of the new RTMA_RU,
C              central dump time can now also have minutes = 15, 30
C              or 45 (since the RTMA_RU runs 4 times per hour). This
C              change allows the print statements to reflect this new
C              center dump time format.
C 2020-07-07  S. MELCHIOR -- Accommodate BUFR format buoy data.
C 2021-06-24  S. MELCHIOR -- Accommodate BUFR format ship and cman data.
C
C USAGE:    CALL LISTSFC
C
C   INPUT FILES: 
C     UNIT 05  - INPUT DATA CARDS IN THE FORM OF A NAMELIST (SEE
C              - REMARKS IN MAIN PROGRAM DOCBLOCK)
C     UNIT 21  - BUFR DATA SET
C
C   OUTPUT FILES:
C     UNIT 06  - STANDARD OUTPUT PRINT
C
C REMARKS: NONE.
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE:  NCEP WCOSS
C
C$$$

      SUBROUTINE LISTSFC

      PARAMETER (MAXOBS = 3500)

      CHARACTER*1  C1,C2,CHAR1,c1_8,c2_8
      CHARACTER*2  CQM(5)
      CHARACTER*8  STNID,CRES1,CRES2,DSNAME,SUBSET,DSNAME_LC,
     $ STNID_S(40000),CRES1_S(40000),CRES2_S(40000),SUBSET_S(40000)
      CHARACTER*10 CCAT8(60)
      CHARACTER*11 CBULL
      CHARACTER*15 CDATUM(3),CIND2(3)

      LOGICAL  GLOBAL,SUBSKP(0:255,0:200),SORTID

      REAL  ADATA(MAXOBS),ADATA_S(MAXOBS,40000),ADATA2(43),
     $ ADATA2_S(43,40000),ADATA3(5,255,7),ADATA3_S(5,255,7,40000),
     $ OB8(3),Q82(3)
      REAL(8) BMISS,adata8_8(2),alat_8,alon_8,adata8_8_s(2,40000)

      INTEGER  IDATA(MAXOBS),ICAT(17),INDX(40000),NDATA3(7),IQM(255),
     $  NDATA3_S(7,40000)
      INTEGER(8)  IDSDMP_8,IWORK_8(40000)

      COMMON/TYPE/DSNAME_LC
      COMMON/BUFRLIB_MISSING/BMISS

      EQUIVALENCE  (ADATA,IDATA)

      DATA XMISS/99999./,IMISS/99999/
      DATA NUNIT/21/
      DATA CCAT8/'ADDIT-DATA',59*'          '/
      DATA ICAT/1,2,3,4,5,6,-99,8,51,-99,-99,10,11,12,13,14,15/

      NAMELIST/SDATA/LATS,LATN,LONW,LONE,CHAR1,SUBSKP

      SORTID = .FALSE.

      IF(DSNAME_LC.EQ.'adpsfc') THEN
         PRINT 101
  101 FORMAT(5X,'KEY FOR DATA LISTED IN EACH REPORT BELOW:'/
     $/10X,'Field  1 ....... WMO Block/Station number'
     $/10X,'Field  2 ....... Observation time (UTC)'
     $/10X,'Field  3 ....... Latitude (N,S)'
     $/10X,'Field  4 ....... Longitude (E,W)'
     $/10X,'ELV/QM ......... Elevation (meters) / quality marker ',
     $ '(BUFR Code Table 0-33-024 -'
     $/28X,'see http://www.emc.ncep.noaa.gov/mmb/data_processing/table',
     $ '_25-35.htm#0-33-024)'
     $/10X,'ITP ............ Instrument type (always missing)'
     $/10X,'RCT ............ Receipt time (UTC)'
     $/10X,'RES ............ SYNOP: Reserve characters (16) {1 = ',
     $ 'Indicator for precipitation inclusion (BUFR Code Table 0-13-',
     $ '194,'
     $/28X,'see http://www.emc.ncep.noaa.gov/mmb/data_processing/table',
     $ '_local_await-val.htm#0-13-194), 2 = blank,'
     $/28X,'3 = Indicator for wind speed (source/units) ("0" - wind ',
     $ 'speed estimated in m/sec "uncertified'
     $/28X,'instrument", "1" - wind speed obtained from anemometer in ',
     $ 'm/sec "certified instrument", "3" - wind',
     $/28X,'speed estimated in knots "uncertified instrument", "4" - ',
     $ 'wind speed obtained from anemometer in knots'
     $/28X,'"certified instrument", "7" - Missing), 4 = blank, 5 = ',
     $ 'Indicator for station operation/past weather'
     $/28X,'data (BUFR Code Table 0-02-193,'
     $/28X,'see http://www.emc.ncep.noaa.gov/mmb/data_processing/table',
     $ '_local_await-val.htm#0-02-193), 6-16 = blank}'
     $/10X,'                 METAR: Reserve characters (16) {1-8 = ',
     $ 'blank, 9-13 = Type of hourly report ("METAR", "SPECI" OR ',
     $ '"LWIS ",'
     $/28X,'unknown is "?????"), 14-15 = blank, 16 = Corrected report ',
     $ 'indicator ("0" - not corrected, "1" - '
     $/28X,'corrected by report originator, "2" - corrected by NCEP ',
     $ 'SDM, "7" - missing)}'
     $/10X,'RTP ............ Dump report type {511 - Fixed land ',
     $ 'surface by block and station number (synoptic, both ',
     $ 'unrestricted and'
     $/28X,'restricted WMO Res. 40), 512 - Fixed land surface by call ',
     $ 'letters (METAR), 514 - Mobile land surface '
     $/28X,'(synoptic)}'
     $/10X,'MSL/STNP ....... Mean sea-level pressure / station ',
     $ 'pressure (both x 10 mb)'
     $/10X,'Next field ..... Wind direction (degrees) / wind speed ',
     $ '(x 10 m/sec)'
     $/10X,'Next field ..... Air temperature (x 10 degrees C)'
     $/10X,'Next field ..... Dewpoint depression (x 10 degrees C)'
     $/10X,'Next field ..... Quality markers in form AABBCCDDEE, where',
     $ ' AA = sea-level pressure, BB = station pressure, CC = wind,'
     $/28X,'DD = air temprature, EE = dewpoint depression (00 - ',
     $ 'monitor keep, 01 - good, 02 - neutral/not checked,'
     $/28X,'03 - suspect, 12 - toss, on reject list, 13 - toss, failed',
     $ ' automatic q.c. tests, 14 - toss, monitor'
     $/28X,'purge)'
     $/28X,'Note: If quality marker is default value of 02 then "--" ',
     $ 'is stamped out here rather than "02"'
     $//10X,'BUFR mnemonics:'
     $/15X,'RSRD ..... Restrictions on redistribution, Flag Table 0-35',
     $ '-200 ('
     $/32X,' 16 - can redistribute to any U.S. government agency ',
     $ 'within NOAA,'
     $/32X,'128 - can redistribute to any U.S. government agency,'
     $/32X,'160 - can redistribute to any U.S. government agency or ',
     $ 'educational institution,'
     $/32X,'192 - can redistribute to any U.S. government agency or ',
     $ 'research group,'
     $/32X,'224 - can redistribute to any U.S. government agency, ',
     $ 'research group or educational institution,'
     $/32X,'256 - no redistribution allowed,'
     $/28X,'Missing - no retrictions on redistribution)'
     $/15X,'EXPRSRD .. Expiration of restrictions on redistribution ',
     $ '(hours), 0-35-201'
     $/15X,'SST1 ..... Sea temperature (K), 0-22-043'
     $/15X,'SSTQM .... Sea temperature quality marker, Code Table 0-22',
     $ '-246'
     $/27X,'(see http://www.emc.ncep.noaa.gov/mmb/data_processing/',
     $ 'prepbufr.doc/table_7.htm)'
     $/15X,'MSST ..... Method of water temperature and/or salinity, ',
     $ 'Code Table 0-02-038'
     $/27X,'(see http://www.emc.ncep.noaa.gov/mmb/data_processing/',
     $ 'table_local_await-val.htm#0-02-038)'
     $/15X,'.REHOVI .. Relationship to horizontal visibility, Code ',
     $ 'Table 0-08-201'
     $/27X,'(see http://www.emc.ncep.noaa.gov/mmb/data_processing/',
     $ 'table_local_await-val.htm#0-08-201)'
     $/15X,'HOVI ..... Horizontal visibility (meters), 0-20-001'
     $/15X,'VTVI ..... Vertical visibility (meters), 0-20-002'
     $/15X,'PSW1 ..... Past weather (1), Code Table 0-20-004'
     $/27X,'(see http://www.emc.ncep.noaa.gov/mmb/data_processing/',
     $ 'table_20.htm#0-20-004)'
     $/15X,'PSW2 ..... Past weather (2), Code Table 0-20-005'
     $/27X,'(see http://www.emc.ncep.noaa.gov/mmb/data_processing/',
     $ 'table_20.htm#0-20-005)'
     $/15X,'PKWDSP ... Peak wind speed (m/sec), 0-11-203'
     $/15X,'PKWDDR ... Peak wind direction (degrees), 0-11-202'
     $/15X,'.DTMMXGS . Duration of time relating to maximum wind gust ',
     $ 'speed (minutes), 0-04-032'
     $/15X,'MXGS ..... Maximum wind gust speed (m/sec), 0-11-041'
     $/15X,'TP01 ..... Total precipitation past 1 hour (kg/m**2), ',
     $ '0-13-019'
     $/15X,'TP03 ..... Total precipitation past 3 hours (kg/m**2), ',
     $ '0-13-020'
     $/15X,'TP06 ..... Total precipitation past 6 hours (kg/m**2), ',
     $ '0-13-021'
     $/15X,'TP12 ..... Total precipitation past 12 hours (kg/m**2), ',
     $ '0-13-022'
     $/15X,'TP24 ..... Total precipitation past 24 hours (kg/m**2), ',
     $ '0-13-023'
     $/15X,'TOCC ..... Cloud cover (total) (%), 0-20-10'
     $/15X,'HBLCS .... Height above surface of the base of the lowest ',
     $ 'cloud seen, Code Table 0-20-201'
     $/27X,'(see http://www.emc.ncep.noaa.gov/mmb/data_processing/',
     $ 'table_local_await-val.htm#0-20-201)'
     $/15X,'ALSE ..... Altimeter setting (QNH) (Pa), 0-10-052 ',
     $ '{followed by quality marker (QM) (00 - monitor keep, 01 - ',
     $ 'good,'
     $/27X,'02 - neutral/not checked, 03 - suspect, 12 - toss, on ',
     $ 'reject list, 13 - toss, failed automatic q.c.'
     $/27X,'tests, 14 - toss, monitor purge)'
     $/15X,'.DTHTOPC . Duration of time relating to total ',
     $ 'precipitation/total water equivalent (hours), 0-04-031' 
     $/15X,'TOPC ..... Total precipitation/total water equivalent ',
     $ '(kg/m**2), 0-13-011 {followed by quality marker (QM) (00 - '
     $/27X,'monitor keep, 01 - good, 02 - neutral/not checked, 03 - ',
     $ 'suspect, 12 - toss, on reject list, 13 - toss,'
     $/27X,'failed automatic q.c. tests, 14 - toss, monitor purge)}'
     $/15X,'PRWE ..... Present weather, Code Table 0-20-003'
     $/27X,'(see http://www.emc.ncep.noaa.gov/mmb/data_processing/',
     $ 'table_20.htm#0-20-003)'
     $/15X,'.DTHMXTM . Duration of time relating to maximum ',
     $ 'temperature (hours), 0-04-031'
     $/15X,'MXTM ..... Maximum temperature (K), 0-12-111'
     $/15X,'.DTHMITM . Duration of time relating to minimum ',
     $ 'temperature (hours), 0-04-031'
     $/15X,'MITM ..... Minimum temperature (K), 0-12-112'
     $/15X,'VSSO ..... Vertical significance (surface observations), ',
     $ 'Code Table 0-08-002'
     $/27X,'(see http://www.emc.ncep.noaa.gov/mmb/data_processing/',
     $ 'table_3-8.htm#0-08-002)'
     $/15X,'CLAM ..... Cloud amount, Code Table 0-20-011'
     $/27X,'(see http://www.emc.ncep.noaa.gov/mmb/data_processing/',
     $ 'table_20.htm#0-20-011)'
     $/15X,'CLTP ..... Cloud type, Code Table 0-20-012'
     $/27X,'(see http://www.emc.ncep.noaa.gov/mmb/data_processing/',
     $ 'table_20.htm#0-20-012)'
     $/15X,'HOCB ..... Height of base of cloud (meters), 0-20-013'
     $/15X,'HOCT ..... Height of top  of cloud (meters), 0-20-014'
     $/15X,'.DTHDOFS . Duration of time relating to depth of fresh ',
     $ 'snow (hours), 0-04-031'
     $/15X,'DOFS ..... Depth of fresh snow (meters), 0-13-012'
     $/15X,'TOSD ..... Total snow depth (meters), 0-13-013'
     $/15X,'HOWV ..... Height of waves (meters), 0-22-021'
     $/15X,'POWV ..... Period of waves (seconds), 0-22-011'
     $/15X,'HOWW ..... Height of wind waves (meters), 0-22-022'
     $/15X,'POWW ..... Period of wind waves (seconds), 0-22-012'
     $/15X,'DOSW ..... Direction of swell waves (degrees), 0-22-003'
     $/15X,'HOSW ..... Height of swell waves (meters), 0-22-023'
     $/15X,'POSW ..... Period of swell waves (seconds), 0-22-013'
     $/15X,'CHPT ..... Characteristic of pressure tendency, Code Table',
     $ ' 0-10-063'
     $/27X,'(see http://www.emc.ncep.noaa.gov/mmb/data_processing/',
     $ 'table_9-19.htm#0-10-063)'
     $/15X,'3HPC ..... 03-hour pressure change (Pa), 0-10-061'
     $/15X,'24PC ..... 24-hour pressure change (Pa), 0-10-062'//)


      ELSE IF(DSNAME_LC.EQ.'msonet') THEN
         PRINT 102
  102 FORMAT(5X,'KEY FOR DATA LISTED IN EACH REPORT BELOW:'/
     $/10X,'Field  1 ....... Report id'
     $/10X,'Field  2 ....... Observation time (UTC)'
     $/10X,'Field  3 ....... Latitude (N,S)'
     $/10X,'Field  4 ....... Longitude (E,W)'
     $/10X,'ELV/QM ......... Elevation (meters) / quality marker ',
     $ '(BUFR Code Table 0-33-024 -'
     $/28X,'see http://www.emc.ncep.noaa.gov/mmb/data_processing/table',
     $ '_25-35.htm#0-33-024)'
     $/10X,'ITP ............ Instrument type (always missing)'
     $/10X,'RCT ............ Receipt time (UTC)'
     $/10X,'RES ............ Reserve characters (16) {1-8 = First 8 ',
     $ 'characters of Mesonet Provider id, 9-16 = First 8 characters ',
     $ 'of'
     $/28X,'Mesonet Subprovider id (if present, otherwise blanks)}'
     $/10X,'RTP ............ Dump report type (540 - Mesonet surface)'
     $/10X,'MSL/STNP ....... Mean sea-level pressure / station ',
     $ 'pressure (both x 10 mb) '
     $/10X,'Next field ..... Wind direction (degrees) / wind speed ',
     $ '(x 10 m/sec)'
     $/10X,'Next field ..... Air temperature (x 10 degrees C)'
     $/10X,'Next field ..... Dewpoint depression (x 10 degrees C)'
     $/10X,'Next field ..... Quality markers in form AABBCCDDEE, where',
     $ ' AA = sea-level pressure, BB = station pressure, CC = wind,'
     $/28X,'DD = air temprature, EE = dewpoint depression (00 - ',
     $ 'monitor keep, 01 - good, 02 - neutral/not checked,'
     $/28X,'03 - suspect, 12 - toss, on reject list, 13 - toss, failed',
     $ ' automatic q.c. tests, 14 - toss, monitor'
     $/28X,'purge)'
     $/28X,'Note: If quality marker is default value of 02 then "--" ',
     $ 'is stamped out here rather than "02"'
     $//10X,'BUFR mnemonics:'
     $/15X,'RSRD ..... Restrictions on redistribution, Flag Table 0-35',
     $ '-200 ('
     $/32X,' 16 - can redistribute to any U.S. government agency ',
     $ 'within NOAA,'
     $/32X,'128 - can redistribute to any U.S. government agency,'
     $/32X,'160 - can redistribute to any U.S. government agency or ',
     $ 'educational institution,'
     $/32X,'192 - can redistribute to any U.S. government agency or ',
     $ 'research group,'
     $/32X,'224 - can redistribute to any U.S. government agency, ',
     $ 'research group or educational institution,'
     $/32X,'256 - no redistribution allowed,'
     $/28X,'Missing - no retrictions on redistribution)'
     $/15X,'EXPRSRD .. Expiration of restrictions on redistribution ',
     $ '(hours), 0-35-201'
     $/15X,'MXGS ..... Maximum wind gust speed (m/sec), 0-11-041'
     $/15X,'MXGD ..... Maximum wind gust direction (degrees), 0-11-043'
     $/15X,'ALSE ..... Altimeter setting (QNH) (Pa), 0-10-052 ',
     $ '{followed by quality marker (QM) (00 - monitor keep, 01 - ',
     $ 'good,'
     $/27X,'02 - neutral/not checked, 03 - suspect, 12 - toss, on ',
     $ 'reject list, 13 - toss, failed automatic q.c.'
     $/27X,'tests, 14 - toss, monitor purge)'
     $/15X,'.DTHTOPC . Duration of time relating to total ',
     $ 'precipitation/total water equivalent (hours), 0-04-031' 
     $/15X,'TOPC ..... Total precipitation/total water equivalent ',
     $ '(kg/m**2), 0-13-011 {followed by quality marker (QM) (00 - '
     $/27X,'monitor keep, 01 - good, 02 - neutral/not checked, 03 - ',
     $ 'suspect, 12 - toss, on reject list, 13 - toss,'
     $/27X,'failed automatic q.c. tests, 14 - toss, monitor purge)}'//)

      ELSE  IF(DSNAME_LC.EQ.'sfcshp') THEN
         PRINT 103
  103 FORMAT(5X,'KEY FOR DATA LISTED IN EACH REPORT BELOW:'/
     $/10X,'Field  1 ....... Report id (definition depends on report ',
     $ 'type)'
     $/10X,'Field  2 ....... Observation time (UTC)'
     $/10X,'Field  3 ....... Latitude (N,S)'
     $/10X,'Field  4 ....... Longitude (E,W)'
     $/10X,'ELV/QM ......... Elevation (meters) / quality marker ',
     $ '(BUFR Code Table 0-33-024 -'
     $/28X,'see http://www.emc.ncep.noaa.gov/mmb/data_processing/table',
     $ '_25-35.htm#0-33-024)'
     $/10X,'ITP ............ Instrument type (always missing)'
     $/10X,'RCT ............ Receipt time (UTC)'
     $/10X,'RES ............ SHIP, C-MAN, FIXED BUOY: Reserve ',
     $ 'characters (16) {1 = Indicator for precipitation inclusion ',
     $ '(BUFR Code'
     $/28X,'Table 0-13-194,'
     $/28X,'see http://www.emc.ncep.noaa.gov/mmb/data_processing/table',
     $ '_local_await-val.htm#0-13-194), 2 = blank,'
     $/28X,'3 = Indicator for wind speed (source/units) ("0" - wind',
     $ ' speed estimated in m/sec "uncertified'
     $/28X,'instrument", "1" - wind speed obtained from anemometer in ',
     $ 'm/sec "certified instrument", "3" - wind'
     $/28X,'speed estimated in knots "uncertified instrument", "4" - ',
     $ 'wind speed obtained from anemometer in knots'
     $/28X,'"certified instrument", "7" - Missing), 4 = blank, 5 = ',
     $ 'Indicator for station operation/past weather'
     $/28X,'data (BUFR Code Table 0-02-193,'
     $/28X,'see http://www.emc.ncep.noaa.gov/mmb/data_processing/table',
     $ '_local_await-val.htm#0-02-193), 6-16 = blank}'
     $/10X,'                 TIDE GAUGE, DRIFTING BUOY: Reserve ',
     $ 'characters (16) (1-16 = blank)'
     $/10X,'RTP ............ Dump report type {522 - Ship with name ',
     $ '(TAC), 523 - Ship without name (report id set to "SHIP") ',
     $ '(TAC),'
     $/28X,'524 - Ship with name (BUFR), 525 - Ship without name ',
     $ '(report id set to "SHIP") (BUFR),'
     $/28X,'530 - C-MAN platform (BUFR), 531 - C-MAN platform ',
     $ '(TAC),' 
     $/28X,'532 - Tide gauge, 561 - Moored buoy (TAC), 562 - ',
     $ 'Drifting buoy (TAC),'
     $/28X,'563 - Moored buoy (BUFR), 564 - Drifting buoy (BUFR)}'
     $/10X,'MSL/STNP ....... Mean sea-level pressure / station ',
     $ 'pressure (both x 10 mb) '
     $/10X,'Next field ..... Wind direction (degrees) / wind speed ',
     $ '(x 10 m/sec)'
     $/10X,'Next field ..... Air temperature (x 10 degrees C)'
     $/10X,'Next field ..... Dewpoint depression (x 10 degrees C)'
     $/10X,'Next field ..... Quality markers in form AABBCCDDEE, where',
     $ ' AA = sea-level pressure, BB = station pressure, CC = wind,'
     $/28X,'DD = air temprature, EE = dewpoint depression (00 - ',
     $ 'monitor keep, 01 - good, 02 - neutral/not checked,'
     $/28X,'03 - suspect, 04 - good - corrected by OPC, 12 - toss, on ',
     $ 'reject list, 13 - toss, failed automatic q.c.'
     $/28X,'tests, 14 - toss, monitor purge)'
     $//10X,'BUFR mnemonics:'
     $/15X,'RSRD ..... Restrictions on redistribution, Flag Table 0-35',
     $ '-200 ('
     $/32X,' 16 - can redistribute to any U.S. government agency ',
     $ 'within NOAA,'
     $/32X,'128 - can redistribute to any U.S. government agency,'
     $/32X,'160 - can redistribute to any U.S. government agency or ',
     $ 'educational institution,'
     $/32X,'192 - can redistribute to any U.S. government agency or ',
     $ 'research group,'
     $/32X,'224 - can redistribute to any U.S. government agency, ',
     $ 'research group or educational institution,'
     $/32X,'256 - no redistribution allowed,'
     $/28X,'Missing - no retrictions on redistribution)'
     $/15X,'EXPRSRD .. Expiration of restrictions on redistribution ',
     $ '(hours), 0-35-201'
     $/15X,'SST1 ..... Sea temperature (K), 0-22-043'
     $/15X,'SSTQM .... Sea temperature quality marker, Code Table 0-22',
     $ '-246'
     $/27X,'(see http://www.emc.ncep.noaa.gov/mmb/data_processing/',
     $ 'prepbufr.doc/table_7.htm)'
     $/15X,'DBSS ..... Depth below sea/water surface (meters), 0-07-062'
     $/15X,'MSST ..... Method of water temperature and/or salinity, ',
     $ 'Code Table 0-02-038'
     $/27X,'(see http://www.emc.ncep.noaa.gov/mmb/data_processing/',
     $ 'table_local_await-val.htm#0-02-038)'
     $/15X,'HOVI ..... Horizontal visibility (meters), 0-20-001'
     $/15X,'VTVI ..... Vertical visibility (meters), 0-20-002'
     $/15X,'PSW1 ..... Past weather (1), Code Table 0-20-004'
     $/27X,'(see http://www.emc.ncep.noaa.gov/mmb/data_processing/',
     $ 'table_20.htm#0-20-004)'
     $/15X,'PSW2 ..... Past weather (2), Code Table 0-20-005'
     $/27X,'(see http://www.emc.ncep.noaa.gov/mmb/data_processing/',
     $ 'table_20.htm#0-20-005)'
     $/15X,'PKWDSP ... Peak wind speed (m/sec), 0-11-203'
     $/15X,'PKWDDR ... Peak wind direction (degrees), 0-11-202'
     $/15X,'.DTMMXGS . Duration of time relating to maximum wind gust ',
     $ 'speed (minutes), 0-04-032'
     $/15X,'MXGS ..... Maximum wind gust speed (m/sec), 0-11-041'
     $/15X,'TOCC ..... Cloud cover (total) (%), 0-20-10'
     $/15X,'HBLCS .... Height above surface of the base of the lowest ',
     $ 'cloud seen, Code Table 0-20-201'
     $/27X,'(see http://www.emc.ncep.noaa.gov/mmb/data_processing/',
     $ 'table_local_await-val.htm#0-20-201)'
     $/15X,'XS10 ..... 10 meter extrapolated wind speed (m/sec), 0-11-',
     $ '223'
     $/15X,'XS20 ..... 20 meter extrapolated wind speed (m/sec), 0-11-',
     $ '224'
     $/15X,'PRWE ..... Present weather, Code Table 0-20-003'
     $/27X,'(see http://www.emc.ncep.noaa.gov/mmb/data_processing/',
     $ 'table_20.htm#0-20-003)'
     $/15X,'VSSO ..... Vertical significance (surface observations), ',
     $ 'Code Table 0-08-002'
     $/27X,'(see http://www.emc.ncep.noaa.gov/mmb/data_processing/',
     $ 'table_3-8.htm#0-08-002)'
     $/15X,'CLAM ..... Cloud amount, Code Table 0-20-011'
     $/27X,'(see http://www.emc.ncep.noaa.gov/mmb/data_processing/',
     $ 'table_20.htm#0-20-011)'
     $/15X,'CLTP ..... Cloud type, Code Table 0-20-012'
     $/27X,'(see http://www.emc.ncep.noaa.gov/mmb/data_processing/',
     $ 'table_20.htm#0-20-012)'
     $/15X,'HOCB ..... Height of base of cloud (meters), 0-20-013'
     $/15X,'HOCT ..... Height of top  of cloud (meters), 0-20-014'
     $/15X,'HOWV ..... Height of waves (meters), 0-22-021'
     $/15X,'POWV ..... Period of waves (seconds), 0-22-011'
     $/15X,'HOWW ..... Height of wind waves (meters), 0-22-022'
     $/15X,'POWW ..... Period of wind waves (seconds), 0-22-012'
     $/15X,'DOSW ..... Direction of swell waves (degrees), 0-22-003'
     $/15X,'HOSW ..... Height of swell waves (meters), 0-22-023'
     $/15X,'POSW ..... Period of swell waves (seconds), 0-22-013'
     $/15X,'TDMP ..... Direction of motion of ship during last 3 ',
     $ 'hours, Code Table 0-01-193'
     $/27X,'(see http://www.emc.ncep.noaa.gov/mmb/data_processing/',
     $ 'table_local_await-val.htm#0-01-193)'
     $/15X,'ASMP ..... Average speed of motion of ship during last 3 ',
     $ 'hours, Code Table 0-01-200'
     $/27X,'(see http://www.emc.ncep.noaa.gov/mmb/data_processing/',
     $ 'table_local_await-val.htm#0-01-200)'
     $/15X,'CHPT ..... Characteristic of pressure tendency, Code Table',
     $ ' 0-10-063'
     $/27X,'(see http://www.emc.ncep.noaa.gov/mmb/data_processing/',
     $ 'table_9-19.htm#0-10-063)'
     $/15X,'3HPC ..... 03-hour pressure change (Pa), 0-10-061'
     $/15X,'24PC ..... 24-hour pressure change (Pa), 0-10-062'//)

      ELSE  IF(DSNAME_LC.EQ.'sfcbog') THEN
         PRINT 104
  104 FORMAT(5X,'KEY FOR DATA LISTED IN EACH REPORT BELOW:'/
     $/10X,'Field  1 ....... Report id'
     $/10X,'Field  2 ....... Observation time (UTC)'
     $/10X,'Field  3 ....... Latitude (N,S)'
     $/10X,'Field  4 ....... Longitude (E,W)'
     $/10X,'ELV/QM ......... Elevation (meters) / quality marker ',
     $ '(BUFR Code Table 0-33-024 -'
     $/28X,'see http://www.emc.ncep.noaa.gov/mmb/data_processing/',
     $ 'table_25-35.htm#0-33-024)'
     $/10X,'ITP ............ Instrument type (always missing)'
     $/10X,'RCT ............ Receipt time (UTC)'
     $/10X,'RES ............ Reserve characters (16) (1-16 = blank)'
     $/10X,'RTP ............ Dump report type (551 - Sea-level ',
     $ 'pressure bogus)'//)

      END IF

      KOUNT  = 0
      KNTLAT = 0
      KNTLON = 0
      KNTCHR = 0

      LATS = -9001
      LATN =  9001
      LONW = -0001
      LONE = 36001
      CHAR1= '*'
      SUBSKP = .FALSE.

      READ(5,SDATA,END=1905)

 1905 CONTINUE

      GLOBAL = (LATS.LE.-09000.AND.LATN.GE.09000.AND.
     $          LONW.LE. 00000.AND.LONE.GE.36000)

  905 CONTINUE

      IF(IW3UNPBF(NUNIT,ADATA,STNID,CRES1,CRES2,CBULL,ADATA2,ADATA3,
     $ NDATA3,adata8_8,DSNAME,IDSDAT,IDSDMP_8,SUBSET,SUBSKP,IER).EQ.0)
     $ GO TO 950
      IF(IER.EQ.1)  GO TO 910
      IF(IER.EQ.2)  GO TO 920
      IF(IER.EQ.3)  GO TO 920
      IF(IER.EQ.999)  GO TO 999

C-----------------------------------------------------------------------

  910 CONTINUE
cpppppppppp
cc    PRINT'(" RETURN CODE =",I0,"; DATA SET INFORMATION RETURNED")',
cc   $ IER
cpppppppppp
c  1st dummy message in file is open, call iupvs01 to get iminu
      iminu = iupvs01(nunit,'MINU')
      IF(.NOT.GLOBAL.OR.CHAR1.NE.'*')  THEN
         IF(GLOBAL)  THEN
            PRINT 6999, DSNAME,IDSDAT,iminu,IDSDMP_8,CHAR1
 6999 FORMAT(//22X,'--> DATA SET INFORMATION: NAME: ',A8,'; DATE: ',
     $ I10.10,i2.2,'; DUMP TIME: ',I12.12,' <--'//39X,'-- ONLY REPORTS',
     $ ' BEGINNING WITH "',A1,'" ARE PROCESSED --'//)
         ELSE  IF(CHAR1.EQ.'*')  THEN
            PRINT 7000, DSNAME,IDSDAT,iminu,IDSDMP_8,LATS/100.,
     $       LATN/100.,LONW/100.,LONE/100.
 7000 FORMAT(//22X,'--> DATA SET INFORMATION: NAME: ',A8,'; DATE: ',
     $ I10.10,i2.2,'; DUMP TIME: ',I12.12,' <--'//10X,'-- SELECTED ',
     $ 'DOMAIN FOR PROCESSING REPORTS: LATITUDE:',F7.2,' TO ',F7.2,
     $ ' N; LONGITUDE:',F8.2,' TO ',F8.2,' E --'//)
         ELSE
            PRINT 6998, DSNAME,IDSDAT,iminu,IDSDMP_8,LATS/100.,
     $       LATN/100.,LONW/100.,LONE/100.,CHAR1
 6998 FORMAT(//22X,'--> DATA SET INFORMATION: NAME: ',A8,'; DATE: ',
     $ I10.10,i2.2,'; DUMP TIME: ',I12.12,' <--'//10X,'-- SELECTED ',
     $ 'DOMAIN FOR PROCESSING REPORTS: LATITUDE:',F7.2,' TO ',F7.2,
     $ ' N; LONGITUDE:',F8.2,' TO ',F8.2,' E --'//39X,'-- ONLY REPORTS',
     $ ' BEGINNING WITH "',A1,'" ARE PROCESSED --'//)
          END IF
      ELSE
         PRINT 8000, DSNAME,IDSDAT,iminu,IDSDMP_8
 8000 FORMAT(//22X,'--> DATA SET INFORMATION: NAME: ',A8,'; DATE: ',
     $ I10.10,i2.2,'; DUMP TIME: ',I12.12,' <--'//10X,'-- SELECTED ',
     $ 'DOMAIN FOR PROCESSING REPORTS: ALL REPORTS IN DATA SET ',
     $ 'REGARDLESS OF LOCATION'//)
      END IF
C  Uncomment line below to sort ADPSFC reports first by stnid and
C   second by obs time
CCCC  SORTID = (DSNAME.EQ.'ADPSFC  ')
      IFIND = 0
      DO  I = 0,255
         DO  J = 0,200
            IF(SUBSKP(I,J))  THEN
               IF(IFIND.EQ.0)  PRINT 7001
 7001 FORMAT(34X,'-- THE FOLLOWING BUFR MESSAGE TYPES/SUBTYPES WILL ',
     $ 'BE SKIPPED:')
               PRINT 7002, I,J
 7002 FORMAT(45X,'BUFR TYPE ',I3.3,', SUBTYPE ',I3.3)
               IFIND = 1
            END IF
         ENDDO
      ENDDO
      IF(IFIND.EQ.0)  PRINT 8003
 8003 FORMAT(10X,'-- ALL BUFR MESSAGE TYPES/SUBTYPES IN DATA DUMP FILE',
     $ ' WILL BE PROCESSED')
      IF(SORTID)  PRINT 8002
 8002 FORMAT(/34X,'-- REPORTS WILL BE LISTED IN ORDER OF ASCENDING ',
     $ 'STATION ID AND WITHIN THAT ASCENDING OBS TIME'///130('+')
     $ //43X,'READING IN REPORTS AND STORING FOR LATER SORT'/)
      PRINT 7004
 7004 FORMAT(//)

      GO TO 905

C-----------------------------------------------------------------------

  920 CONTINUE
      PRINT 566, IER
  566 FORMAT('RETURN CODE =',I3,'; PHYSICAL END-OF-FILE - DONE')
      IF(SORTID)  THEN
         PRINT 8006
 8006 FORMAT(//130('+')//23X,'ALL REPORTS HAVE BEEN READ IN AND STORED',
     $ ' - NEXT SORT BY STATION ID AND OBS TIME AND BEGIN LISTING'//)
         GO TO 7050
      END IF

      GO TO 906

C-----------------------------------------------------------------------

  950 CONTINUE

      IDATA1 = NINT(ADATA(1) * 100.)
      IDATA2 = NINT(ADATA(2) * 100.)

      IF(.NOT.GLOBAL)  THEN

C  DO A DOMAIN CHECK IF GLOBAL DOMAIN NOT SELECTED
C  -----------------------------------------------

cpppppppppp
cc       print'(" FOR THIS RPT, IDATA1 = ",I0,"; IDATA2 = ",I0)',
cc   $    IDATA1,IDATA2
cpppppppppp
         IF(IDATA1.LT.LATS.OR.IDATA1.GT.LATN)  THEN
            KNTLAT = KNTLAT + 1
            GO TO 905
         END IF
         IF(IDATA2.LT.LONW.OR.IDATA2.GT.LONE)  THEN
            KNTLON = KNTLON + 1
            GO TO 905
         END IF

      END IF

      IF(CHAR1.NE.'*')  THEN

C  DO A STNID CHECK IF NECESSARY
C  -----------------------------

cpppppppppp
cc       print'(" FOR THIS RPT, STNID = ",A)', STNID
cpppppppppp
         IF(STNID(1:1).NE.CHAR1)  THEN
            KNTCHR = KNTCHR + 1
            GO TO 905
         END IF

      END IF

      JJ = 0
      DO I = 13,25,2
         JJ = JJ + 1
         IF(IDATA(I).GT.0)  THEN
            PRINT 998, ICAT(JJ)
            CALL W3TAGE('BUFR_LISTDUMPS')
            CALL ERREXIT(33)
         END IF
      END DO
      JJ = JJ + 2
      DO I = 31,45,2
         JJ = JJ + 1
         IF(IDATA(I).GT.0)  THEN
            PRINT 998, ICAT(JJ)
            CALL W3TAGE('BUFR_LISTDUMPS')
            CALL ERREXIT(33)
         END IF
      END DO
  998 FORMAT('**BUFR_LISTDUMPS/LISTSFC: CANNOT PROCESS DATA IN CAT.',I4,
     $ ' - STOP 33')

      KOUNT = KOUNT + 1

      IF(.NOT.SORTID)  GO TO 7060

C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C    ADPSFC REPORTS COME HERE FOR STORAGE BECAUSE THEY WILL BE SORTED
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

      IF(KOUNT.GT.40000)  THEN
         PRINT 8014
 8014 FORMAT('**BUFR_LISTDUMPS/LISTSFC: THERE ARE MORE THAN 40000 ',
     $ 'ADPSFC REPORTS - THIS EXCEEDS THE SORT LIMIT - STOP 65'/)
         CALL W3TAGE('BUFR_LISTDUMPS')
         CALL ERREXIT(65)
      END IF

      ADATA_S(:,KOUNT) = ADATA
      ADATA2_S(:,KOUNT) = ADATA2
      ADATA3_S(:,:,:,KOUNT) = ADATA3
      NDATA3_S(:,KOUNT) = NDATA3
      adata8_8_s(:,kount) = adata8_8
      STNID_S(KOUNT)  = STNID
      CRES1_S(KOUNT) = CRES1
      CRES2_S(KOUNT) = CRES2
      SUBSET_S(KOUNT) = SUBSET
      STNID_S(KOUNT) = STNID
      GO TO 905
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

 7050 CONTINUE

C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C ALL ADPSFC REPORTS HAVE BEEN STORED, TIME TO SORT BY STATION ID AND
C WITHIN THAT OBS TIME AND THEN BEGIN PROCESS OF LISTING SORTED REPORTS
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

      CALL ORDERS( 2,IWORK,ADATA_S(4,1),INDX,KOUNT,MAXOBS,4,2)
      CALL ORDERS(10,IWORK,STNID_S,INDX,KOUNT,1,8,2)

      KNTOUT = 0

 8050 CONTINUE

      KNTOUT = KNTOUT + 1
      IF(KNTOUT.GT.KOUNT)  GO TO 906
      ADATA  = ADATA_S(:,INDX(KNTOUT))
      ADATA2 = ADATA2_S(:,INDX(KNTOUT))
      ADATA3 = ADATA3_S(:,:,:,INDX(KNTOUT))
      NDATA3 = NDATA3_S(:,INDX(KNTOUT))
      adata8_8 = adata8_8_s(:,INDX(KNTOUT))
      STNID  = STNID_S(INDX(KNTOUT))
      CRES1  = CRES1_S(INDX(KNTOUT))
      CRES2  = CRES2_S(INDX(KNTOUT))
      SUBSET  = SUBSET_S(INDX(KNTOUT))

C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

 7060 CONTINUE

C  CHANGE MISSING TO 10E10 (REAL) OR 99999999 (INTEGER)
C  ----------------------------------------------------

      DO I = 1,MAXOBS
         IF(ADATA(I).EQ.99999.) ADATA(I) = BMISS
         IF(IDATA(I).EQ.99999)  IDATA(I) = 99999999
      END DO

      C1 = 'N'
      C2 = 'E'
      c1_8 = 'N'
      c2_8 = 'E'
      ALAT = ADATA(1)
      IF(NINT(ADATA(1)*100.).LT.0)  THEN
         ALAT = -ALAT
         C1 = 'S'
      END IF
      ALON = ADATA(2)
      IF(NINT(ADATA(2)*100.).GT.18000)  THEN
         ALON = 360.00 - ALON
         C2 = 'W'
      END IF
      alat_8 = adata8_8(1)
      if(adata8_8(1).lt.0.)  then
         alat_8 = -alat_8
         c1_8 = 'S'
      end if
      alon_8 = adata8_8(2)
      if(adata8_8(2).lt.0.)  then
         alon_8 = -alon_8
         c2_8 = 'W'
      end if
      PRINT 7, STNID,ADATA(4),alat_8,c1_8,alon_8,c2_8,NINT(ADATA(7)),
     $ NINT(ADATA(12)),IDATA(8),ADATA(11),CRES1,CRES2,IDATA(9)
    7 FORMAT(1X,A8,1X,F9.5,'Z',3X,2(F11.5,A1,2X),2X,'ELV/QM  ',I5.5,
     $ 'M/',I1,4X,'ITP',I5.2,4X,'RCT',F6.2,'Z',4X,'RES "',A8,A8,'"',3X,
     $ 'RTP',I5.3)

      QAL   = BMISS
      QTP01 = BMISS
      QTP24 = BMISS
      IQM   = IMISS
      IF(IDATA(27).GT.0)  THEN
         IF(DSNAME.EQ.'MSONET  ')  THEN

C  MESONET DATA IN CATEGORY 8
C  (just store, will print all but alt. qm, TP01 qm & TP24 qm later)
C  -----------------------------------------------------------------

            N = IDATA(28) - 4
            M = IDATA(28) - 4
            I = 0
            DO NLVL = 1,IDATA(27)
               N = N + 4
               IF(NINT(ADATA(N+1)).EQ.3)  THEN
                  I = I + 1
                  IF(I.GT.3)  EXIT
                  CDATUM(I) = 'DIF SR (J/M**2)'
                  CIND2(I)  = 'TIME PER (MIN) '
                  OB8(I) = MIN(XMISS,ADATA(N)*100.)
                  Q82(I) = MIN(XMISS,ADATA(N+3))
               ELSE IF(NINT(ADATA(N+1)).EQ.4)  THEN
                  I = I + 1
                  IF(I.GT.3)  EXIT
                  CDATUM(I) = 'DIR SR (J/M**2)'
                  CIND2(I)  = 'TIME PER (MIN) '
                  OB8(I) = MIN(XMISS,ADATA(N)*100.)
                  Q82(I) = MIN(XMISS,ADATA(N+3))
               ELSE IF(NINT(ADATA(N+1)).EQ.5)  THEN
                  QTP01 = MIN(XMISS,ADATA(N))
               ELSE IF(NINT(ADATA(N+1)).EQ.6)  THEN
                  QTP24 = MIN(XMISS,ADATA(N))
               ELSE IF(NINT(ADATA(N+1)).EQ.20)  THEN
                  QAL = MIN(XMISS,ADATA(N))
               ELSE IF(NINT(ADATA(N+1)).EQ.198)  THEN
                  I = I + 1
                  IF(I.GT.3)  EXIT
                  CDATUM(I) = 'RAIN RTE (MM/H)'
                  CIND2(I)  = 'QUALITY MARKER '
                  OB8(I) = MIN(XMISS,ADATA(N)*3600.)
                  Q82(I) = MIN(XMISS,ADATA(N+3))
               END IF
            END DO
         ELSE IF(DSNAME.EQ.'ADPSFC  ')  THEN

C  SURFACE LAND DATA IN CATEGORY 8 (currently only alt. q.m)
C  ---------------------------------------------------------

            N = IDATA(28) - 4
            M = IDATA(28) - 4
            I = 0
            DO NLVL = 1,IDATA(27)
               N = N + 4
               IF(NINT(ADATA(N+1)).EQ.20)  THEN
                  QAL = MIN(XMISS,ADATA(N))
               END IF
            END DO
         END IF
      END IF

      IF(IDATA(29).GT.0)  THEN

C  CAT. 51 & DATA RETURNED DIRECTLY FROM BUFR DUMP FILE (ADATA2 ARRAY)
C  -------------------------------------------------------------------

         IF(IDATA(29).NE.1)  THEN
            PRINT 991, ICAT(9)
  991 FORMAT('**BUFR_LISTDUMPS/LISTSFC: MORE THAN 1 LEVEL IN CAT. ',I3,
     $ '- STOP 44')
            CALL W3TAGE('BUFR_LISTDUMPS')
            CALL ERREXIT(44)
         END IF

         N51 = IDATA(30) - 1

cpppppppppp
cc       DO NN=1,13
cc          IF(NINT(ADATA(N51+NN)).LT.0)  print'(" Cat. 51 Word ",I0,
cc   $       " < 0")', NN
cc       END DO
cpppppppppp

         CQM = '--'
         DO  II=1,5
            IF(NINT(ADATA(N51+8+II)).NE.2)
     $       WRITE(CQM(II),'(I2.2)') NINT(ADATA(N51+8+II))
         ENDDO

         IF(DSNAME.EQ.'ADPSFC')  THEN
            IF(IDATA(9).EQ.512) THEN ! Land METARs
               PRINT 7012, (NINT(ADATA(N51+NN)),NN=1,6),
     $         (CQM(II),II=1,5),(NINT(ADATA2(I)),I=38,39),
     $         NINT(ADATA2(3)),NINT(QAL),ADATA2(17),ADATA2(18),
     $         ADATA2(19),ADATA2(21)
 7012 FORMAT('MSL/STNP:',I5.5,'/',I5.5,1X,I3.3,'/',I4.4,1X,I5.3,1X,
     $ I3.3,1X,5A2,1X,', CHPT ',I2,', 3HPC ',I5,', ALSE/QM ',I6,'/',I2,
     $ ', TP01 ',F6.1,', TP03 ',F6.1,', TP06 ',F6.1,', TP24 ',F6.1)
               IF(MIN(ADATA2(1),ADATA2(2)).LT.BMISS)  PRINT 1144,
     $          (NINT(ADATA2(I)),I=1,2)
 1144 FORMAT('RSRD ',I3,', EXPRSRD ',I3)
               IF(ADATA2(22).LT.BMISS) PRINT 1114, NINT(ADATA2(22))
 1114 FORMAT(' TOSS ',I4)
            ELSE ! Land SYNOPs
               PRINT 7063, (NINT(ADATA(N51+NN)),NN=1,6),
     $         (CQM(II),II=1,5),(NINT(ADATA2(I)),I=38,40),
     $         (ADATA2(I),NINT(ADATA2(I+1)),I=32,34,2)
 7063 FORMAT('MSL/STNP:',I5.5,'/',I5.5,1X,I3.3,'/',I4.4,1X,I5.3,1X,I3.3,
     $ 1X,5A2,1X,', CHPT ',I2,', 3HPC ',I5,', 24PC ',I6,', HOWV ',F5.1,
     $ ', POWV ',I2,', HOWW ',F5.1,', POWW ',I2)
               IF(MIN(ADATA2(1),ADATA2(2),ADATA2(17),ADATA2(18),
     $          ADATA2(19),ADATA2(20),ADATA2(21),ADATA2(23),ADATA2(24))
     $          .LT.BMISS) PRINT 7164, (NINT(ADATA2(I)),I=1,2),
     $          (ADATA2(I),I=17,21),(NINT(ADATA2(I)),I=23,24)
 7164 FORMAT('RSRD ',I3,', EXPRSRD ',I3,', TP01 ',F6.1,', TP03 ',F6.1,
     $ ', TP06 ',F6.1,', TP12 ',F6.1,', TP24 ',F6.1,', TOCC ',I3,
     $ ', HBLCS ',I2)
            END IF
                 ! Land METARs and SYNOPs
            IF(MIN(ADATA2(29),ADATA2(30),ADATA2(31)).LT.BMISS)
     $       PRINT 8144, NINT(ADATA2(29)),(ADATA2(I),I=30,31)
 8144 FORMAT('.DTHDOFS ',I3,', DOFS ',F5.2,', TOSD ',F6.2)
            IF(MIN(ADATA2(4),ADATA2(41),ADATA2(6),ADATA2(7),ADATA2(8),
     $       ADATA2(9),ADATA2(10),ADATA2(11),ADATA2(12),ADATA2(13),
     $       ADATA2(14),ADATA2(15)).LT.BMISS)  PRINT 7154, ADATA2(4),
     $       NINT(ADATA2(41)),(NINT(ADATA2(I)),I=6,11),ADATA2(12),
     $       (NINT(ADATA2(I)),I=13,14),ADATA2(15)
 7154 FORMAT('SST1 ',F6.2,', SSTQM ',I2,', MSST ',I1,', .REHOVI ',I1,
     $ ', HOVI ',I5,', VTVI ',I4,', PSW1 ',I2,', PSW2 ',I2,', PKWDSP ',
     $ F5.1,', PKWDDR ',I3,', .DTMMXGS ',I2,', MXGS ',F5.1)
         ELSE  IF(DSNAME.EQ.'MSONET  ')  THEN ! mesonets
            PRINT 8062, (NINT(ADATA(N51+NN)),NN=1,6),(CQM(II),II=1,5),
     $       (NINT(ADATA2(I)),I=1,2),ADATA2(15),NINT(ADATA2(16)),
     $       NINT(ADATA2(3)),NINT(QAL)
 8062 FORMAT('MSL/STNP:',I5.5,'/',I5.5,1X,I3.3,'/',I4.4,1X,I5.3,1X,
     $ I3.3,1X,5A2,1X,', RSRD ',I3,', EXPRSRD ',I3,', MXGS ',F5.1,
     $ ', MXGD ',I3,', ALSE/QM ',I6,'/',I2)

         ELSE  IF(DSNAME.EQ.'SFCSHP')  THEN
            
            IF(IDATA(9).EQ.562.OR.IDATA(9).EQ.564) THEN ! drifting buoys

               PRINT 9063, (NINT(ADATA(N51+NN)),NN=1,6),
     $         (CQM(II),II=1,5),ADATA2(4),NINT(ADATA2(41)),ADATA2(5),
     $         (NINT(ADATA2(I)),I=38,39),ADATA2(32),NINT(ADATA2(33))
 9063 FORMAT('MSL/STNP:',I5.5,'/',I5.5,1X,I3.3,'/',I4.4,1X,I5.3,1X,I3.3,
     $ 1X,5A2,', SST1 ',F6.2,', SSTQM ',I2,', DBSS ',F4.1,', CHPT ',I2,
     $ ', 3HPC ',I5,', HOWV ',F5.1,', POWV ',I2)
               IF(MIN(ADATA2(1),ADATA2(2)).LT.BMISS)  PRINT 1144,
     $          (NINT(ADATA2(I)),I=1,2)

            ELSE IF(IDATA(9).EQ.522.OR.IDATA(9).EQ.523) THEN ! ships

               PRINT 8063, (NINT(ADATA(N51+NN)),NN=1,6),
     $         (CQM(II),II=1,5),ADATA2(4),NINT(ADATA2(41)),
     $         NINT(ADATA2(6)),(NINT(ADATA2(I)),I=38,39),
     $         NINT(ADATA2(24)),(NINT(ADATA2(I)),I=36,37)
 8063 FORMAT('MSL/STNP:',I5.5,'/',I5.5,1X,I3.3,'/',I4.4,1X,I5.3,1X,I3.3,
     $ 1X,5A2,', SST1 ',F6.2,', SSTQM ',I2,', MSST ',I1,', CHPT ',I2,
     $ ', 3HPC ',I5,', HBLCS ',I2,', TDMP ',I2,', ASMP ',I2)
               IF(MIN(ADATA2(1),ADATA2(2)).LT.BMISS)  PRINT 1144,
     $          (NINT(ADATA2(I)),I=1,2)
               IF(MIN(ADATA2(32),ADATA2(33),ADATA2(34),ADATA2(35),
     $          ADATA2(9),ADATA2(10),ADATA2(11),ADATA2(23),ADATA2(8),
     $          ADATA2(14),ADATA2(15),ADATA2(40)).LT.BMISS)
     $          PRINT 56, (ADATA2(I),NINT(ADATA2(I+1)),I=32,34,2),
     $          (NINT(ADATA2(I)),I=9,11),NINT(ADATA2(23)),
     $          NINT(ADATA2(8)),NINT(ADATA2(14)),ADATA2(15),
     $          NINT(ADATA2(40))
   56 FORMAT('HOWV ',F5.1,', POWV ',I2,', HOWW ',F5.1,', POWW ',I2,
     $ ', VTVI ',I4,', PSW1 ',I2,', PSW2 ',I2,', TOCC ',I3,', HOVI ',I5,
     $ ', .DTMMXGS ',I2,', MXGS ',F5.1,', 24PC ',I6)

            ELSE ! all other marine

               PRINT 8093, (NINT(ADATA(N51+NN)),NN=1,6),
     $         (CQM(II),II=1,5),ADATA2(4),NINT(ADATA2(41)),
     $         NINT(ADATA2(6)),(NINT(ADATA2(I)),I=38,39),
     $         NINT(ADATA2(8)),NINT(ADATA2(14))
 8093 FORMAT('MSL/STNP:',I5.5,'/',I5.5,1X,I3.3,'/',I4.4,1X,I5.3,1X,I3.3,
     $ 1X,5A2,', SST1 ',F6.2,', SSTQM ',I2,', MSST ',I1,', CHPT ',I2,
     $ ', 3HPC ',I5,', HOVI ',I5,', .DTMMXGS ',I2)
               IF(MIN(ADATA2(1),ADATA2(2)).LT.BMISS)  PRINT 1144,
     $          (NINT(ADATA2(I)),I=1,2)
               IF(MIN(ADATA2(15),ADATA2(32),ADATA2(33),ADATA2(34),
     $          ADATA2(35),ADATA2(10),ADATA2(11),ADATA2(12),ADATA2(13),
     $          ADATA2(25),ADATA2(26)).LT.BMISS)
     $          PRINT 58, ADATA2(15),(ADATA2(I),
     $          NINT(ADATA2(I+1)),I=32,34,2),(NINT(ADATA2(I)),I=10,11),
     $          ADATA2(12),NINT(ADATA2(13)),ADATA2(25),ADATA2(26)
   58 FORMAT('MXGS ',F5.1,', HOWV ',F5.1,', POWV ',I2,', HOWW ',F5.1,
     $ ', POWW ',I2,', PSW1 ',I2,', PSW2 ',I2,', PKWDSP ',F5.1,
     $ ', PKWDDR ',I3,', XS10 ',F5.1,', XS20 ',F5.1)

            END IF

         ELSE  IF(DSNAME.EQ.'SFCBOG')  THEN
            PRINT 8069, (NINT(ADATA(N51+1)))
 8069 FORMAT('MEAN SEA-LEVEL PRESSURE (x 10 mb): ',I5.5)

         END IF
      END IF

      IF(IDATA(27).GT.0)  THEN
         IF(DSNAME.EQ.'MSONET  ')  THEN

C  MESONET DATA IN CATEGORY 8 (already stored & ready to print)
C  ------------------------------------------------------------

            ILV = MIN(IDATA(27)-3,3)
            IF(ILV.GT.0)  PRINT 777, (CDATUM(I),OB8(I),CIND2(I),Q82(I),
     $       I=1,ILV)
  777 FORMAT(2(1X,'|| ',A15,F9.1,2X,A15,F9.1),' ||')

         ELSE

C  ALL OTHER CATEGORY 8 SURFACE DATA (store and then print)
C  --------------------------------------------------------

            N = IDATA(28) - 20
            J = 0
            DO NLVL = 1,IDATA(27),5
               J = J + 1
               N = N + 20
               IF(NLVL+1.GT.IDATA(27))  THEN
                  ADATA(N) = MIN(ADATA(N),XMISS)
                  PRINT 7091,CCAT8(J),NINT(ADATA(N)),
     $            (NINT(ADATA(N+II)),II=1,3)
 7091             FORMAT(1X,A10,I6.5,1X,I3.3,2(1X,I5.5),2X)
               ELSE  IF(NLVL+2.GT.IDATA(27))  THEN
                  DO II = 4,8,4
                     ADATA(N-4+II) = MIN(ADATA(N-4+II),XMISS)
                  ENDDO
                  PRINT 7092,CCAT8(J),NINT(ADATA(N)),
     $            (NINT(ADATA(N+II)),II=1,3),NINT(ADATA(N+4)),
     $            (NINT(ADATA(N+4+II)),II=1,3)
 7092             FORMAT(1X,A10,2(I6.5,1X,I3.3,2(1X,I5.5),2X))
               ELSE  IF(NLVL+3.GT.IDATA(27))  THEN
                  DO II = 4,12,4
                     ADATA(N-4+II) = MIN(ADATA(N-4+II),XMISS)
                  ENDDO
                  PRINT 7093,CCAT8(J),NINT(ADATA(N)),
     $            (NINT(ADATA(N+II)),II=1,3),NINT(ADATA(N+4)),
     $            (NINT(ADATA(N+4+II)),II=1,3),NINT(ADATA(N+8)),
     $            (NINT(ADATA(N+8+II)),II=1,3)
 7093             FORMAT(1X,A10,3(I6.5,1X,I3.3,2(1X,I5.5),2X))
               ELSE  IF(NLVL+4.GT.IDATA(27))  THEN
                  DO II = 4,16,4
                     ADATA(N-4+II) = MIN(ADATA(N-4+II),XMISS)
                  ENDDO
                  PRINT 7094,CCAT8(J),NINT(ADATA(N)),
     $            (NINT(ADATA(N+II)),II=1,3),NINT(ADATA(N+4)),
     $            (NINT(ADATA(N+4+II)),II=1,3),NINT(ADATA(N+8)),
     $            (NINT(ADATA(N+8+II)),II=1,3),NINT(ADATA(N+12)),
     $            (NINT(ADATA(N+12+II)),II=1,3)
 7094             FORMAT(1X,A10,4(I6.5,1X,I3.3,2(1X,I5.5),2X))
               ELSE
                  DO II = 4,20,4
                     ADATA(N-4+II) = MIN(ADATA(N-4+II),XMISS)
                  ENDDO
                  PRINT 7095,CCAT8(J),NINT(ADATA(N)),
     $            (NINT(ADATA(N+II)),II=1,3),NINT(ADATA(N+4)),
     $            (NINT(ADATA(N+4+II)),II=1,3),NINT(ADATA(N+8)),
     $            (NINT(ADATA(N+8+II)),II=1,3),NINT(ADATA(N+12)),
     $            (NINT(ADATA(N+12+II)),II=1,3),NINT(ADATA(N+16)),
     $            (NINT(ADATA(N+16+II)),II=1,3)
 7095             FORMAT(1X,A10,5(I6.5,1X,I3.3,2(1X,I5.5),2X))
               END IF
            END DO
         END IF
      END IF

C  DATA RETURNED DIRECTLY FROM BUFR DUMP FILE (ADATA3 ARRAY)
C  ---------------------------------------------------------

cpppppppppp
cc    print'(1X)'
cc    print'(" NDATA3 = ",7(I0,1X))', ndata3
cpppppppppp
      if(ndata3(1).gt.0) then
         if(ndata3(1).eq.1) then
            if(min(adata3(1,1,1),adata3(2,1,1)).ge.bmiss) go to 401
         end if
cpppppppppp
cc       print'(1X)'
cc       print'(" ADATA3(*,*,1):")'
cpppppppppp
         IF(NDATA3(1).EQ.1) THEN
            JNDX = 1
            IF(NINT(ADATA3(1,1,1)).EQ.1.AND.QTP01.LT.BMISS) THEN
               IQM(1)=NINT(QTP01)
            ELSE IF(NINT(ADATA3(1,1,1)).EQ.24.AND.QTP24.LT.BMISS) THEN
               IQM(1)=NINT(QTP24)
            END IF
            PRINT 1135, (J,NINT(ADATA3(1,J,1)),ADATA3(2,J,1),IQM(J),
     $       J=1,1)
         ELSE
            DO K = 1,NDATA3(1),3
               DO L = 3,2,-1
                  IF(K+(L-1).LE.NDATA3(1))  THEN
                     JNDX = L
                     DO J = K,K+(L-1)
                        IF(NINT(ADATA3(1,J,1)).EQ.1.AND.
     $                   QTP01.LT.BMISS) THEN
                           IQM(J)=NINT(QTP01)
                        ELSE IF(NINT(ADATA3(1,J,1)).EQ.24
     $                   .AND.QTP24.LT.BMISS) THEN
                           IQM(J)=NINT(QTP24)
                        END IF
                     ENDDO
                     PRINT 1135, (J,NINT(ADATA3(1,J,1)),
     $                ADATA3(2,J,1),IQM(J),J=K,K+(L-1))
                     EXIT
                  END IF
               ENDDO
            ENDDO
         END IF
 1135 FORMAT(<JNDX>(' L',I1,': .DTHTOPC ',I3,', TOPC/QM ',F6.1,'/',I2,
     $ ' |'))
      end if
  401 continue
      if(ndata3(2).gt.0) then
         if(ndata3(2).eq.1) then
            if(adata3(1,1,2).ge.bmiss) go to 402
         end if
cpppppppppp
cc       print'(1X)'
cc       print'(" ADATA3(*,*,2):")'
cpppppppppp
         IF(NDATA3(2).EQ.1) THEN
            JNDX = 1
            PRINT 1136, (J,NINT(ADATA3(1,J,2)),J=1,1)
         ELSE
            DO K = 1,NDATA3(2),8
               DO L = 8,2,-1
                  IF(K+(L-1).LE.NDATA3(2))  THEN
                     JNDX = L
                     PRINT 1136, (J,NINT(ADATA3(1,J,2)),J=K,K+(L-1))
                     EXIT
                  END IF
               ENDDO
            ENDDO
         END IF
 1136 FORMAT(<JNDX>(' L',I1,': PRWE ',I3,' |'))
      end if
  402 continue
      if(ndata3(3).gt.0) then
         if(ndata3(3).eq.1) then
            if(min(adata3(1,1,3),adata3(2,1,3),adata3(3,1,3),
     $       adata3(4,1,3),adata3(5,1,3)).ge.bmiss) go to 403
         end if
cpppppppppp
cc       print'(1X)'
cc       print'(" ADATA3(*,*,3):")'
cpppppppppp
         DO K = 1,NDATA3(3),2
            IF(K+1.LE.NDATA3(3))  THEN
               JNDX = 2
               PRINT 1137, (J,(NINT(ADATA3(I,J,3)),I=1,5),J=K,K+1)
            ELSE
               JNDX = 1
               PRINT 1137, (J,(NINT(ADATA3(I,J,3)),I=1,5),J=K,K)
            END IF
 1137 FORMAT(<JNDX>(' L',I1,': VSSO ',I2,', CLAM ',I2,', CLTP ',I2,
     $ ', HOCB ',I5,', HOCT ',I5,' |'))
         ENDDO
      end if
  403 continue
      if(ndata3(4).gt.0) then
         if(ndata3(4).eq.1) then
            if(min(adata3(1,1,4),adata3(2,1,4),adata3(3,1,4),
     $       adata3(4,1,4)).ge.bmiss) go to 404
         end if
cpppppppppp
cc       print'(1X)'
cc       print'(" ADATA3(*,*,4):")'
cpppppppppp
         DO K = 1,NDATA3(4),2
            IF(K+1.LE.NDATA3(4))  THEN
               JNDX = 2
               PRINT 1138, (J,(NINT(ADATA3(I,J,4)),
     $          ADATA3(I+1,J,4),I=1,3,2),J=K,K+1)
            ELSE
               JNDX = 1
               PRINT 1138, (J,(NINT(ADATA3(I,J,4)),
     $          ADATA3(I+1,J,4),I=1,3,2),J=K,K)
            END IF
 1138 FORMAT(<JNDX>(' L',I1,': .DTHMXTM ',I3,', MXTM ',F6.2,
     $ ', .DTHMITM ',I3,', MITM ',F6.2,' |'))
         ENDDO
      end if
  404 continue
      if(ndata3(5).gt.0) then
         if(ndata3(5).eq.1) then
            if(min(adata3(1,1,5),adata3(2,1,5)).ge.bmiss) go to 405
         end if
cpppppppppp
cc       print'(1X)'
cc       print'(" ADATA3(*,*,5):")'
cpppppppppp
         IF(NDATA3(5).EQ.1) THEN
            JNDX = 1
            PRINT 4135, (J,NINT(ADATA3(1,J,5)),ADATA3(2,J,5),
     $       NINT(ADATA3(3,J,5)),J=1,1)
         ELSE
            DO K = 1,NDATA3(5),3
               DO L = 3,2,-1
                  IF(K+(L-1).LE.NDATA3(5))  THEN
                     JNDX = L
                     PRINT 4135, (J,NINT(ADATA3(1,J,5)),ADATA3(2,J,5),
     $                NINT(ADATA3(3,J,5)),J=K,K+(L-1))
                     EXIT
                  END IF
               ENDDO
            ENDDO
         END IF
 4135 FORMAT(<JNDX>(' L',I1,': DOSW ',I3,', HOSW ',F5.1,', POSW ',I2,
     $ ' |'))
      end if
  405 continue

      PRINT 993                             
  993 FORMAT(' ')
      
      IF(SORTID)  GO TO 8050

      GO TO 905

C-----------------------------------------------------------------------

  906 CONTINUE
      PRINT 9004, NUNIT,KOUNT
 9004 FORMAT(//45X,'--> ALL REPORTS IN FILE',I3,' PROCESSED <--'//48X,
     $ '*** ',I5,' REPORTS LISTED HERE ***'/)
      IF(KNTLAT.GT.0)  PRINT 9005, KNTLAT
 9005 FORMAT(' --> ',I6,' REPORTS OUTSIDE OF SELECTED LATITUDE  BAND ',
     $ 'AND NOT LISTED HERE <--'/)
      IF(KNTLON.GT.0)  PRINT 9006, KNTLON
 9006 FORMAT(' --> ',I6,' REMAINING REPORTS OUTSIDE OF SELECTED ',
     $ 'LONGITUDE BAND AND NOT LISTED HERE <--'/)
      IF(KNTCHR.GT.0)  PRINT 9007, KNTCHR
 9007 FORMAT(' --> ',I6,' REMAINING REPORTS NOT OF REQUESTED STNID ',
     $ 'NOT LISTED HERE <--'/)
      PRINT 9008
 9008 FORMAT(/40X,'>>>  SUCCESSFUL COMPLETION OF PROGRAM ',
     $ 'BUFR_LISTDUMPS <<<'/)

      RETURN

C-----------------------------------------------------------------------

  999 CONTINUE
      PRINT 567, IER
  567 FORMAT('**BUFR_LISTDUMPS/LISTSFC: RETURN CODE =',I3,'; SOME TYPE',
     $ ' OF ERROR IN DECODING REPORT FROM INPUT BUFR FILE - STOP 99')
      CALL W3TAGE('BUFR_LISTDUMPS')
      CALL ERREXIT(99)

C-----------------------------------------------------------------------


      END
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    LISTPROFILER
C   PRGMMR: D. A. KEYSER     ORG: NP22       DATE: 2017-10-13
C
C ABSTRACT: LISTS CONTENTS OF A TIME-WINDOWED WIND PROFILER BUFR DATA
C   DUMP FILE.  THE STANDARD OUTPUT IS IN AN EASY-TO-READ FORMAT.
C   NOTE: THIS SUBROUTINE CAN HANDLE THE FOLLOWING BUFR DATA DUMP
C   FILE TYPE: PROFLR {ALL TYPES EXCEPT FOR THOSE ORIGINATING FROM
C   PILOT (PIBAL) FORMAT BULLETINS WHICH ARE PROCESSED BY SUBROUTINE
C   "LISTUPA"}.
C
C PROGRAM HISTORY LOG:
C 2000-03-28  D.A. KEYSER -- ORIGINAL AUTHOR
C 2001-04-06  D.A. KEYSER -- TESTS FOR IRET = 8 FROM W3UNPKB7 - IF
C     FOUND MEANS A NEW BUFR MESSAGE WAS READ WITH SUBSET "NC002009",
C     AND CALLS SUBR. "LISTUPA" TO PROCESS THE REPORTS; ACCOUNTS FOR
C     CHANGE IN W3UNPKB7 WHICH RETURNS FULL DATE (YYYYMMDDHH) IN
C     HEADER WORD 5
C 2002-03-05  D.A. KEYSER -- SUBR. W3UNPKB7 ARGUMENT RDATA MUST BE
C     DIMENSIONED AT LEAST 1200 NOW TO ACCOUNT FOR 64 POSSIBLE WIND
C     PROFILER LEVELS FROM NOAA/FSL, RDATA INCREASED FROM 800 TO 1200
C     IN THIS PROGRAM
C 2004-02-02  KEYSER -- ARRAY SUBSKP BUMPED UP FROM (0:12,200) TO
C     (0:255,0:200) AND NOW IT CAN ALSO BE READ IN FOR NON-UPA AND
C     NON-SFC TYPES IN NAMELIST PDATA
C 2016-11-30  D. A. KEYSER -- Reads new output real, double-precision
C     argument array RDATA8_8 of length 2 in call to W3UNPKB7.  This
C     new array, which returns latitude and longitude for each report,
C     is currently not referenced by this subroutine.
C 2017-10-13  D. A. KEYSER -- Added minutes to every print statement
C     that includes the central dump time.  Central dump time minutes is
C     obtained from Section 1 of first (dummy) message of input dump
C     file via call to BUFRLIB routine IUPVS01.
C     BENEFIT: Until now, central dump time minutes was always zero.
C              However, with the implementation of the new RTMA_RU,
C              central dump time can now also have minutes = 15, 30
C              or 45 (since the RTMA_RU runs 4 times per hour). This
C              change allows the print statements to reflect this new
C              center dump time format.
C
C USAGE:    CALL LISTPROFILER
C
C   INPUT FILES: 
C     UNIT 05  - INPUT DATA CARDS IN THE FORM OF A NAMELIST (SEE
C              - REMARKS IN MAIN PROGRAM DOCBLOCK)
C     UNIT 21  - BUFR DATA SET
C
C   OUTPUT FILES:
C     UNIT 06  - STANDARD OUTPUT PRINT
C
C REMARKS: NONE.
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE:  NCEP WCOSS
C
C$$$

      SUBROUTINE LISTPROFILER

      LOGICAL SNDG,RETR,RADN,SUBSKP(0:255,0:200)
      INTEGER  NWINDO(2),IDATE(4),MDATE(4),IDATA(2500)
      INTEGER(8)  IDSDMP_8
      REAL  RDATA(2500),RDATA2(25)
      REAL(8) BMISS,rdata8_8(2)
      CHARACTER*1  C1,C2
      CHARACTER*8  STNID,DSNAME,SUBSET
      CHARACTER*9  TEXT1

      COMMON/BUFRLIB_MISSING/BMISS

      EQUIVALENCE (RDATA,IDATA)
      DATA  XMISS/99999./

      NAMELIST/PDATA/IDAT10,IWINDE,IWINDL,IPRINT,SNDG,RETR,RADN,SUBSKP

      SUBSKP = .FALSE.
      READ(5,PDATA)

      IDATE(1) = IDAT10/1000000
      IDATE(2) = MOD((IDAT10/10000),100)
      IDATE(3) = MOD((IDAT10/100),100)
      IDATE(4) = MOD(IDAT10,100)

      IUNIT   = 21
      NWINDO(1) = IWINDE
      NWINDO(2) = IWINDL

      KNTRPT = 0

 2090 CONTINUE

C CALL W3UNPKB7 TO UNPACK THE NEXT WIND PROFILER REPORT

      IRET = IPRINT

      PRINT'(1X)'

      CALL W3UNPKB7(IDATE,NWINDO(1),NWINDO(2),IUNIT,RDATA,STNID,DSNAME,
     $ RDATA2,rdata8_8,IDSDAT,IDSDMP_8,SUBSET,SUBSKP,IRET)
C-----------------------------------------------------------------------
      IF(IRET.EQ.1)  THEN

C IRET = 1 RETURNS DATA SET INFO (ONLY) AFTER FIRST CALL

         IF(IPRINT.LT.0)  PRINT'(" RETURN CODE =",I0,"; DATA SET ",
     $    "INFORMATION RETURNED")', IRET
         PRINT 102, DSNAME,IUNIT
  102    FORMAT(//46X,'*****  ',A8,'  --  UNIT =',I3,'  *****')

C SPLIT DATE INTO COMPONENTS (MDATE)
         MDATE(1) = IDSDAT/1000000
         MDATE(2) = MOD((IDSDAT/10000),100)
         MDATE(3) = MOD((IDSDAT/100),100)
         MDATE(4) = MOD(IDSDAT,100)
c-----------------------------------------------------------------------
c  Read 1st dummy message in file so can then call iupvs01 to get iminu
         call readmg(iunit,subset,ibdate,kret)
         iminu = iupvs01(iunit,'MINU')
c  Close file and reopen so W3UNPKB7 will handle things as though this
c   block of code never exited
         call closbf(iunit)
         call openbf(iunit,'IN',iunit)
c-----------------------------------------------------------------------
         PRINT 1101, DSNAME,MDATE,iminu,IDSDMP_8
 1101    FORMAT(20X,'DATASET NAME: ',A8,'  --  DATE: ',I4.4,2('-',I2.2),
     $    1X,I2.2,i2.2,'Z  -- DUMP DATE (I12 FORMAT): ',I12.12/)

C DOES DATE FROM DATA SET MATCH EXPECTED CENTER DATE?

         IF(IDSDAT.NE.IDAT10)  THEN
            PRINT 324
  324 FORMAT(/13X,'>>>>>   P R O B L E M :   B U F R   F I L E   ',
     $ 'D A T E   D O E S   N O T   M A T C H   E X P E C T E D   ',
     $ 'D A T E   <<<<<'/)
            GO TO 7003
         END IF
         IFIND = 0
         DO  I = 0,255
            DO  J = 0,200
               IF(SUBSKP(I,J))  THEN
                  IF(IFIND.EQ.0)  PRINT 7000
 7000 FORMAT(34X,'-- THE FOLLOWING BUFR MESSAGE TYPES/SUBTYPES WILL BE',
     $ ' SKIPPED:')
                  PRINT 7001, I,J
 7001 FORMAT(45X,'BUFR TYPE ',I3.3,', SUBTYPE ',I3.3)
                  IFIND = 1
               END IF
            ENDDO
         ENDDO
         IF(IFIND.EQ.0)  PRINT 7002
 7002 FORMAT(34X,'-- ALL BUFR MESSAGE TYPES/SUBTYPES IN DATA DUMP FILE',
     $ ' WILL BE PROCESSED')
         PRINT 7004
 7004    FORMAT(//)
         GO TO 2090
C----------------------------------------------------------------------
      ELSE  IF(IRET.EQ.8)  THEN
C A NEW BUFR MESSAGE WAS READ WITH TYPE 002, SUBTYPE 009 - THIS MESSAGE
C  CONTAINS WIND PROFILER REPORTS ORIGINATING FROM PILOT (PIBAL)
C  BULLETINS - USE SUBROUTINE LISTUPA TO UNPACK AND LIST
         PRINT 892, IUNIT,SUBSET
  892 FORMAT(/'##BUFR_LISTDUMPS/LISTPROFILER: BUFR MESSAGE IN UNIT',I3,
     $ ' CONTAINS WIND PROFILER REPORTS ORIG. FROM PILOT (PIBAL) ',
     $ ' BULLETINS (SUBSET=',A8,')'/31X,'USE SUBROUTINE LISTUPA TO ',
     $ 'UNPACK AND LIST THESE REPORTS'/)
         IOPENED = 1
         CALL LISTUPA(IOPENED,KNTRPT,DSNAME,IDSDAT,IDSDMP_8,SUBSET)
         RETURN
C----------------------------------------------------------------------
      ELSE  IF(IRET.GT.2)  THEN
C PROBLEM READING WIND PROFILER REPORT, GO ON TO NEXT REPORT
         PRINT 912
  912    FORMAT(' * * ERROR READING WIND PROFILER REPORT, TRY NEXT ONE')
         GO TO 2090
C----------------------------------------------------------------------
C ALL DONE
      ELSE  IF(IRET.EQ.2)  THEN
         GO TO 7003
      END IF
C----------------------------------------------------------------------

      KNTRPT = KNTRPT + 1

C PRINT OUT REPORT AS FOUND IN OUTPUT ARRAY 'IDATA'
      IF(IPRINT.LT.0)  PRINT 8890,(IDATA(K),K=35,38)
 8890 FORMAT(1X,'>> PRINTOUT OF OUTPUT IDATA ARRAY:'//1X,'NO. CAT. 10 ',
     $ 'LVLS=',I1,';  CAT. 10 DATA SUBSCRIPT=',I2,';  NO. CAT. 11 LVLS='
     $ ,I2,';  CAT. 11 DATA SUBSCRIPT=',I3/)
      C1 = 'N'
      C2 = 'E'

      ALAT = RDATA(1)
      IF(RDATA(1).LT.0.0)  THEN
         ALAT = -ALAT
         C1 = 'S'
      END IF
      ALON = RDATA(2)
      IF(RDATA(2).GT.180.00)  THEN
         ALON = 360.00 - ALON
         C2 = 'W'
      END IF

      IF(RDATA2(5).LT.BMISS)  THEN
         ISBMD = NINT(RDATA2(5))
      ELSE
         ISBMD = 3
      END IF
      PRINT 9890, STNID(1:5),RDATA(4),ALAT,C1,ALON,C2,NINT(RDATA(7)),
     $ IDATA(9),NINT(RDATA2(1)),ISBMD,NINT(RDATA2(6)),IDATA(5)
 9890 FORMAT(1X,A5,3X,F8.5,'Z',3X,F5.2,A1,3X,F6.2,A1,3X,'ELEV ',I5,
     $ 'M',3X,'RPT TYPE ',I3.3,3X,'TSIG ',I2,3X,'SUBMODE ',I2,3X,
     $ 'TAVG ',I4,'MIN',3X,'DATE ',I10.10)
      IF(IDATA(35).GT.0)  THEN
         PMSL = XMISS
         PSTN = XMISS
         WSPD = XMISS
         TEMP = XMISS
         IF(RDATA(IDATA(36)).LT.XMISS)    PMSL = RDATA(IDATA(36))*0.1
         IF(RDATA(IDATA(36)+1).LT.XMISS)  PSTN = RDATA(IDATA(36)+1)*0.1
         IF(RDATA(IDATA(36)+3).LT.XMISS)  WSPD = RDATA(IDATA(36)+3)*0.1
         IF(RDATA(IDATA(36)+4).LT.XMISS)  TEMP = RDATA(IDATA(36)+4)*0.1
         PRINT 9891, PMSL,PSTN,NINT(RDATA(IDATA(36)+2)),WSPD,TEMP,
     $    NINT(RDATA(IDATA(36)+5)),RDATA(IDATA(36)+6)*3600.
 9891 FORMAT('SURFACE:  PMSL  ',F6.1,'MB   PSTN  ',F6.1,'MB   WDIR ',
     $ I3,'DEG   WSPD ',F5.1,'M/S   TEMP  ',F5.1,'K   RH ',I3,
     $ '%   RAINFALL RATE ',F6.1,'MM/HR')
      END IF
      IF(IDATA(37).GT.0)  THEN
         J = IDATA(38) - 11
         TEXT1 = ' PEAK PWR'
         IF(SUBSET.EQ.'NC002013')  TEXT1 = 'S2N RATIO'
         PRINT 8892, TEXT1
 8892 FORMAT('UPPER AIR:  LVL   HGT(M)  WDIR(DEG)  WSPD(M/S)   Q.CODE ',
     $ '  VVEL(M/S)   H.C.   V.C.  ',A9,'(DB)   H. VAR(M/S)   V. ',
     $ 'VAR(M/S)   MODE')
         DO I = 1,IDATA(37)
            J = J + 11
            IHGHT = 999999
            IF(RDATA(J).LT.XMISS)  IHGHT = NINT(RDATA(J))
            WSPD = XMISS
            IF(RDATA(J+2).LT.XMISS)  WSPD = RDATA(J+2)*0.1
            VVEL = XMISS
            IF(RDATA(J+4).LT.XMISS)  VVEL = RDATA(J+4)*0.01
            HVAR = XMISS
            IF(RDATA(J+8).LT.XMISS)  HVAR = RDATA(J+8)*0.1
            VVAR = XMISS
            IF(RDATA(J+9).LT.XMISS)  VVAR = RDATA(J+9)*0.1
            PRINT 8893, I,IHGHT,NINT(RDATA(J+1)),WSPD,IDATA(J+3),VVEL,
     $       (IDATA(J+K),K=5,6),NINT(RDATA(J+7)),HVAR,VVAR,IDATA(J+10)
 8893 FORMAT(11X,I3,4X,I5,6X,I3,6X,F5.1,7X,I3,5X,F6.2,7X,I2,5X,I2,6X,I4,
     $ 12X,F5.1,9X,F5.1,7X,I2)
         ENDDO
      END IF

C GO UP AND UNPACK THE NEXT REPORT

      GO TO 2090

 7003 CONTINUE

C-----------------------------------------------------------------------

C ALL REPORTS HAVE BEEN UNPACKED -- ALL DONE

      PRINT 9004, IUNIT,KNTRPT
 9004 FORMAT(//45X,'--> ALL REPORTS IN FILE',I3,' PROCESSED <--'//47X,
     $ '*** ',I6,' REPORTS LISTED HERE ***'/)
      PRINT 9006
 9006 FORMAT(/38X,'>>>  SUCCESSFUL COMPLETION OF PROGRAM ',
     $ 'BUFR_LISTDUMPS  <<<'/)

      RETURN

C-----------------------------------------------------------------------

      END
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    LISTVADWIND
C   PRGMMR: D. A. KEYSER     ORG: NP22       DATE: 2017-10-13
C
C ABSTRACT: LISTS CONTENTS OF A TIME-WINDOWED VAD WIND BUFR DATA
C   DUMP FILE.  THE STANDARD OUTPUT IS IN AN EASY-TO-READ FORMAT.
C   NOTE: THIS SUBROUTINE CAN HANDLE THE FOLLOWING BUFR DATA DUMP
C   FILE TYPE: VADWND.
C
C PROGRAM HISTORY LOG:
C 2000-03-28  D.A. KEYSER -- ORIGINAL AUTHOR
C 2001-04-06  D.A. KEYSER -- ACCOUNTS FOR CHANGE IN W3UNPKB7 WHICH
C     RETURNS FULL DATE (YYYYMMDDHH) IN HEADER WORD 5
C 2002-03-05  D.A. KEYSER -- SUBR. W3UNPKB7 ARGUMENT RDATA MUST BE
C     DIMENSIONED AT LEAST 1200 NOW TO ACCOUNT FOR 64 POSSIBLE WIND
C     PROFILER LEVELS FROM NOAA/FSL, RDATA INCREASED FROM 800 TO 1200
C     IN THIS PROGRAM
C 2004-02-02  KEYSER -- ARRAY SUBSKP BUMPED UP FROM (0:12,200) TO
C     (0:255,0:200) AND NOW IT CAN ALSO BE READ IN FOR NON-UPA AND
C     NON-SFC TYPES IN NAMELIST PDATA
C 2014-04-22  D. A. KEYSER -- CHANGES TO ALLOW FOR LISTING OF NEW VAD
C     WIND REPORTS FROM LEVEL 2 DECODER.
C 2016-11-30  D. A. KEYSER -- Reads new output real, double-precision
C     argument array RDATA8_8 of length 2 in call to W3UNPKB7.  This
C     new array, which returns latitude and longitude for each report,
C     is currently not referenced by this subroutine.
C 2017-10-13  D. A. KEYSER -- Added minutes to every print statement
C     that includes the central dump time.  Central dump time minutes is
C     obtained from Section 1 of first (dummy) message of input dump
C     file via call to BUFRLIB routine IUPVS01.
C     BENEFIT: Until now, central dump time minutes was always zero.
C              However, with the implementation of the new RTMA_RU,
C              central dump time can now also have minutes = 15, 30
C              or 45 (since the RTMA_RU runs 4 times per hour). This
C              change allows the print statements to reflect this new
C              center dump time format.
C
C USAGE:    CALL LISTVADWND
C
C   INPUT FILES: 
C     UNIT 05  - INPUT DATA CARDS IN THE FORM OF A NAMELIST (SEE
C              - REMARKS IN MAIN PROGRAM DOCBLOCK)
C     UNIT 21  - BUFR DATA SET
C
C   OUTPUT FILES:
C     UNIT 06  - STANDARD OUTPUT PRINT
C
C REMARKS: NONE.
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE:  NCEP WCOSS
C
C$$$

      SUBROUTINE  LISTVADWIND

      LOGICAL SNDG,RETR,RADN,SUBSKP(0:255,0:200)
      INTEGER  NWINDO(2),IDATE(4),MDATE(4),IDATA(2500)
      INTEGER(8)  IDSDMP_8
      REAL  RDATA(2500),RDATA2(25)
      real(8)     rdata8_8(2)
      CHARACTER*1  C1,C2
      CHARACTER*8  STNID,DSNAME,SUBSET
      EQUIVALENCE (RDATA,IDATA)
      DATA  XMISS/99999./

      NAMELIST/PDATA/IDAT10,IWINDE,IWINDL,IPRINT,SNDG,RETR,RADN,SUBSKP

      SUBSKP = .FALSE.
      READ(5,PDATA)

      IDATE(1) = IDAT10/1000000
      IDATE(2) = MOD((IDAT10/10000),100)
      IDATE(3) = MOD((IDAT10/100),100)
      IDATE(4) = MOD(IDAT10,100)

      IUNIT   = 21
      NWINDO(1) = IWINDE
      NWINDO(2) = IWINDL

      KNTRPT = 0

 2090 CONTINUE

C CALL W3UNPKB7 TO UNPACK THE NEXT VAD WIND REPORT

      IRET = IPRINT

      PRINT'(1X)'

      CALL W3UNPKB7(IDATE,NWINDO(1),NWINDO(2),IUNIT,RDATA,STNID,DSNAME,
     $ RDATA2,rdata8_8,IDSDAT,IDSDMP_8,SUBSET,SUBSKP,IRET)
C-----------------------------------------------------------------------
      IF(IRET.EQ.1)  THEN

C IRET = 1 RETURNS DATA SET INFO (ONLY) AFTER FIRST CALL

         IF(IPRINT.LT.0)  PRINT'(" RETURN CODE =",I0,"; DATA SET ",
     $    "INFORMATION RETURNED")', IRET
         PRINT 102, DSNAME,IUNIT
  102    FORMAT(//46X,'*****  ',A8,'  --  UNIT =',I3,'  *****')

C SPLIT DATE INTO COMPONENTS (MDATE)
         MDATE(1) = IDSDAT/1000000
         MDATE(2) = MOD((IDSDAT/10000),100)
         MDATE(3) = MOD((IDSDAT/100),100)
         MDATE(4) = MOD(IDSDAT,100)
c-----------------------------------------------------------------------
c  Read 1st dummy message in file so can then call iupvs01 to get iminu
         call readmg(iunit,subset,ibdate,kret)
         iminu = iupvs01(iunit,'MINU')
c  Close file and reopen so W3UNPKB7 will handle things as though this
c   block of code never exited
         call closbf(iunit)
         call openbf(iunit,'IN',iunit)
c-----------------------------------------------------------------------
         PRINT 1101, DSNAME,MDATE,iminu,IDSDMP_8
 1101    FORMAT(20X,'DATASET NAME: ',A8,'  --  DATE: ',I4.4,2('-',I2.2),
     $    1X,I2.2,i2.2,'Z  -- DUMP DATE (I12 FORMAT): ',I12.12/)

C DOES DATE FROM DATA SET MATCH EXPECTED CENTER DATE?

         IF(IDSDAT.NE.IDAT10)  THEN
            PRINT 324
  324 FORMAT(/13X,'>>>>>   P R O B L E M :   B U F R   F I L E   ',
     $ 'D A T E   D O E S   N O T   M A T C H   E X P E C T E D   ',
     $ 'D A T E   <<<<<'/)
            GO TO 7003
         END IF
         IFIND = 0
         DO  I = 0,255
            DO  J = 0,200
               IF(SUBSKP(I,J))  THEN
                  IF(IFIND.EQ.0)  PRINT 7001
 7001 FORMAT(34X,'-- THE FOLLOWING BUFR MESSAGE TYPES/SUBTYPES WILL ',
     $ 'BE SKIPPED:')
                  PRINT 7002, I,J
 7002 FORMAT(45X,'BUFR TYPE ',I3.3,', SUBTYPE ',I3.3)
                  IFIND = 1
               END IF
            ENDDO
         ENDDO
         IF(IFIND.EQ.0)  PRINT 8003
 8003 FORMAT(10X,'-- ALL BUFR MESSAGE TYPES/SUBTYPES IN DATA DUMP FILE',
     $ ' WILL BE PROCESSED')
         PRINT 7004
 7004    FORMAT(//)
         GO TO 2090
C----------------------------------------------------------------------
      ELSE IF(IRET.GT.2)  THEN
C PROBLEM READING VAD WIND REPORT, GO ON TO NEXT REPORT
         PRINT 912
  912    FORMAT(' * * ERROR READING VAD WIND REPORT, TRY NEXT ONE')
         GO TO 2090
C----------------------------------------------------------------------
      ELSE  IF(IRET.EQ.2)  THEN
C ALL DONE
         GO TO 7003
      END IF
C----------------------------------------------------------------------

      KNTRPT = KNTRPT + 1

C PRINT OUT REPORT AS FOUND IN OUTPUT ARRAY 'IDATA'
      IF(IPRINT.LT.0)  PRINT 8890,(IDATA(K),K=19,20)
 8890 FORMAT(//1X,'>> PRINTOUT OF OUTPUT IDATA ARRAY:'//' NO.',
     $ ' CAT. 04 LVLS=',I3,';  CAT. 04 DATA SUBSCRIPT=',I3/)
      C1 = 'N'
      C2 = 'E'

      ALAT = RDATA(1)
      IF(RDATA(1).LT.0.0)  THEN
         ALAT = -ALAT
         C1 = 'S'
      END IF
      ALON = RDATA(2)
      IF(RDATA(2).GT.180.00)  THEN
         ALON = 360.00 - ALON
         C2 = 'W'
      END IF

      PRINT 9890, STNID,RDATA(4),ALAT,C1,ALON,C2,NINT(RDATA(7)),
     $ IDATA(9),IDATA(5)
 9890 FORMAT(1X,A8,4X,F8.5,'Z',4X,F5.2,A1,4X,F6.2,A1,4X,'ELEV ',I5,
     $ 'M',4X,'RPT TYPE ',I3.3,4X,'DATE ',I10.10)
      IF(IDATA(19).GT.0)  THEN
         J = IDATA(20) - 5
         IF(SUBSET.EQ.'NC002008') THEN
            PRINT 9892
 9892 FORMAT(12X,'LVL   HGT(M)   WDIR(DEG)   WSPD(M/S)   Q.MARK')
            DO I = 1,IDATA(19)
               J = J + 5
               IHGHT = 999999
               IF(RDATA(J).LT.XMISS)  IHGHT = NINT(RDATA(J))
               WSPD = XMISS
               IF(RDATA(J+2).LT.XMISS)  WSPD = RDATA(J+2)*0.1
               PRINT 9893,I,IHGHT,NINT(RDATA(J+1)),WSPD,NINT(RDATA(J+4))
 9893 FORMAT(12X,I2,4X,I5,6X,I3,7X,F5.1,9X,I2.2)
            ENDDO
         ELSE IF(SUBSET.EQ.'NC002017') THEN
            PRINT 9894
 9894 FORMAT(12X,'LVL   HGT(M)   UCMP(M/S)   VCMP(M/S)   Q.MARK')
            DO I = 1,IDATA(19)
               J = J + 5
               IHGHT = 999999
               IF(RDATA(J).LT.XMISS)  IHGHT = NINT(RDATA(J))
               PRINT 9895,I,IHGHT,RDATA(J+1),RDATA(J+2),NINT(RDATA(J+4))
 9895 FORMAT(10X,I4,4X,I5,4X,F5.1,7X,F5.1,9X,I2.2)
            ENDDO
         END IF
      END IF

C GO UP AND UNPACK THE NEXT REPORT

      GO TO 2090

 7003 CONTINUE

C-----------------------------------------------------------------------

C ALL REPORTS HAVE BEEN UNPACKED -- ALL DONE

      PRINT 9004, IUNIT,KNTRPT
 9004 FORMAT(//45X,'--> ALL REPORTS IN FILE',I3,' PROCESSED <--'//47X,
     $ '*** ',I6,' REPORTS LISTED HERE ***'/)
      PRINT 9006
 9006 FORMAT(/38X,'>>>  SUCCESSFUL COMPLETION OF PROGRAM ',
     $ 'BUFR_LISTDUMPS  <<<'/)

      RETURN

C-----------------------------------------------------------------------

      END
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    LISTGOESNDGS
C   PRGMMR: D. A. KEYSER     ORG: NP22       DATE: 2017-10-13
C
C ABSTRACT: LISTS CONTENTS OF A TIME-WINDOWED GOES SOUNDING/RETRIEVAL/
C   RADIANCE BUFR DATA DUMP FILE.  THE STANDARD OUTPUT IS IN AN EASY-
C   TO-READ FORMAT.  NOTE: THIS SUBROUTINE CAN HANDLE THE FOLLOWING
C   BUFR DATA DUMP FILE TYPES: GOESND AND GOESFV.
C
C PROGRAM HISTORY LOG:
C 2000-03-28  D.A. KEYSER -- ORIGINAL AUTHOR
C 2001-04-06  D.A. KEYSER -- UNITS FOR INPUT GOES BRIGHT. TEMPS, LI,
C     PWATER (TOTAL AND LAYERS), SKIN TEMP, ZENITH ANGLE (SOLAR AND
C     SATELLITE), CLOUD TOP TEMP AND CLOUD TOP PRESSURE CHANGED FROM
C     K*100, K*100, MM*100, K*100, DEG*100, K*100, MB*10, RESP. TO K,
C     K, MM, K, DEG, K, MB WITH FLOATING POINT PRECISION TO 10**2,
C     10**2, 10**2, 10**2, 10**2, 10**2, 10**1, RESP. TO ACCOUNT FOR
C     CHANGE IN W3UNPKB7; ACCOUNTS FOR CHANGE IN W3UNPKB7 WHICH RETURNS
C     FULL DATE (YYYYMMDDHH) IN HEADER WORD 5 AND SATELLITE ID IN
C     HEADER WORD 6, INCLUDES SATELLITE ID IN LISTING
C 2001-06-19  D.A. KEYSER -- CAN NOW LIST GOES CLOUD TOP REPORTS
C     CONTAINING CLOUD TOP PRESSURE, CLOUD COVER AND CLOUD TOP
C     TEMPERATURE WHICH CAN NOW BE PART OF THE "GOESND" DATA DUMP FILE
C 2002-03-05  D.A. KEYSER -- SUBR. W3UNPKB7 ARGUMENT RDATA MUST BE
C     DIMENSIONED AT LEAST 1200 NOW TO ACCOUNT FOR 64 POSSIBLE WIND
C     PROFILER LEVELS FROM NOAA/FSL, RDATA INCREASED FROM 800 TO 1200
C     IN THIS PROGRAM
C 2004-02-02  KEYSER -- ARRAY SUBSKP BUMPED UP FROM (0:12,200) TO
C     (0:255,0:200) AND NOW IT CAN ALSO BE READ IN FOR NON-UPA AND
C     NON-SFC TYPES IN NAMELIST PDATA
C 2004-09-09  KEYSER -- NO LONGER SELECTS WHAT TO PRINT SIMPLY BY
C     WHETHER REPORT IS A 1x1 ("H" IN 1ST CHAR. OF STNID) OR 5x5
C     REPORT, THIS IS BECAUSE 1x1 REPORTS COULD NOW CONTAIN BOTH CLOUD
C     REPORTS (AS BEFORE) AND SOUNDING/RADIANCE REPORTS - SUBR. NOW
C     TESTS FOR MISSING CLOUD DATA TO NOT PRINT CLOUD INFO, MISSING
C     PSFC AND TPW TO NOT PRINT RETRIEVAL INFO AND ZERO BRIGHTNESS TEMP
C     LEVELS TO NOT PRINT RADIANCE INFO
C 2007-09-14 D. A. KEYSER -- IMPROVED DOCUMENTATION AT TOP OF LISTINGS.
C 2015-04-16 D. A. KEYSER -- Now correctly lists total cloud cover from
C     GOES cloud reports in dump file "goesnd" as the value of TOCC
C     from RDATA2(25) passed from W3UNPKB7 (had looked for it in cat 8
C     c.f. 258 passed in from W3UNPKB7 in RDATA array but this was
C     changed long ago to hold cloud amount and not total cloud cover,
C     and the former is missing in GOES cloud reports).
C 2016-11-30  D. A. KEYSER -- Reads new output real, double-precision
C     argument array RDATA8_8 of length 2 in call to W3UNPKB7.  This
C     new array, which returns latitude and longitude for each report,
C     is currently not referenced by this subroutine.
C 2017-10-13  D. A. KEYSER -- Added minutes to every print statement
C     that includes the central dump time.  Central dump time minutes is
C     obtained from Section 1 of first (dummy) message of input dump
C     file via call to BUFRLIB routine IUPVS01.
C     BENEFIT: Until now, central dump time minutes was always zero.
C              However, with the implementation of the new RTMA_RU,
C              central dump time can now also have minutes = 15, 30
C              or 45 (since the RTMA_RU runs 4 times per hour). This
C              change allows the print statements to reflect this new
C              center dump time format.
C
C USAGE:    CALL LISTGOESNDGS
C
C   INPUT FILES: 
C     UNIT 05  - INPUT DATA CARDS IN THE FORM OF A NAMELIST (SEE
C              - REMARKS IN MAIN PROGRAM DOCBLOCK)
C     UNIT 21  - BUFR DATA SET
C
C   OUTPUT FILES:
C     UNIT 06  - STANDARD OUTPUT PRINT
C
C REMARKS: NONE.
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE:  NCEP WCOSS
C
C$$$

      SUBROUTINE LISTGOESNDGS

      LOGICAL SNDG,RETR,RADN,SUBSKP(0:255,0:200)
      INTEGER  NWINDO(2),IDATE(4),IDATA(2500),IQM(250:262),JQM(18)
      INTEGER(8)  IDSDMP_8
      REAL  RDATA(2500),DAT(250:262),RAD(18),RDATA2(25)
      real(8)     rdata8_8(2)
      CHARACTER*1  C1,C2
      CHARACTER*8  STNID,DSNAME,SUBSET
      EQUIVALENCE (RDATA,IDATA)
      DATA  ZMISS/999999./

      NAMELIST/PDATA/IDAT10,IWINDE,IWINDL,IPRINT,SNDG,RETR,RADN,SUBSKP

      SUBSKP = .FALSE.
      READ(5,PDATA)

      IUNIT   = 21
      NWINDO(1) = IWINDE
      NWINDO(2) = IWINDL

      PRINT 9003, IUNIT
 9003 FORMAT(//32X,' ***** GOES SATELLITE SOUNDING/RETRIEVAL/RADIANCE',
     $ ' FILE    UNIT =',I4,' *****')

C SPLIT PRODUCTION DATE INTO COMPONENTS (IDATE)

      IDATE(1) = IDAT10/1000000
      IDATE(2) = MOD((IDAT10/10000),100)
      IDATE(3) = MOD((IDAT10/100),100)
      IDATE(4) = MOD(IDAT10,100)
      PRINT 550, IDATE
  550 FORMAT(25X,'LOOKING FOR FILE WITH CENTER DATE: ',2X,I4.4,
     $ 2('-',I2.2),1X,I2.2,'Z  BASED ON PRODUCTION DATE')

      PRINT 101
  101 FORMAT(//5X,'KEY FOR DATA LISTED IN EACH REPORT BELOW:'/
     $/10X,'Field  1 ....... Report id'
     $/10X,'Field  2 ....... Observation time (UTC)'
     $/10X,'Field  3 ....... Latitude (N,S)'
     $/10X,'Field  4 ....... Longitude (E,W)'
     $/10X,'ELV ............ Elevation (meters)'
     $/10X,'SATID .......... Satellite id, BUFR Code Table 0-01-007'
     $/28X,'(see http://www.emc.ncep.noaa.gov/mmb/data_processing/',
     $ 'common_tbl_c1-c5.htm#c-5)'
     $/10X,'RTYPE .......... Dump report type (always 061 - GOES ',
     $ 'sounding/radiance)'
     $/10X,'#FOV ........... Number of fields-of-view (numeric)'
     $/10X,'QM ............. Quality information, BUFR Code Table 0-33',
     $ '-002'
     $/28X,'(see http://www.emc.ncep.noaa.gov/mmb/data_processing/table'
     $,'_25-35.htm#0-33-002)'
     $/10X,'TECH ........... Retrieval type (21 - Clear, 23 - Cloudy)'
     $/10X,'DATE ........... YYYYMMDDHH of observation'/)
      IF(RETR)  PRINT 551
  551 FORMAT(7X,'RETRIEVALS --'
     $/10X,'xxx/QM  , where xxx is:'
     $/16X,'PS  = Surface pressure (mb)'
     $/16X,'LI  = Lifted index (K)'
     $/16X,'PW  = Total column precipitable water (mm)'
     $/16X,'P1  = 1.0 to 0.9 sigma layer precipitable water (mm)'
     $/16X,'P2  = 0.9 to 0.7 sigma layer precipitable water (mm)'
     $/16X,'P3  = 0.7 to 0.3 sigma layer precipitable water (mm)'
     $/16X,'TS  = Skin temperature (K)'
     $/16X,'CL  = Cloud amount, BUFR Code Table 0-20-011'
     $/23X,'(see http://www.emc.ncep.noaa.gov/mmb/data_processing/',
     $ 'table_20.htm#0-20-011)'
     $/16X,'CC  = Total cloud cover (%) (note: there is no QM, stamped',
     $ ' out as "--")'
     $/16X,'IN  = Instrument data used, BUFR Code Table 0-02-021'
     $/23X,'(see http://www.emc.ncep.noaa.gov/mmb/data_processing/',
     $ 'table_1-2.htm#0-02-021)'
     $/16X,'OZ  = Solar zenith angle (degrees)'
     $/16X,'AZ  = Satellite zenith angle (degrees)'
     $/16X,'CTT = Cloud top temperature (K)'
     $/16X,'CTP = Cloud top pressure (mb)'
     $//20X,'and QM is Quality marker (00 - monitor keep, 01 - good, ',
     $ '02 - neutral/not checked, 03 - suspect, 12 - toss, on'
     $/30X,'reject list, 13 - toss, failed automatic q.c. tests, 14 - ',
     $ 'toss, monitor purge)'//)
      IF(RADN)  PRINT 552
  552 FORMAT(7X,'RADIANCES --'
     $/10X,'RADN: For each channel: xx yyy.yy/zz where:'
     $/20X,'xx     = Channel number (1-18)'
     $/20X,'yyy.yy = Brightness temperature (K)'
     $/20X,'zz     = Quality marker (00 - monitor keep, 01 - good, 02',
     $ ' - neutral/not checked, 03 - suspect, 12 - toss, on'
     $/30X,'reject list, 13 - toss, failed automatic q.c. tests, 14 - ',
     $ 'toss, monitor purge)'//)

      PRINT'(1X)'

      KNTRPT = 0

C***********************************************************************
 1400 CONTINUE

C ATTEMPT TO DECODE THE NEXT GOES REPORT

      IRET = IPRINT

      PRINT'(1X)'

      CALL W3UNPKB7(IDATE,NWINDO(1),NWINDO(2),IUNIT,RDATA,STNID,DSNAME,
     $ RDATA2,rdata8_8,IDSDAT,IDSDMP_8,SUBSET,SUBSKP,IRET)
C-----------------------------------------------------------------------
      IF(IRET.EQ.1)  THEN

C IRET = 1 RETURNS DATA SET INFO (ONLY) AFTER FIRST CALL

         IF(IPRINT.LT.0)  PRINT'(" RETURN CODE =",I0,"; DATA SET ",
     $    "INFORMATION RETURNED")', IRET
c-----------------------------------------------------------------------
c  Read 1st dummy message in file so can then call iupvs01 to get iminu
         call readmg(iunit,subset,ibdate,kret)
         iminu = iupvs01(iunit,'MINU')
c  Close file and reopen so W3UNPKB7 will handle things as though this
c   block of code never exited
         call closbf(iunit)
         call openbf(iunit,'IN',iunit)
c-----------------------------------------------------------------------
         PRINT 7000, DSNAME,IDSDAT,iminu,IDSDMP_8
 7000    FORMAT(//22X,'--> DATA SET INFORMATION: NAME: ',A8,'; DATE: ',
     $    I10.10,i2.2,'; DUMP TIME: ',I12.12,' <--')

C DOES DATE FROM DATA SET MATCH EXPECTED CENTER DATE?

         IF(IDSDAT.NE.IDAT10)  THEN
            PRINT 324
  324 FORMAT(/13X,'>>>>>   P R O B L E M :   B U F R   F I L E   ',
     $ 'D A T E   D O E S   N O T   M A T C H   E X P E C T E D   ',
     $ 'D A T E   <<<<<'/)
            GO TO 9999
         END IF
         IFIND = 0
         DO  I = 0,255
            DO  J = 0,200
               IF(SUBSKP(I,J))  THEN
                  IF(IFIND.EQ.0)  PRINT 7001
 7001 FORMAT(34X,'-- THE FOLLOWING BUFR MESSAGE TYPES/SUBTYPES WILL ',
     $ 'BE SKIPPED:')
                  PRINT 7002, I,J
 7002 FORMAT(45X,'BUFR TYPE ',I3.3,', SUBTYPE ',I3.3)
                  IFIND = 1
               END IF
            ENDDO
         ENDDO
         IF(IFIND.EQ.0)  PRINT 8003
 8003 FORMAT(10X,'-- ALL BUFR MESSAGE TYPES/SUBTYPES IN DATA DUMP FILE',
     $ ' WILL BE PROCESSED')
         PRINT 7004
 7004    FORMAT(//)
         GO TO 1400
C----------------------------------------------------------------------
      ELSE  IF(IRET.GT.2)  THEN

C ERROR DECODING THIS REPORT, GO ON TO NEXT REPORT

         PRINT 572, IUNIT,KNTRPT+1,IRET
  572    FORMAT(' * * ERROR DECODING GOES REPORT ON UNIT',I3,' -- ',
     $    'REPORT CNT. ',I5,' -- IRET ',I5,' --> GO ON TO NEXT RPT')
         GO TO 1400
C----------------------------------------------------------------------
      ELSE  IF(IRET.EQ.2)  THEN

C IF IER = 2, HAVE HIT END-OF-FILE, ALL REPORTS PROCESSED

         GO TO 9999
C----------------------------------------------------------------------
      END IF

C A REPORT WAS SUCCESSFULLY DECODED

      KNTRPT = KNTRPT + 1

C PRINT OUT REPORT AS FOUND IN OUTPUT ARRAY 'IDATA'
      IF(IPRINT.LT.0)  PRINT 8890, IDATA(39),IDATA(40),IDATA(27),
     $ IDATA(28),IDATA(41),IDATA(42)
 8890 FORMAT(//1X,'>> PRINTOUT OF OUTPUT IDATA ARRAY:'//' NO. CAT. 12 ',
     $ 'LVLS=',I3,';  CAT. 12 SUBS.=',I3,';  NO. CAT. 08 LVLS=',I3,
     $ ';  CAT. 08 SUBS.=',I3,';  NO. CAT. 13 LVLS=',I3,
     $ ';  CAT. 13 SUBS.=',I3/)
      C1 = 'N'
      C2 = 'E'

      ALAT = RDATA(1)
      IF(RDATA(1).LT.0.0)  THEN
         ALAT = -ALAT
         C1 = 'S'
      END IF
      ALON = RDATA(2)
      IF(RDATA(2).GT.180.00)  THEN
         ALON = 360.00 - ALON
         C2 = 'W'
      END IF

      PRINT 9890, STNID,RDATA(4),ALAT,C1,ALON,C2,NINT(RDATA(7)),
     $ IDATA(6),IDATA(9),NINT(RDATA2(2)),NINT(RDATA2(7)),IDATA(8),
     $ IDATA(5)
 9890 FORMAT(1X,A8,1X,F9.5,'Z', 3X,F8.2,A1,2X,F8.2,A1,4X,'ELV  ',I5,
     $ 4X,'SATID',I4,3X,'RTYPE',I5.3,4X,'#FOV ',I3.2,3X,'QM ',I2.2,
     $ 3X,'TECH',I3.2,3X,'DATE ',I10.10)
      IF(SNDG)  THEN
         IF(IDATA(39).GT.0) THEN ! will not print sndg data if zero lvls
            J = IDATA(40) - 9
            PRINT 8892
 8892 FORMAT('SOUNDING:  LVL    PRESS(MB)   HGHT(M)  TEMP(C)  DWPT(C)',
     $ '    *RESV*    *RESV*      QM  ')
            DO I = 1,IDATA(39)
               J = J + 9
               PRESS = ZMISS
               IHGHT = 999999
               IF(RDATA(J+1).LT.ZMISS)  IHGHT = NINT(RDATA(J+1))
               TEMP  = ZMISS
               DWPT  = ZMISS
               IF(RDATA(J).LT.ZMISS)    PRESS = RDATA(J)/10.
               IF(RDATA(J+2).LT.ZMISS)  TEMP  = RDATA(J+2)/10.
               IF(RDATA(J+3).LT.ZMISS)  DWPT  = RDATA(J+3)/10.
               PRINT 8893, I,PRESS,IHGHT,TEMP,DWPT,RDATA(J+4),
     $          RDATA(J+5),(NINT(RDATA(J+II)),II=6,8)
 8893 FORMAT(10X,I3,6X,F7.1,4X,I5,3X,F7.1,2X,F7.1,1X,2(3X,F7.1),2X,3(1X,
     $ I2.2))
            END DO
         END IF
      END IF
      IF(RETR)  THEN
         DAT = ZMISS
         IQM = 999999
         J = IDATA(28) - 4
         IF(IDATA(27).GT.0)  THEN
            DO I = 1,IDATA(27)
               J = J + 4
               IF(NINT(RDATA(J+1)).GT.249.AND.NINT(RDATA(J+1)).LT.263)
     $          THEN
                  DAT(NINT(RDATA(J+1))) = RDATA(J)
                  IF(RDATA(J+2).LT.ZMISS)  IQM(NINT(RDATA(J+1))) =
     $             NINT(RDATA(J+2))
               END IF
            END DO
         END IF
         IF(MIN(DAT(256),DAT(257)).LT.ZMISS) PRINT 9897,
             ! will not print cld data if c-top temp & press are missing
     $   (DAT(II),IQM(II),II=256,257),NINT(RDATA2(25)),NINT(DAT(259)),
     $   IQM(259)
 9897 FORMAT('CTT',F7.2,'/',I2.2,5X,'CTP ',F6.1,'/',I2.2,5X,'CC',I4,
     $ '/--',5X,'IN',I2,'/',I2.2)
         IF(MIN(DAT(262),DAT(251)).LT.ZMISS) PRINT 9891, DAT(262),
     $    IQM(262),(DAT(II),IQM(II),II=250,255),(NINT(DAT(II)),IQM(II),
     $    II=258,259),(DAT(II),IQM(II),II=260,261)
             ! will not print retr data if psfc & tpw are missing
 9891 FORMAT('PS',F7.1,'/',I2.2,2X,'LI',F6.2,'/',I2.2,2X,'PW',F5.1,'/',
     $ I2.2,2X,'P1',F5.1,'/',I2.2,2X,'P2',F5.1,'/',I2.2,2X,'P3',F5.1,
     $ '/',I2.2,2X,'TS',F7.2,'/',I2.2,2X,'CL',I2,'/',I2.2,2X,'IN',I2,
     $ '/',I2.2,2X,'OZ',F6.2,'/',I2.2,2X,'AZ',F6.2,'/',I2.2)
      END IF
      IF(RADN)  THEN
         RAD = ZMISS
         JQM = 999999
         J = IDATA(42) - 3
         IF(IDATA(41).GT.0)  THEN
            DO I = 1,IDATA(41)
               J = J + 3
               IF(IDATA(J).GT.0.AND.IDATA(J).LT.19)  THEN
                  RAD(IDATA(J)) = RDATA(J+1)
                  IF(RDATA(J+2).LT.ZMISS)JQM(IDATA(J)) =NINT(RDATA(J+2))
               END IF
            END DO
         END IF
         IF(IDATA(41).GT.0)  THEN
             ! will not print radiance data if all channels missing
            PRINT 9895, (RAD(II),JQM(II),II=1,18)
 9895 FORMAT('RADN:  1',F7.2,'/',I2.2,'   2',F7.2,'/',I2.2,'   3',F7.2,
     $  '/',I2.2,'   4',F7.2,'/',I2.2,'   5',F7.2,'/',I2.2,'   6',F7.2,
     $  '/',I2.2,'   7',F7.2,'/',I2.2,'   8',F7.2,'/',I2.2,'   9',F7.2,
     $  '/',I2.2
     $      /'      10',F7.2,'/',I2.2,'  11',F7.2,'/',I2.2,'  12',F7.2,
     $  '/',I2.2,'  13',F7.2,'/',I2.2,'  14',F7.2,'/',I2.2,'  15',F7.2,
     $  '/',I2.2,'  16',F7.2,'/',I2.2,'  17',F7.2,'/',I2.2,'  18',F7.2,
     $  '/',I2.2)
         END IF
      END IF

C GO UP AND UNPACK THE NEXT REPORT

      GO TO 1400

 9999 CONTINUE

C-----------------------------------------------------------------------

C ALL REPORTS HAVE BEEN UNPACKED -- ALL DONE

      PRINT 9004, IUNIT,KNTRPT
 9004 FORMAT(//45X,'--> ALL REPORTS IN FILE',I3,' PROCESSED <--'//47X,
     $ '*** ',I6,' REPORTS LISTED HERE ***'/)
      PRINT 9006
 9006 FORMAT(/38X,'>>>  SUCCESSFUL COMPLETION OF PROGRAM ',
     $ 'BUFR_LISTDUMPS  <<<'/)

      RETURN

C-----------------------------------------------------------------------

      END
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    LISTERSCAT
C   PRGMMR: D. A. KEYSER     ORG: NP22       DATE: 2017-10-13
C
C ABSTRACT: LISTS CONTENTS OF A TIME-WINDOWED REPROCESSED ERS
C   SCATTEROMETER BUFR DATA DUMP FILE.  THE STANDARD OUTPUT IS IN
C   AN EASY-TO-READ FORMAT.  NOTE: THIS SUBROUTINE CAN
C   HANDLE THE FOLLOWING BUFR DATA DUMP FILE TYPE: ERS1DA.
C
C PROGRAM HISTORY LOG:
C 2000-03-28  D.A. KEYSER -- ORIGINAL AUTHOR
C 2001-04-06  D.A. KEYSER -- ACCOUNTS FOR CHANGE IN W3UNPKB7 WHICH
C     RETURNS SATELLITE ID IN HEADER WORD 6, INCLUDES SATELLITE ID IN
C     LISTING
C 2002-03-05  D.A. KEYSER -- SUBR. W3UNPKB7 ARGUMENT RDATA MUST BE
C     DIMENSIONED AT LEAST 1200 NOW TO ACCOUNT FOR 64 POSSIBLE WIND
C     PROFILER LEVELS FROM NOAA/FSL, RDATA INCREASED FROM 800 TO 1200
C     IN THIS PROGRAM
C 2004-02-02  KEYSER -- ARRAY SUBSKP BUMPED UP FROM (0:12,200) TO
C     (0:255,0:200) AND NOW IT CAN ALSO BE READ IN FOR NON-UPA AND
C     NON-SFC TYPES IN NAMELIST PDATA
C 2016-11-30  D. A. KEYSER -- Reads new output real, double-precision
C     argument array RDATA8_8 of length 2 in call to W3UNPKB7.  This
C     new array, which returns latitude and longitude for each report,
C     is currently not referenced by this subroutine.
C 2017-10-13  D. A. KEYSER -- Added minutes to every print statement
C     that includes the central dump time.  Central dump time minutes is
C     obtained from Section 1 of first (dummy) message of input dump
C     file via call to BUFRLIB routine IUPVS01.
C     BENEFIT: Until now, central dump time minutes was always zero.
C              However, with the implementation of the new RTMA_RU,
C              central dump time can now also have minutes = 15, 30
C              or 45 (since the RTMA_RU runs 4 times per hour). This
C              change allows the print statements to reflect this new
C              center dump time format.
C
C USAGE:    CALL LISTERSCAT
C
C   INPUT FILES: 
C     UNIT 05  - INPUT DATA CARDS IN THE FORM OF A NAMELIST (SEE
C              - REMARKS IN MAIN PROGRAM DOCBLOCK)
C     UNIT 21  - BUFR DATA SET
C
C   OUTPUT FILES:
C     UNIT 06  - STANDARD OUTPUT PRINT
C
C REMARKS: NONE.
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE:  NCEP WCOSS
C
C$$$

      SUBROUTINE LISTERSCAT

      LOGICAL SNDG,RETR,RADN,SUBSKP(0:255,0:200)
      INTEGER  NWINDO(2),IDATE(4),MDATE(4),IDATA(2500)
      INTEGER(8)  IDSDMP_8
      REAL  RDATA(2500),RDATA2(25)
      real(8)     rdata8_8(2)
      CHARACTER*1  C1,C2
      CHARACTER*8  STNID,DSNAME,SUBSET
      EQUIVALENCE (RDATA,IDATA)
      DATA  XMISS/99999./

      NAMELIST/PDATA/IDAT10,IWINDE,IWINDL,IPRINT,SNDG,RETR,RADN,SUBSKP

      SUBSKP = .FALSE.
      READ(5,PDATA)

      IDATE(1) = IDAT10/1000000
      IDATE(2) = MOD((IDAT10/10000),100)
      IDATE(3) = MOD((IDAT10/100),100)
      IDATE(4) = MOD(IDAT10,100)

      IUNIT   = 21
      NWINDO(1) = IWINDE
      NWINDO(2) = IWINDL

      KNTRPT = 0

 2090 CONTINUE

C CALL W3UNPKB7 TO UNPACK THE NEXT ERS SCATTEROMETER WIND REPORT

      IRET = IPRINT

      CALL W3UNPKB7(IDATE,NWINDO(1),NWINDO(2),IUNIT,RDATA,STNID,DSNAME,
     $ RDATA2,rdata8_8,IDSDAT,IDSDMP_8,SUBSET,SUBSKP,IRET)
C-----------------------------------------------------------------------
      IF(IRET.EQ.1)  THEN

C IRET = 1 RETURNS DATA SET INFO (ONLY) AFTER FIRST CALL

         IF(IPRINT.LT.0)   PRINT'(" RETURN CODE =",I0,"; DATA SET ",
     $    "INFORMATION RETURNED")', IRET
         PRINT 102, DSNAME,IUNIT
  102    FORMAT(//46X,'*****  ',A8,'  --  UNIT =',I3,'  *****')

C SPLIT DATE INTO COMPONENTS (MDATE)
         MDATE(1) = IDSDAT/1000000
         MDATE(2) = MOD((IDSDAT/10000),100)
         MDATE(3) = MOD((IDSDAT/100),100)
         MDATE(4) = MOD(IDSDAT,100)
c-----------------------------------------------------------------------
c  Read 1st dummy message in file so can then call iupvs01 to get iminu
         call readmg(iunit,subset,ibdate,kret)
         iminu = iupvs01(iunit,'MINU')
c  Close file and reopen so W3UNPKB7 will handle things as though this
c   block of code never exited
         call closbf(iunit)
         call openbf(iunit,'IN',iunit)
c-----------------------------------------------------------------------
         PRINT 1101, DSNAME,MDATE,iminu,IDSDMP_8
 1101    FORMAT(20X,'DATASET NAME: ',A8,'  --  DATE: ',I4.4,2('-',I2.2),
     $    1X,I2.2,i2.2,'Z  -- DUMP DATE (I12 FORMAT): ',I12.12/)

C DOES DATE FROM DATA SET MATCH EXPECTED CENTER DATE?

         IF(IDSDAT.NE.IDAT10)  THEN
            PRINT 324
  324 FORMAT(/13X,'>>>>>   P R O B L E M :   B U F R   F I L E   ',
     $ 'D A T E   D O E S   N O T   M A T C H   E X P E C T E D   ',
     $ 'D A T E   <<<<<'/)
            GO TO 7003
         END IF
         IFIND = 0
         DO  I = 0,255
            DO  J = 0,200
               IF(SUBSKP(I,J))  THEN
                  IF(IFIND.EQ.0)  PRINT 7001
 7001 FORMAT(34X,'-- THE FOLLOWING BUFR MESSAGE TYPES/SUBTYPES WILL ',
     $ 'BE SKIPPED:')
                  PRINT 7002, I,J
 7002 FORMAT(45X,'BUFR TYPE ',I3.3,', SUBTYPE ',I3.3)
                  IFIND = 1
               END IF
            ENDDO
         ENDDO
         IF(IFIND.EQ.0)  PRINT 8003
 8003 FORMAT(10X,'-- ALL BUFR MESSAGE TYPES/SUBTYPES IN DATA DUMP FILE',
     $ ' WILL BE PROCESSED')
         PRINT 7004
 7004    FORMAT(//)
         GO TO 2090
C----------------------------------------------------------------------
      ELSE IF(IRET.GT.2)  THEN
C PROBLEM READING ERS SCATTEROMETER WIND REPORT, GO ON TO NEXT REPORT
         PRINT 912
  912    FORMAT(' * * ERROR READING ERS SCATTEROMETER WIND REPORT, TRY',
     $    ' NEXT ONE')
         GO TO 2090
C----------------------------------------------------------------------
      ELSE  IF(IRET.EQ.2)  THEN
C ALL DONE
         GO TO 7003
      END IF
C----------------------------------------------------------------------

      KNTRPT = KNTRPT + 1

C PRINT OUT REPORT AS FOUND IN OUTPUT ARRAYS 'RDATA' AND 'IDATA'
      IF(IPRINT.LT.0)  PRINT 8890, (IDATA(K),K=35,36)
 8890 FORMAT(1X,'>> PRINTOUT OF OUTPUT RDATA/IDATA ARRAY:'//1X,'NO. ',
     $ 'CAT. 10 LVLS=',I1,';  CAT. 10 DATA SUBSCRIPT=',I2/)
      C1 = 'N'
      C2 = 'E'

      ALAT = RDATA(1)
      IF(RDATA(1).LT.0.0)  THEN
         ALAT = -ALAT
         C1 = 'S'
      END IF
      ALON = RDATA(2)
      IF(RDATA(2).GT.180.00)  THEN
         ALON = 360.00 - ALON
         C2 = 'W'
      END IF

      IHGHT = 999999
      IF(RDATA(7).LT.XMISS)  IHGHT = NINT(RDATA(7))
      WSPD = XMISS
      IF(RDATA(IDATA(36)+3).LT.XMISS)  WSPD = RDATA(IDATA(36)+3)*0.1
      PRINT 9890, STNID,RDATA(4),ALAT,C1,ALON,C2,IHGHT,IDATA(6),
     $ IDATA(9),NINT(RDATA(IDATA(36)+2)),WSPD
 9890 FORMAT(1X,A8,2X,F8.5,'Z',4X,F5.2,A1,4X,F6.2,A1,4X,'ELEV  ',I5,
     $ 'M',4X,'SATID',I4,4X,'RPT TYPE  ',I3.3,4X,'WDIR  ',I3,4X,'WSPD ',
     $ F5.1,'M/S')

C GO UP AND UNPACK THE NEXT REPORT

      GO TO 2090

 7003 CONTINUE

C-----------------------------------------------------------------------

C ALL REPORTS HAVE BEEN UNPACKED -- ALL DONE

      PRINT 9004, IUNIT,KNTRPT
 9004 FORMAT(//45X,'--> ALL REPORTS IN FILE',I3,' PROCESSED <--'//47X,
     $ '*** ',I6,' REPORTS LISTED HERE ***'/)
      PRINT 9006
 9006 FORMAT(/38X,'>>>  SUCCESSFUL COMPLETION OF PROGRAM ',
     $ 'BUFR_LISTDUMPS  <<<'/)

      RETURN

C-----------------------------------------------------------------------

      END
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    LISTQKSWND
C   PRGMMR: D. A. KEYSER     ORG: NP22       DATE: 2017-10-13
C
C ABSTRACT: LISTS CONTENTS OF A TIME-WINDOWED REPROCESSED QUIKSCAT
C   OR ASCAT SCATTEROMETER BUFR DATA DUMP FILE.  THE STANDARD OUTPUT IS
C   IN AN EASY-TO-READ FORMAT.  NOTE: THIS SUBROUTINE CAN HANDLE THE
C   FOLLOWING BUFR DATA DUMP FILE TYPES: QKSWND, ASCATW.
C
C PROGRAM HISTORY LOG:
C 2000-09-22  D.A. KEYSER -- ORIGINAL AUTHOR
C 2001-04-06  D.A. KEYSER -- ACCOUNTS FOR CHANGE IN W3UNPKB7 WHICH
C     RETURNS SATELLITE ID IN HEADER WORD 6, INCLUDES SATELLITE ID IN
C     LISTING
C 2001-08-20  D.A. KEYSER -- ACCOUNTS FOR CHANGE IN W3UNPKB7 WHICH
C     RETURNS NUMBER OF ORIGINAL REPORTS USED TO GENERATE SUPEROB
C     (ACAV) IN HEADER WORD 10, INCLUDES THIS IN LISTING
C 2002-03-05  D.A. KEYSER -- SUBR. W3UNPKB7 ARGUMENT RDATA MUST BE
C     DIMENSIONED AT LEAST 1200 NOW TO ACCOUNT FOR 64 POSSIBLE WIND
C     PROFILER LEVELS FROM NOAA/FSL, RDATA INCREASED FROM 800 TO 1200
C     IN THIS PROGRAM
C 2004-02-02  KEYSER -- ARRAY SUBSKP BUMPED UP FROM (0:12,200) TO
C     (0:255,0:200) AND NOW IT CAN ALSO BE READ IN FOR NON-UPA AND
C     NON-SFC TYPES IN NAMELIST PDATA
C 2008-09-25  KEYSER -- HANDLES "REPROCESSED" ASCAT WINDS IN "ascatw"
C     DUMP FILE
C 2016-11-30  D. A. KEYSER -- Reads new output real, double-precision
C     argument array RDATA8_8 of length 2 in call to W3UNPKB7.  This
C     returns latitude and longitude for each report which is then
C     stored in R*8 variables ALAT_8 and ALON_8 prior to listing for
C     dump type ASCATW (also here format changed to list 5 significant
C     digits instead of 2).
C     BENEFIT: Replaces lat/lon returned in RDATA(1:2) in call to
C              W3UNPKB7 for this type, which is just at machine precison
C              (normally R*4).  Since reports in these dumps can store
C              lat/lon at 0.00001 degree precision, this change will
C              ensure that lat/lon is always accurate to 0.00001 degrees
C              in these listings.
C 2017-10-13  D. A. KEYSER -- Added minutes to every print statement
C     that includes the central dump time.  Central dump time minutes is
C     obtained from Section 1 of first (dummy) message of input dump
C     file via call to BUFRLIB routine IUPVS01.
C     BENEFIT: Until now, central dump time minutes was always zero.
C              However, with the implementation of the new RTMA_RU,
C              central dump time can now also have minutes = 15, 30
C              or 45 (since the RTMA_RU runs 4 times per hour). This
C              change allows the print statements to reflect this new
C              center dump time format.
C
C USAGE:    CALL LISTQKSWND(ITYPE)
C   INPUT ARGUMENT LIST:
C     ITYPE    - TYPE OF SCATTEROMETER DATA BEING PROCESSED (=1 -
C                QUIKSCAT, =2 - ASCAT)
C
C   INPUT FILES: 
C     UNIT 05  - INPUT DATA CARDS IN THE FORM OF A NAMELIST (SEE
C              - REMARKS IN MAIN PROGRAM DOCBLOCK)
C     UNIT 21  - BUFR DATA SET
C
C   OUTPUT FILES:
C     UNIT 06  - STANDARD OUTPUT PRINT
C
C REMARKS: NONE.
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE:  NCEP WCOSS
C
C$$$

      SUBROUTINE LISTQKSWND(ITYPE)

      LOGICAL SNDG,RETR,RADN,SUBSKP(0:255,0:200)
      INTEGER  NWINDO(2),IDATE(4),MDATE(4),IDATA(2500),IBIT(31)
      INTEGER(8)  IDSDMP_8
      REAL  RDATA(2500),RDATA2(25)
      REAL(8) WVCQ_8,BMISS,rdata8_8(2),alat_8,alon_8
      CHARACTER*1  C1,C2,c1_8,c2_8
      CHARACTER*8  STNID,DSNAME,SUBSET,CTYPE(2)

      COMMON/BUFRLIB_MISSING/BMISS

      EQUIVALENCE (RDATA,IDATA)
      DATA  XMISS/99999./
      DATA  CTYPE/'QUIKSCAT','  ASCAT '/

      NAMELIST/PDATA/IDAT10,IWINDE,IWINDL,IPRINT,SNDG,RETR,RADN,SUBSKP

      SUBSKP = .FALSE.
      READ(5,PDATA)

      IDATE(1) = IDAT10/1000000
      IDATE(2) = MOD((IDAT10/10000),100)
      IDATE(3) = MOD((IDAT10/100),100)
      IDATE(4) = MOD(IDAT10,100)

      IUNIT   = 21
      NWINDO(1) = IWINDE
      NWINDO(2) = IWINDL

      KNTRPT = 0

 2090 CONTINUE

C CALL W3UNPKB7 TO UNPACK THE NEXT QUIKSCAT OR ASCAT SCATTEROMETER WIND
C  REPORT

      IRET = IPRINT

      CALL W3UNPKB7(IDATE,NWINDO(1),NWINDO(2),IUNIT,RDATA,STNID,DSNAME,
     $ RDATA2,rdata8_8,IDSDAT,IDSDMP_8,SUBSET,SUBSKP,IRET)
C-----------------------------------------------------------------------
      IF(IRET.EQ.1)  THEN

C IRET = 1 RETURNS DATA SET INFO (ONLY) AFTER FIRST CALL

         IF(IPRINT.LT.0)   PRINT'(" RETURN CODE =",I0,"; DATA SET ",
     $    "INFORMATION RETURNED")', IRET
         PRINT 102, DSNAME,IUNIT
  102    FORMAT(//46X,'*****  ',A8,'  --  UNIT =',I3,'  *****')

C SPLIT DATE INTO COMPONENTS (MDATE)
         MDATE(1) = IDSDAT/1000000
         MDATE(2) = MOD((IDSDAT/10000),100)
         MDATE(3) = MOD((IDSDAT/100),100)
         MDATE(4) = MOD(IDSDAT,100)
c-----------------------------------------------------------------------
c  Read 1st dummy message in file so can then call iupvs01 to get iminu
         call readmg(iunit,subset,ibdate,kret)
         iminu = iupvs01(iunit,'MINU')
c  Close file and reopen so W3UNPKB7 will handle things as though this
c   block of code never exited
         call closbf(iunit)
         call openbf(iunit,'IN',iunit)
c-----------------------------------------------------------------------
         PRINT 1101, DSNAME,MDATE,iminu,IDSDMP_8
 1101    FORMAT(20X,'DATASET NAME: ',A8,'  --  DATE: ',I4.4,2('-',I2.2),
     $    1X,I2.2,i2.2,'Z  -- DUMP DATE (I12 FORMAT): ',I12.12/)

C DOES DATE FROM DATA SET MATCH EXPECTED CENTER DATE?

         IF(IDSDAT.NE.IDAT10)  THEN
            PRINT 324
  324 FORMAT(/13X,'>>>>>   P R O B L E M :   B U F R   F I L E   ',
     $ 'D A T E   D O E S   N O T   M A T C H   E X P E C T E D   ',
     $ 'D A T E   <<<<<'/)
            GO TO 7003
         END IF
         IFIND = 0
         DO  I = 0,255
            DO  J = 0,200
               IF(SUBSKP(I,J))  THEN
                  IF(IFIND.EQ.0)  PRINT 7001
 7001 FORMAT(34X,'-- THE FOLLOWING BUFR MESSAGE TYPES/SUBTYPES WILL ',
     $ 'BE SKIPPED:')
                  PRINT 7002, I,J
 7002 FORMAT(45X,'BUFR TYPE ',I3.3,', SUBTYPE ',I3.3)
                  IFIND = 1
               END IF
            ENDDO
         ENDDO
         IF(IFIND.EQ.0)  PRINT 8003
 8003 FORMAT(10X,'-- ALL BUFR MESSAGE TYPES/SUBTYPES IN DATA DUMP FILE',
     $ ' WILL BE PROCESSED')
         PRINT 7004
 7004    FORMAT(//)
         GO TO 2090
C----------------------------------------------------------------------
      ELSE IF(IRET.GT.2)  THEN
C PROBLEM READING QUIKSCAT OR ASCAT SCATTEROMETER WIND REPORT, GO ON TO
C  NEXT RPT
         PRINT 912, CTYPE(ITYPE)
  912    FORMAT(' * * ERROR READING ',A,' SCATTEROMETER WIND REPORT, ',
     $    'TRY NEXT ONE')
         GO TO 2090
C----------------------------------------------------------------------
      ELSE  IF(IRET.EQ.2)  THEN
C ALL DONE
         GO TO 7003
      END IF
C----------------------------------------------------------------------

      KNTRPT = KNTRPT + 1

C PRINT OUT REPORT AS FOUND IN OUTPUT ARRAYS 'RDATA' AND 'IDATA'
      IF(IPRINT.LT.0)  PRINT 8890, (IDATA(K),K=35,36)
 8890 FORMAT(1X,'>> PRINTOUT OF OUTPUT RDATA/IDATA ARRAY:'//1X,'NO. ',
     $ 'CAT. 10 LVLS=',I1,';  CAT. 10 DATA SUBSCRIPT=',I2/)
      C1 = 'N'
      C2 = 'E'
      c1_8 = 'N'
      c2_8 = 'E'

      ALAT = RDATA(1)
      IF(RDATA(1).LT.0.0)  THEN
         ALAT = -ALAT
         C1 = 'S'
      END IF
      ALON = RDATA(2)
      IF(RDATA(2).GT.180.00)  THEN
         ALON = 360.00 - ALON
         C2 = 'W'
      END IF
      alat_8 = rdata8_8(1)
      if(rdata8_8(1).lt.0.)  then
         alat_8 = -alat_8
         c1_8 = 'S'
      end if
      alon_8 = rdata8_8(2)
      if(rdata8_8(2).lt.0.)  then
         alon_8 = -alon_8
         c2_8 = 'W'
      end if

      IHGHT = 999999
      IF(RDATA(7).LT.XMISS)  IHGHT = NINT(RDATA(7))
      WSPD = XMISS
      SPRR = XMISS
      IF(RDATA(IDATA(36)+3).LT.XMISS)  WSPD = RDATA(IDATA(36)+3)*0.1
      IF(RDATA2(8).LT.BMISS)    SPRR = RDATA2(8) * 100.0
      IF(ITYPE.EQ.1)  THEN
         PRINT 9890, STNID,RDATA(4),ALAT,C1,ALON,C2,IHGHT,IDATA(6),
     $    IDATA(9),NINT(RDATA(IDATA(36)+2)),WSPD,NINT(RDATA2(3)),
     $    NINT(RDATA2(4)),SPRR,NINT(RDATA2(2))
 9890 FORMAT(A8,1X,F8.5,'Z',3X,F5.2,A1,2X,F6.2,A1,3X,'ELV',I3,'M',
     $ 3X,'SAID',I4,3X,'RT ',I3.3,3X,'DIR ',I3,2X,'SPD',F5.1,
     $ 'M/S',3X,'CELL',I3,2X,'ROW',I4,3X,'SPRR',F6.1,'%',3X,'ACAV',I3)
      ELSE
         PRINT 9891, STNID,RDATA(4),alat_8,c1_8,alon_8,c2_8,IHGHT,
     $    IDATA(6),IDATA(9),NINT(RDATA(IDATA(36)+2)),WSPD,
     $    NINT(RDATA2(3)),NINT(RDATA2(2)),RDATA2(23),RDATA2(24)
 9891 FORMAT(A8,1X,F8.5,'Z',3X,F8.5,A1,2X,F9.5,A1,3X,'ELV',I3,'M',
     $ 3X,'SAID',I4,3X,'RT ',I3.3,3X,'DIR ',I3,2X,'SPD',F5.1,
     $ 'M/S',3X,'CELL',I3,3X,'ACAV',I3,3X,'BSCD ',F6.1,3X,'LKCS ',F7.3)
         IF(RDATA2(22).LT.BMISS ) THEN
            WVCQ_8 = RDATA2(22)
            CALL UPFTBV(21,'WVCQ',WVCQ_8,31,IBIT,NIB)
            IF(NIB.GT.0) THEN
               PRINT 1245, NINT(RDATA2(22)),(IBIT(II)-1,II=1,NIB)
 1245 FORMAT(5X,'WVCQ ',I8,' (',<nib>I3,')')
            ELSE
               PRINT 9892, NINT(RDATA2(22))
 9892 FORMAT(5X,'WVCQ ',I8)
            END IF
         END IF
      END IF

C GO UP AND UNPACK THE NEXT REPORT

      GO TO 2090

 7003 CONTINUE

C-----------------------------------------------------------------------

C ALL REPORTS HAVE BEEN UNPACKED -- ALL DONE

      PRINT 9004, IUNIT,KNTRPT
 9004 FORMAT(//45X,'--> ALL REPORTS IN FILE',I3,' PROCESSED <--'//47X,
     $ '*** ',I6,' REPORTS LISTED HERE ***'/)
      PRINT 9006
 9006 FORMAT(/38X,'>>>  SUCCESSFUL COMPLETION OF PROGRAM ',
     $ 'BUFR_LISTDUMPS  <<<'/)

      RETURN

C-----------------------------------------------------------------------

      END
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    LISTGPSIPW
C   PRGMMR: D. A. KEYSER     ORG: NP22       DATE: 2017-10-13
C
C ABSTRACT: LISTS CONTENTS OF A TIME-WINDOWED GPS INTEGRATED
C   PRECIPITABLE BUFR DATA DUMP FILE.  THE STANDARD OUTPUT IS IN
C   AN EASY-TO-READ FORMAT.  NOTE: THIS SUBROUTINE CAN
C   HANDLE THE FOLLOWING BUFR DATA DUMP FILE TYPE: GPSIPW.
C
C PROGRAM HISTORY LOG:
C 2002-07-05  D.A. KEYSER -- ORIGINAL AUTHOR
C 2004-02-02  KEYSER -- ARRAY SUBSKP BUMPED UP FROM (0:12,200) TO
C     (0:255,0:200) AND NOW IT CAN ALSO BE READ IN FOR NON-UPA AND
C     NON-SFC TYPES IN NAMELIST PDATA
C 2016-08-28 D. A. Keyser -- Now lists lat and lon to nearest 0.00001
C     degree rather than to nearest 0.01 degree.  New WMO format GNSS
C     ground-based data (in dump file "gpsipw" under subset 'NC012004)
C     stores CLATH/CLONH rather than CLAT/CLON as with previous
C     production non-standard BUFR format GPS ground-based data from GSD
C     (had been in dump file "gpsipw" under subset 'NC012003).
C 2016-11-30  D. A. KEYSER -- Reads new output real, double-precision
C     argument array RDATA8_8 of length 2 in call to W3UNPKB7.  This
C     returns latitude and longitude for each report which is then
C     stored in R*8 variables ALAT_8 and ALON_8 prior to listing for
C     dump type GPSIPW (already lists to 5 significant digits).
C     BENEFIT: Replaces lat/lon returned in RDATA(1:2) in call to
C              W3UNPKB7 for this type, which is just at machine precison
C              (normally R*4).  Since reports in these dumps can store
C              lat/lon at 0.00001 degree precision, this change will
C              ensure that lat/lon is always accurate to 0.00001 degrees
C              in these listings.
C 2017-10-13  D. A. KEYSER -- Added minutes to every print statement
C     that includes the central dump time.  Central dump time minutes is
C     obtained from Section 1 of first (dummy) message of input dump
C     file via call to BUFRLIB routine IUPVS01.
C     BENEFIT: Until now, central dump time minutes was always zero.
C              However, with the implementation of the new RTMA_RU,
C              central dump time can now also have minutes = 15, 30
C              or 45 (since the RTMA_RU runs 4 times per hour). This
C              change allows the print statements to reflect this new
C              center dump time format.
C
C USAGE:    CALL LISTGPSIPW
C
C   INPUT FILES: 
C     UNIT 05  - INPUT DATA CARDS IN THE FORM OF A NAMELIST (SEE
C              - REMARKS IN MAIN PROGRAM DOCBLOCK)
C     UNIT 21  - BUFR DATA SET
C
C   OUTPUT FILES:
C     UNIT 06  - STANDARD OUTPUT PRINT
C
C REMARKS: NONE.
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE:  NCEP WCOSS
C
C$$$

      SUBROUTINE LISTGPSIPW

      LOGICAL SNDG,RETR,RADN,SUBSKP(0:255,0:200)
      INTEGER  NWINDO(2),IDATE(4),MDATE(4),IDATA(2500)
      INTEGER(8)  IDSDMP_8
      REAL  RDATA(2500),RDATA2(25)
      real(8)     rdata8_8(2),alat_8,alon_8
      CHARACTER*1  C1,C2,c1_8,c2_8
      CHARACTER*8  STNID,DSNAME,SUBSET
      EQUIVALENCE (RDATA,IDATA)
      DATA  XMISS/99999./

      NAMELIST/PDATA/IDAT10,IWINDE,IWINDL,IPRINT,SNDG,RETR,RADN,SUBSKP

      SUBSKP = .FALSE.
      READ(5,PDATA)

      IDATE(1) = IDAT10/1000000
      IDATE(2) = MOD((IDAT10/10000),100)
      IDATE(3) = MOD((IDAT10/100),100)
      IDATE(4) = MOD(IDAT10,100)

      IUNIT   = 21
      NWINDO(1) = IWINDE
      NWINDO(2) = IWINDL

      KNTRPT = 0

 2090 CONTINUE

C CALL W3UNPKB7 TO UNPACK THE NEXT GPS-IPW REPORT

      IRET = IPRINT

      CALL W3UNPKB7(IDATE,NWINDO(1),NWINDO(2),IUNIT,RDATA,STNID,DSNAME,
     $ RDATA2,rdata8_8,IDSDAT,IDSDMP_8,SUBSET,SUBSKP,IRET)
C-----------------------------------------------------------------------
      IF(IRET.EQ.1)  THEN

C IRET = 1 RETURNS DATA SET INFO (ONLY) AFTER FIRST CALL

         IF(IPRINT.LT.0)   PRINT'(" RETURN CODE =",I0,"; DATA SET ",
     $    "INFORMATION RETURNED")', IRET
         PRINT 102, DSNAME,IUNIT
  102    FORMAT(//46X,'*****  ',A8,'  --  UNIT =',I3,'  *****')

C SPLIT DATE INTO COMPONENTS (MDATE)
         MDATE(1) = IDSDAT/1000000
         MDATE(2) = MOD((IDSDAT/10000),100)
         MDATE(3) = MOD((IDSDAT/100),100)
         MDATE(4) = MOD(IDSDAT,100)
c-----------------------------------------------------------------------
c  Read 1st dummy message in file so can then call iupvs01 to get iminu
         call readmg(iunit,subset,ibdate,kret)
         iminu = iupvs01(iunit,'MINU')
c  Close file and reopen so W3UNPKB7 will handle things as though this
c   block of code never exited
         call closbf(iunit)
         call openbf(iunit,'IN',iunit)
c-----------------------------------------------------------------------
         PRINT 1101, DSNAME,MDATE,iminu,IDSDMP_8
 1101    FORMAT(20X,'DATASET NAME: ',A8,'  --  DATE: ',I4.4,2('-',I2.2),
     $    1X,I2.2,i2.2,'Z  -- DUMP DATE (I12 FORMAT): ',I12.12/)

C DOES DATE FROM DATA SET MATCH EXPECTED CENTER DATE?

         IF(IDSDAT.NE.IDAT10)  THEN
            PRINT 324
  324 FORMAT(/13X,'>>>>>   P R O B L E M :   B U F R   F I L E   ',
     $ 'D A T E   D O E S   N O T   M A T C H   E X P E C T E D   ',
     $ 'D A T E   <<<<<'/)
            GO TO 7003
         END IF
         IFIND = 0
         DO  I = 0,255
            DO  J = 0,200
               IF(SUBSKP(I,J))  THEN
                  IF(IFIND.EQ.0)  PRINT 7001
 7001 FORMAT(34X,'-- THE FOLLOWING BUFR MESSAGE TYPES/SUBTYPES WILL ',
     $ 'BE SKIPPED:')
                  PRINT 7002, I,J
 7002 FORMAT(45X,'BUFR TYPE ',I3.3,', SUBTYPE ',I3.3)
                  IFIND = 1
               END IF
            ENDDO
         ENDDO
         IF(IFIND.EQ.0)  PRINT 8003
 8003 FORMAT(10X,'-- ALL BUFR MESSAGE TYPES/SUBTYPES IN DATA DUMP FILE',
     $ ' WILL BE PROCESSED')
         PRINT 7004
 7004    FORMAT(//)
         GO TO 2090
C----------------------------------------------------------------------
      ELSE IF(IRET.GT.2)  THEN
C PROBLEM READING GPS-IPW REPORT, GO ON TO NEXT REPORT
         PRINT 912
  912    FORMAT(' * * ERROR READING GPS-IPW REPORT, TRY NEXT ONE')
         GO TO 2090
C----------------------------------------------------------------------
      ELSE  IF(IRET.EQ.2)  THEN
C ALL DONE
         GO TO 7003
      END IF
C----------------------------------------------------------------------

      KNTRPT = KNTRPT + 1

C PRINT OUT REPORT AS FOUND IN OUTPUT ARRAYS 'RDATA' AND 'IDATA'
      IF(IPRINT.LT.0)  PRINT 8890, (IDATA(K),K=43,44)
 8890 FORMAT(1X,'>> PRINTOUT OF OUTPUT RDATA/IDATA ARRAY:'//1X,'NO. ',
     $ 'CAT. 14 LVLS=',I1,';  CAT. 14 DATA SUBSCRIPT=',I2/)
      C1 = 'N'
      C2 = 'E'
      c1_8 = 'N'
      c2_8 = 'E'

      ALAT = RDATA(1)
      IF(RDATA(1).LT.0.0)  THEN
         ALAT = -ALAT
         C1 = 'S'
      END IF
      ALON = RDATA(2)
      IF(RDATA(2).GT.180.00)  THEN
         ALON = 360.00 - ALON
         C2 = 'W'
      END IF
      alat_8 = rdata8_8(1)
      if(rdata8_8(1).lt.0.)  then
         alat_8 = -alat_8
         c1_8 = 'S'
      end if
      alon_8 = rdata8_8(2)
      if(rdata8_8(2).lt.0.)  then
         alon_8 = -alon_8
         c2_8 = 'W'
      end if

      IHGHT = 999999
      IF(RDATA(7).LT.XMISS)  IHGHT = NINT(RDATA(7))
      ITDEL = 999999
      IF(RDATA(IDATA(44)+4).LT.XMISS)  ITDEL =
     $ NINT(RDATA(IDATA(44)+4) * 100.)
      IF(RDATA(IDATA(44)+5).LT.XMISS)  RDATA(IDATA(44)+5) =
     $ RDATA(IDATA(44)+5) * 1000.
      IHSDL = 999999
      IF(RDATA(IDATA(44)+6).LT.XMISS)  IHSDL =
     $ NINT(RDATA(IDATA(44)+6) * 100.)
      IF(RDATA(IDATA(44)+7).LT.XMISS)  RDATA(IDATA(44)+7) =
     $ RDATA(IDATA(44)+7) * 1000.
      PRINT 9890, STNID,RDATA(4),alat_8,c1_8,alon_8,c2_8,IHGHT,
     $ IDATA(9),RDATA(11),(RDATA(IDATA(44)+II),II=0,1),
     $ NINT(RDATA(IDATA(44)+2)),RDATA(IDATA(44)+3),ITDEL,
     $ RDATA(IDATA(44)+5),IHSDL,(RDATA(IDATA(44)+II),II=7,9)
 9890 FORMAT(A8,2X,F8.5,'Z',3X,F8.5,A1,2X,F9.5,A1,3X,'ELV ',I4,'M',
     $ 3X,'RTP ',I3.3,3X,'RCPT ',F6.2,'Z'/' PSTN ',F6.1,'MB',
     $ 3X,'TEMP ',F5.1,'K',3X,'RELH ',I3,'%',3X,'TPW',F5.1,'MM',3X,
     $ 'ZTD ',I4,'CM',2X,'eZTD ',F4.1,'MM',3X,'HSDL',I3,'CM',2X,
     $ 'EHSD',F4.1,'MM',3X,'WMTM ',F6.2,'K',3X,'WDMF',F5.2/)

C GO UP AND UNPACK THE NEXT REPORT

      GO TO 2090

 7003 CONTINUE

C-----------------------------------------------------------------------

C ALL REPORTS HAVE BEEN UNPACKED -- ALL DONE

      PRINT 9004, IUNIT,KNTRPT
 9004 FORMAT(//45X,'--> ALL REPORTS IN FILE',I3,' PROCESSED <--'//47X,
     $ '*** ',I6,' REPORTS LISTED HERE ***'/)
      PRINT 9006
 9006 FORMAT(/38X,'>>>  SUCCESSFUL COMPLETION OF PROGRAM ',
     $ 'BUFR_LISTDUMPS  <<<'/)

      RETURN

C-----------------------------------------------------------------------

      END
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    LISTRASS
C   PRGMMR: D. A. KEYSER     ORG: NP22       DATE: 2017-10-13
C
C ABSTRACT: LISTS CONTENTS OF A TIME-WINDOWED RASS BUFR DATA DUMP
C   FILE.  THE STANDARD OUTPUT IS IN AN EASY-TO-READ FORMAT. NOTE:
C   THIS SUBROUTINE CAN HANDLE THE FOLLOWING BUFR DATA DUMP FILE
C   TYPE: RASSDA.
C
C PROGRAM HISTORY LOG:
C 2004-02-02  D.A. KEYSER -- ORIGINAL AUTHOR
C 2016-11-30  D. A. KEYSER -- Reads new output real, double-precision
C     argument array RDATA8_8 of length 2 in call to W3UNPKB7.  This
C     new array, which returns latitude and longitude for each report,
C     is currently not referenced by this subroutine.
C 2017-10-13  D. A. KEYSER -- Added minutes to every print statement
C     that includes the central dump time.  Central dump time minutes is
C     obtained from Section 1 of first (dummy) message of input dump
C     file via call to BUFRLIB routine IUPVS01.
C     BENEFIT: Until now, central dump time minutes was always zero.
C              However, with the implementation of the new RTMA_RU,
C              central dump time can now also have minutes = 15, 30
C              or 45 (since the RTMA_RU runs 4 times per hour). This
C              change allows the print statements to reflect this new
C              center dump time format.
C
C USAGE:    CALL LISTRASS
C
C   INPUT FILES: 
C     UNIT 05  - INPUT DATA CARDS IN THE FORM OF A NAMELIST (SEE
C              - REMARKS IN MAIN PROGRAM DOCBLOCK)
C     UNIT 21  - BUFR DATA SET
C
C   OUTPUT FILES:
C     UNIT 06  - STANDARD OUTPUT PRINT
C
C REMARKS: NONE.
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE:  NCEP WCOSS
C
C$$$

      SUBROUTINE LISTRASS

      LOGICAL SNDG,RETR,RADN,SUBSKP(0:255,0:200)
      INTEGER  NWINDO(2),IDATE(4),MDATE(4),IDATA(2500)
      INTEGER(8)  IDSDMP_8
      REAL  RDATA(2500),RDATA2(25)
      real(8)     rdata8_8(2)
      CHARACTER*1  C1,C2
      CHARACTER*8  STNID,DSNAME,SUBSET
      EQUIVALENCE (RDATA,IDATA)
      DATA  XMISS/99999./

      NAMELIST/PDATA/IDAT10,IWINDE,IWINDL,IPRINT,SNDG,RETR,RADN,SUBSKP

      SUBSKP = .FALSE.
      READ(5,PDATA)

      IDATE(1) = IDAT10/1000000
      IDATE(2) = MOD((IDAT10/10000),100)
      IDATE(3) = MOD((IDAT10/100),100)
      IDATE(4) = MOD(IDAT10,100)

      IUNIT   = 21
      NWINDO(1) = IWINDE
      NWINDO(2) = IWINDL

      KNTRPT = 0

 2090 CONTINUE

C CALL W3UNPKB7 TO UNPACK THE NEXT RASS REPORT

      IRET = IPRINT

      PRINT'(1X)'

      CALL W3UNPKB7(IDATE,NWINDO(1),NWINDO(2),IUNIT,RDATA,STNID,DSNAME,
     $ RDATA2,rdata8_8,IDSDAT,IDSDMP_8,SUBSET,SUBSKP,IRET)
C-----------------------------------------------------------------------
      IF(IRET.EQ.1)  THEN

C IRET = 1 RETURNS DATA SET INFO (ONLY) AFTER FIRST CALL

         IF(IPRINT.LT.0)   PRINT'(" RETURN CODE =",I0,"; DATA SET ",
     $    "INFORMATION RETURNED")', IRET
         PRINT 102, DSNAME,IUNIT
  102    FORMAT(//46X,'*****  ',A8,'  --  UNIT =',I3,'  *****')

C SPLIT DATE INTO COMPONENTS (MDATE)
         MDATE(1) = IDSDAT/1000000
         MDATE(2) = MOD((IDSDAT/10000),100)
         MDATE(3) = MOD((IDSDAT/100),100)
         MDATE(4) = MOD(IDSDAT,100)
c-----------------------------------------------------------------------
c  Read 1st dummy message in file so can then call iupvs01 to get iminu
         call readmg(iunit,subset,ibdate,kret)
         iminu = iupvs01(iunit,'MINU')
c  Close file and reopen so W3UNPKB7 will handle things as though this
c   block of code never exited
         call closbf(iunit)
         call openbf(iunit,'IN',iunit)
c-----------------------------------------------------------------------
         PRINT 1101, DSNAME,MDATE,iminu,IDSDMP_8
 1101    FORMAT(20X,'DATASET NAME: ',A8,'  --  DATE: ',I4.4,2('-',I2.2),
     $    1X,I2.2,i2.2,'Z  -- DUMP DATE (I12 FORMAT): ',I12.12/)

C DOES DATE FROM DATA SET MATCH EXPECTED CENTER DATE?

         IF(IDSDAT.NE.IDAT10)  THEN
            PRINT 324
  324 FORMAT(/13X,'>>>>>   P R O B L E M :   B U F R   F I L E   ',
     $ 'D A T E   D O E S   N O T   M A T C H   E X P E C T E D   ',
     $ 'D A T E   <<<<<'/)
            GO TO 7003
         END IF
         IFIND = 0
         DO  I = 0,255
            DO  J = 0,200
               IF(SUBSKP(I,J))  THEN
                  IF(IFIND.EQ.0)  PRINT 7001
 7001 FORMAT(34X,'-- THE FOLLOWING BUFR MESSAGE TYPES/SUBTYPES WILL ',
     $ 'BE SKIPPED:')
                  PRINT 7002, I,J
 7002 FORMAT(45X,'BUFR TYPE ',I3.3,', SUBTYPE ',I3.3)
                  IFIND = 1
               END IF
            ENDDO
         ENDDO
         IF(IFIND.EQ.0)  PRINT 8003
 8003 FORMAT(10X,'-- ALL BUFR MESSAGE TYPES/SUBTYPES IN DATA DUMP FILE',
     $ ' WILL BE PROCESSED')
         PRINT 7004
 7004    FORMAT(//)
         GO TO 2090
C----------------------------------------------------------------------
      ELSE  IF(IRET.GT.2)  THEN
C PROBLEM READING RASS REPORT, GO ON TO NEXT REPORT
         PRINT 912
  912    FORMAT(' * * ERROR READING RASS REPORT, TRY NEXT ONE')
         GO TO 2090
C----------------------------------------------------------------------
C ALL DONE
      ELSE  IF(IRET.EQ.2)  THEN
         GO TO 7003
      END IF
C----------------------------------------------------------------------

      KNTRPT = KNTRPT + 1

C PRINT OUT REPORT AS FOUND IN OUTPUT ARRAY 'IDATA'
      IF(IPRINT.LT.0)  PRINT 8890,(IDATA(K),K=45,46)
 8890 FORMAT(//1X,'>> PRINTOUT OF OUTPUT IDATA ARRAY:'//' NO. CAT. 15',
     $ ' LVLS=',I3,';  CAT. 15 DATA SUBSCRIPT=',I3/)
      C1 = 'N'
      C2 = 'E'

      ALAT = RDATA(1)
      IF(RDATA(1).LT.0.0)  THEN
         ALAT = -ALAT
         C1 = 'S'
      END IF
      ALON = RDATA(2)
      IF(RDATA(2).GT.180.00)  THEN
         ALON = 360.00 - ALON
         C2 = 'W'
      END IF

      PRINT 9890, STNID,RDATA(4),ALAT,C1,ALON,C2,NINT(RDATA(7)),
     $ IDATA(9),NINT(RDATA2(1)),NINT(RDATA2(6)),IDATA(5)
 9890 FORMAT(1X,A8,4X,F8.5,'Z',4X,F5.2,A1,4X,F6.2,A1,4X,'ELEV ',I5,
     $ 'M',4X,'RPT TYPE ',I3.3,4X,'TSIG ',I2,4X,'TAVG ',I4,'MIN',4X,
     $ 'DATE ',I10.10)
      IF(IDATA(45).GT.0)  THEN
         J = IDATA(46) - 3
         PRINT 8892
 8892 FORMAT('UPPER AIR:  LVL   HGT(M)   VTMP(K)      Q.CODE ')
         DO I = 1,IDATA(45)
            J = J + 3
            IHGHT = 999999
            IF(RDATA(J).LT.XMISS)  IHGHT = NINT(RDATA(J))
            VTMP = XMISS
            IF(RDATA(J+2).LT.XMISS)  VTMP = RDATA(J+1)
            PRINT 8893, I,IHGHT,VTMP,IDATA(J+2)
 8893 FORMAT(12X,I2,4X,I5,6X,F6.2,7X,I3)
         ENDDO
      END IF

C GO UP AND UNPACK THE NEXT REPORT

      GO TO 2090

 7003 CONTINUE

C-----------------------------------------------------------------------

C ALL REPORTS HAVE BEEN UNPACKED -- ALL DONE

      PRINT 9004, IUNIT,KNTRPT
 9004 FORMAT(//45X,'--> ALL REPORTS IN FILE',I3,' PROCESSED <--'//47X,
     $ '*** ',I6,' REPORTS LISTED HERE ***'/)
      PRINT 9006
 9006 FORMAT(/38X,'>>>  SUCCESSFUL COMPLETION OF PROGRAM ',
     $ 'BUFR_LISTDUMPS  <<<'/)

      RETURN

C-----------------------------------------------------------------------

      END
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C                .      .    .                                       .
C SUBPROGRAM:    INDEXC      GENERAL SORT ROUTINE FOR CHARACTER ARRAY
C   PRGMMR: D. A. KEYSER     ORG: NP22       DATE: 2000-06-07
C
C ABSTRACT: USES EFFICIENT SORT ALGORITHM TO PRODUCE INDEX SORT LIST
C   FOR A 8-CHARACTER ARRAY.  DOES NOT REARRANGE THE FILE.
C
C PROGRAM HISTORY LOG:
C 1993-06-05  R  KISTLER --- FORTRAN VERSION OF C-PROGRAM
C 1993-07-15  P. JULIAN ---- MODIFIED TO SORT 12-CHARACTER ARRAY
C 1994-08-25  D. A. KEYSER - MODIFIED TO SORT 8-CHARACTER ARRAY
C 1995-05-30  D. A. KEYSER - TESTS FOR < 2 ELEMENTS IN SORT LIST,
C             IF SO RETURNS WITHOUT SORTING (BUT FILLS INDX ARRAY)
C 2000-06-07  D. A. KEYSER - CONVERTED TO IBM-SP
C
C USAGE:    CALL INDEXC(N,CARRIN,INDX)
C   INPUT ARGUMENT LIST:
C     N        - SIZE OF ARRAY TO BE SORTED
C     CARRIN   - 8-CHARACTER ARRAY TO BE SORTED
C
C   OUTPUT ARGUMENT LIST:
C     INDX     - ARRAY OF POINTERS GIVING SORT ORDER OF CARRIN IN
C              - ASCENDING ORDER {E.G., CARRIN(INDX(I)) IS SORTED IN
C              - ASCENDING ORDER FOR ORIGINAL I = 1, ... ,N}
C
C REMARKS: NONE
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE:  NCEP WCOSS
C
C$$$
      SUBROUTINE INDEXC(N,CARRIN,INDX)
      CHARACTER*8  CARRIN(N),CC
      INTEGER  INDX(N)
      DO J = 1,N
         INDX(J) = J
      ENDDO
C MUST BE > 1 ELEMENT IN SORT LIST, ELSE RETURN
      IF(N.LE.1)  RETURN
      L = N/2 + 1
      IR = N
   33 CONTINUE
      IF(L.GT.1)  THEN
         L = L - 1
         INDXT = INDX(L)
         CC = CARRIN(INDXT)
      ELSE
         INDXT = INDX(IR)
         CC = CARRIN(INDXT)
         INDX(IR) = INDX(1)
         IR = IR - 1
         IF(IR.EQ.1)  THEN
            INDX(1) = INDXT
            RETURN
         END IF
      END IF
      I = L
      J = L * 2
   30 CONTINUE
      IF(J.LE.IR)  THEN
         IF(J.LT.IR)  THEN
            IF(CARRIN(INDX(J)).LT.CARRIN(INDX(J+1)))  J = J + 1
         END IF
         IF(CC.LT.CARRIN(INDX(J)))  THEN
            INDX(I) = INDX(J)
            I = J
            J = J + I
         ELSE
            J = IR + 1
         ENDIF
      END IF
      IF(J.LE.IR)  GO TO 30
      INDX(I) = INDXT
      GO TO 33
      END
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    LISTWNDSAT
C   PRGMMR: D. A. KEYSER     ORG: NP22       DATE: 2017-10-13
C
C ABSTRACT: LISTS CONTENTS OF A TIME-WINDOWED REPROCESSED WINDSAT
C   SCATTEROMETER BUFR DATA DUMP FILE.  THE STANDARD OUTPUT IS IN
C   AN EASY-TO-READ FORMAT.  NOTE: THIS SUBROUTINE CAN
C   HANDLE THE FOLLOWING BUFR DATA DUMP FILE TYPE: WDSATR.
C
C PROGRAM HISTORY LOG:
C 2006-07-14  D.A. KEYSER -- ORIGINAL AUTHOR
C 2016-11-30  D. A. KEYSER -- Reads new output real, double-precision
C     argument array RDATA8_8 of length 2 in call to W3UNPKB7.  This
C     new array, which returns latitude and longitude for each report,
C     is currently not referenced by this subroutine.
C 2017-10-13  D. A. KEYSER -- Added minutes to every print statement
C     that includes the central dump time.  Central dump time minutes is
C     obtained from Section 1 of first (dummy) message of input dump
C     file via call to BUFRLIB routine IUPVS01.
C     BENEFIT: Until now, central dump time minutes was always zero.
C              However, with the implementation of the new RTMA_RU,
C              central dump time can now also have minutes = 15, 30
C              or 45 (since the RTMA_RU runs 4 times per hour). This
C              change allows the print statements to reflect this new
C              center dump time format.
C
C USAGE:    CALL LISTWNDSAT
C
C   INPUT FILES: 
C     UNIT 05  - INPUT DATA CARDS IN THE FORM OF A NAMELIST (SEE
C              - REMARKS IN MAIN PROGRAM DOCBLOCK)
C     UNIT 21  - BUFR DATA SET
C
C   OUTPUT FILES:
C     UNIT 06  - STANDARD OUTPUT PRINT
C
C REMARKS: NONE.
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE:  NCEP WCOSS
C
C$$$

      SUBROUTINE LISTWNDSAT

      LOGICAL SNDG,RETR,RADN,SUBSKP(0:255,0:200),short
      INTEGER  NWINDO(2),IDATE(4),MDATE(4),IDATA(2500)
      INTEGER(8)  IDSDMP_8
      REAL  RDATA(2500),RDATA2(25)
      real(8)     rdata8_8(2)
      CHARACTER*1  C1,C2
      CHARACTER*8  STNID,DSNAME,SUBSET
      EQUIVALENCE (RDATA,IDATA)
      DATA  XMISS/99999./

      NAMELIST/PDATA/IDAT10,IWINDE,IWINDL,IPRINT,SNDG,RETR,RADN,SUBSKP

      SUBSKP = .FALSE.
      READ(5,PDATA)

      IDATE(1) = IDAT10/1000000
      IDATE(2) = MOD((IDAT10/10000),100)
      IDATE(3) = MOD((IDAT10/100),100)
      IDATE(4) = MOD(IDAT10,100)

      IUNIT   = 21
      NWINDO(1) = IWINDE
      NWINDO(2) = IWINDL

      KNTRPT = 0

 2090 CONTINUE

C CALL W3UNPKB7 TO UNPACK THE NEXT WINDSAT SCATTEROMETER WIND REPORT

      IRET = IPRINT

      CALL W3UNPKB7(IDATE,NWINDO(1),NWINDO(2),IUNIT,RDATA,STNID,DSNAME,
     $ RDATA2,rdata8_8,IDSDAT,IDSDMP_8,SUBSET,SUBSKP,IRET)
C-----------------------------------------------------------------------
      IF(IRET.EQ.1)  THEN

C IRET = 1 RETURNS DATA SET INFO (ONLY) AFTER FIRST CALL

         IF(IPRINT.LT.0)   PRINT'(" RETURN CODE =",I0,"; DATA SET ",
     $    "INFORMATION RETURNED")', IRET
         PRINT 102, DSNAME,IUNIT
  102    FORMAT(//46X,'*****  ',A8,'  --  UNIT =',I3,'  *****')

C SPLIT DATE INTO COMPONENTS (MDATE)
         MDATE(1) = IDSDAT/1000000
         MDATE(2) = MOD((IDSDAT/10000),100)
         MDATE(3) = MOD((IDSDAT/100),100)
         MDATE(4) = MOD(IDSDAT,100)
c-----------------------------------------------------------------------
c  Read 1st dummy message in file so can then call iupvs01 to get iminu
         call readmg(iunit,subset,ibdate,kret)
         iminu = iupvs01(iunit,'MINU')
c  Close file and reopen so W3UNPKB7 will handle things as though this
c   block of code never exited
         call closbf(iunit)
         call openbf(iunit,'IN',iunit)
c-----------------------------------------------------------------------
         PRINT 1101, DSNAME,MDATE,iminu,IDSDMP_8
 1101    FORMAT(20X,'DATASET NAME: ',A8,'  --  DATE: ',I4.4,2('-',I2.2),
     $    1X,I2.2,i2.2,'Z  -- DUMP DATE (I12 FORMAT): ',I12.12/)

C DOES DATE FROM DATA SET MATCH EXPECTED CENTER DATE?

         IF(IDSDAT.NE.IDAT10)  THEN
            PRINT 324
  324 FORMAT(/13X,'>>>>>   P R O B L E M :   B U F R   F I L E   ',
     $ 'D A T E   D O E S   N O T   M A T C H   E X P E C T E D   ',
     $ 'D A T E   <<<<<'/)
            GO TO 7003
         END IF
         IFIND = 0
         DO  I = 0,255
            DO  J = 0,200
               IF(SUBSKP(I,J))  THEN
                  IF(IFIND.EQ.0)  PRINT 7001
 7001 FORMAT(34X,'-- THE FOLLOWING BUFR MESSAGE TYPES/SUBTYPES WILL ',
     $ 'BE SKIPPED:')
                  PRINT 7002, I,J
 7002 FORMAT(45X,'BUFR TYPE ',I3.3,', SUBTYPE ',I3.3)
                  IFIND = 1
               END IF
            ENDDO
         ENDDO
         IF(IFIND.EQ.0)  PRINT 8003
 8003 FORMAT(10X,'-- ALL BUFR MESSAGE TYPES/SUBTYPES IN DATA DUMP FILE',
     $ ' WILL BE PROCESSED')
         PRINT 7004
 7004    FORMAT(//)
         GO TO 2090
C----------------------------------------------------------------------
      ELSE IF(IRET.GT.2)  THEN
C PROBLEM READING WINDSAT SCATTEROMETER WIND REPORT, GO ON TO NEXT RPT
         PRINT 912
  912    FORMAT(' * * ERROR READING WINDSAT SCATTEROMETER WIND REPORT,',
     $    ' TRY NEXT ONE')
         GO TO 2090
C----------------------------------------------------------------------
      ELSE  IF(IRET.EQ.2)  THEN
C ALL DONE
         GO TO 7003
      END IF
C----------------------------------------------------------------------

      KNTRPT = KNTRPT + 1

C PRINT OUT REPORT AS FOUND IN OUTPUT ARRAYS 'RDATA' AND 'IDATA'
      IF(IPRINT.LT.0)  PRINT 8890, (IDATA(K),K=35,36)
 8890 FORMAT(1X,'>> PRINTOUT OF OUTPUT RDATA/IDATA ARRAY:'//1X,'NO. ',
     $ 'CAT. 10 LVLS=',I1,';  CAT. 10 DATA SUBSCRIPT=',I2/)
      C1 = 'N'
      C2 = 'E'

      ALAT = RDATA(1)
      IF(RDATA(1).LT.0.0)  THEN
         ALAT = -ALAT
         C1 = 'S'
      END IF
      ALON = RDATA(2)
      IF(RDATA(2).GT.180.00)  THEN
         ALON = 360.00 - ALON
         C2 = 'W'
      END IF

      IHGHT = 999999
      IF(RDATA(7).LT.XMISS)  IHGHT = NINT(RDATA(7))
      WSPD = XMISS
      short = .true.
      IF(RDATA(IDATA(36)+3).LT.XMISS)  WSPD = RDATA(IDATA(36)+3)*0.1
      if(.not.short) then
         PRINT 9890, STNID,RDATA(4),ALAT,C1,ALON,C2,IHGHT,IDATA(6),
     $    IDATA(9),NINT(RDATA(IDATA(36)+2)),WSPD,
     $    RDATA(IDATA(36)+6)*3600.,RDATA2(9),RDATA2(10),RDATA2(11),
     $    NINT(RDATA2(12)),RDATA2(19),RDATA2(17),RDATA2(18),RDATA2(21),
     $    RDATA2(20),RDATA2(16),NINT(RDATA2(15)),RDATA2(13),RDATA2(14),
     $    NINT(RDATA2(2))
 9890 FORMAT(A8,2X,F8.5,'Z',2X,F5.2,A1,1X,F6.2,A1,2X,'ELV',I3,'M',2X,
     $ 'SAID',I4,2X,'RTP ',I3.3,2X,'DIR ',I3,1X,'SPD',F5.1,'M/S',2X,
     $ 'REQV ',F4.1,'MM/HR',2X,'SST1 ',F6.2,'K',2X,'PW ',F6.2,'MM',2X,
     $ 'CLW ',F5.2,'MM'/5X,'WSST',I2,2X,'SSTE ',F6.2,2X,'PHER ',F5.1,
     $ 2X,'SPDE ',F5.2,2X,'VPRE ',F5.2,2X,'CLDE ',F6.3,2X,'CHSQ ',F5.2,
     $ 2X,'WSEQC1 ',I10,2X,'MWD10 ',F6.2,2X,'MWS10 ',F6.2,2X,'ACAV ',I2)
      else
         PRINT 9891, STNID,RDATA(4),ALAT,C1,ALON,C2,IHGHT,IDATA(6),
     $    IDATA(9),NINT(RDATA(IDATA(36)+2)),WSPD,
     $    RDATA(IDATA(36)+6)*3600.,RDATA2(9),RDATA2(10),RDATA2(11)
 9891 FORMAT(A8,2X,F8.5,'Z',2X,F5.2,A1,1X,F6.2,A1,2X,'ELV',I3,'M',2X,
     $ 'SAID',I4,2X,'RTP ',I3.3,2X,'DIR ',I3,1X,'SPD',F5.1,'M/S',2X,
     $ 'REQV ',F4.1,'MM/HR',2X,'SST1 ',F6.2,'K',2X,'PW ',F6.2,'MM',2X,
     $ 'CLW ',F5.2,'MM')
      end if

C GO UP AND UNPACK THE NEXT REPORT

      GO TO 2090

 7003 CONTINUE

C-----------------------------------------------------------------------

C ALL REPORTS HAVE BEEN UNPACKED -- ALL DONE

      PRINT 9004, IUNIT,KNTRPT
 9004 FORMAT(//45X,'--> ALL REPORTS IN FILE',I3,' PROCESSED <--'//47X,
     $ '*** ',I6,' REPORTS LISTED HERE ***'/)
      PRINT 9006
 9006 FORMAT(/38X,'>>>  SUCCESSFUL COMPLETION OF PROGRAM ',
     $ 'BUFR_LISTDUMPS  <<<'/)

      RETURN

C-----------------------------------------------------------------------

      END
