C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:  W3UNPKB7
C   PRGMMR: KEYSER           ORG: NP22        DATE: 2016-11-30
C
C ABSTRACT: THIS SUBROUTINE DECODES A SINGLE REPORT FROM BUFR MESSAGES
C   IN AN NCEP BUFR DATA FILE.  CURRENTLY WIND PROFILER {EXCEPT FOR,
C   THOSE ORIGINATING FROM PILOT (PIBAL) FORMAT BULLETINS, SEE
C   SUBROUTINE IW3UNPBF FOR THESE}, NEXRAD (VAD) WIND (FROM BOTH RADAR
C   CODED MESSAGE AND FROM LEVEL 2 DECODER), GOES SOUNDING/RADIANCE,
C   ERS SCATTEROMETER WIND, QUIKSCAT SCATTEROMETER WIND, WINDSAT
C   SCATTEROMETER WIND (NAVY OR NESDIS), ASCAT SCATTEROMETER WIND, RASS
C   AND GPS-IPW DATA TYPES ARE VALID.  REPORT IS RETURNED IN QUASI-
C   IW3UNPBF UNPACKED FORMAT (SEE REMARKS 5) AND DIRECTLY FROM BUFR
C   FORMAT (SEE REMARKS 6).  IN ADDITION THE ASCII STATION ID IS
C   RETURNED FOR EACH DECODED REPORT.  ALSO, INFORMATION ABOUT THE
C   INPUT DATA SET ITSELF (NAME, CENTER DATE, DUMP TIME) AND THE BUFR
C   MESSAGE TYPE IS RETURNED.
C
C PROGRAM HISTORY LOG:
C 1998-02-17  D. A. KEYSER -- ORIGINAL AUTHOR (BASED ON W3LIB ROUTINE
C     W3UNPK77)
C 1998-06-14  D. A. KEYSER -- MODIFIED WIND PROFILER CAT. 11 (HEIGHT,
C     HORIZ. SIGNIFICANCE, VERT. SIGNIFICANCE) AND VAD WIND HEADER
C     (STATION ID) PROCESSING TO ACCOUNT FOR UPDATES TO BUFRTABLE
C     MNEMONICS IN /dcom; CHANGED CHAR. 6 OF GOES STNID TO BE UNIQUE
C     FOR TWO DIFFERENT EVEN OR ODD SATELLITE ID'S (EVERY OTHER EVEN OR
C     ODD SAT. ID NOW GETS SAME CHAR. 6 TAG)
C 1998-06-15  D. A. KEYSER -- REDEFINED UNITS FOR UNPACKED WORDS 1
C     (LATITUDE), 2 (LONGITUDE), 4 (OBS. TIME) AND 11 (RECEIPT TIME) -
C     ALL TO CONFORM WITH UNPACKED IW3UNPBF FORMAT AND TO STREAMLINE
C     PROCESSING IN PREPDATA PROGRAM
C 1998-09-21  D. A. KEYSER -- SUBROUTINE NOW Y2K AND FORTRAN 90
C     COMPLIANT
C 1998-10-09  D. A. KEYSER -- CORRECTED ERROR IN RETURNING GOES
C     CAT. 8 DATA WHEN GREATER THAN 9 "LEVELS" ARE PRESENT
C 1999-01-20  D. A. KEYSER -- INCORPORATED BOB KISTLER'S CHANGES NEEDED
C     TO PORT THE CODE TO THE IBM SP
C 1999-02-12  D. A. KEYSER -- ADDED ERS SCATTEROMETER WINDS HERE NOW
C     THAT THEY ARE PACKED IN AN NCEP BUFR FILE
C 1999-05-17  D. A. KEYSER -- MADE FURTHER CHANGES NECESSARY TO PORT
C     THIS ROUTINE TO THE IBM SP
C 1999-11-02  D. A. KEYSER -- CHANGES TO MAKE CODE MORE PORTABLE
C 2000-03-30  D. A. KEYSER -- CHANGE TO BY-PASS TIME-WINDOW CHECKS ON
C     BUFR MESSAGES IF TIME WINDOW VALUES ARE -6 AND +6 HOURS, RESP.
C 2000-09-22  D. A. KEYSER -- ADDED QUIKSCAT SCATTEROMETER WINDS HERE
C     NOW THAT THEY ARE PACKED IN A NCEP BUFR FILE; CORRECTED VALUE
C     FOR RETURNED RAINFALL RATE IN CAT. 10 FOR WIND PROFILER REPORTS
C 2000-12-05  D. A. KEYSER -- CHANGE TO BY-PASS TIME-WINDOW CHECKS ON
C     BUFR MESSAGES IF TIME WINDOW VALUES ARE .LE. -3 AND .GE. +2
C     HOURS, RESP. (WAS .LE. -6 AND .GE. +6) SINCE NO DATA DUMPS WILL
C     EVER BE GREATER THAN THIS TIME WINDOW SPAN; GOES SOUNDING
C     PROCESSING MODIFIED TO NOT CREATE STN. ID IF IT HAS ALREADY BEEN
C     CREATED BY BUFR_DUPSAT, ERS SCATTEROMETER PROCESSING MODIFIED TO
C     NOT CREATE STN. IF IT HAS ALREADY BEEN CREATED BY WAVE_DATASORT
C     AND QUIKSCAT SCATTEROMETER PROCESSING MODIFIED TO NOT CREATE STN.
C     ID IF IT HAS ALREADY BEEN CREATED BY WAVE_DCODQUIKSCAT
C     (OTHERWISE, MODIFIED TO CREATE AN 8-CHARACTER STN. ID FOR ALL 3
C     TYPES)
C 2001-04-06  D. A. KEYSER -- RETURNS WITH IRET = 8 IF A BUFR MESSAGE
C     READ IN HAS THE SUBSET "NC002009" - THIS INDICATES THE MESSAGE
C     CONTAINS WIND PROFILER REPORTS ORIGINATING FROM PILOT (PIBAL)
C     FORMAT BULLETINS WHICH THIS SUBR. CANNOT PROCESS; ADDED "SUBSET"
C     (BUFR MESSAGE TYPE) AS AN OUTPUT ARGUMENT; THE GOES SOUNDING/
C     RADIANCE CAT. 8 TYPES ARE NO LONGER SCALED, BUT STORED IN THE
C     SAME UNITS/ SCALING AS FOUND UPON INPUT; THE GOES SOUNDING/
C     RADIANCE CAT. 13 BRIGHTNESS TEMPERATURES ARE NOW STORED AS DEG.
C     K (PRECISE TO 10**2) RATHER THAN AS DEG. K X 100; HEADER WORD 5
C     NOW RETURNS COMPLETE DATE (YYYYMMDDHH) AND HEADER WORD 6 (WAS
C     DDHH) NOW RETURNS SATELLITE ID FOR GOES, ERS AND QUIKSCAT REPORTS
C     (FOR OTHERS IT'S MISSING); FOR GOES SOUNDINGS NOW SKIPS CAT. 12
C     LEVELS WHERE RETRIEVED GEOPOTENTIAL HGHT IS .LE. ELEVATION
C     (LOWEST RETRIEVED HEIGHT); FOR GOES SOUNDINGS NOW UNPACKS SURFACE
C     PRESSURE INTO CAT. 8 CODE FIGURE 262
C 2001-06-19  D. A. KEYSER -- RECOGNIZES BUFR TYPE/SUBTYPE 003/002 AS
C     GOES 1x1 (HI-RES) DATA, PART OF THE "GOESND" DUMP FILE; STORES
C     CLOUD COVER RATHER THAN CLOUD AMOUNT IN OUTPUT CAT. 8, C.F. 258
C     FOR GOES HI-RES REPORTS; GOES HI-RES REPORTS HAVE UNKNOWN PATH
C     AND GET PROPER STNID CHAR. 8 CHARACTER IDENTIFYING THE SAT.
C     NUMBER AND GET "H" IN STNID CHAR. 1 TO UNIQUELY IDENTIFY THEM
C     (IF STNID IS GENERATED HERE)
C 2001-07-10  D. A. KEYSER -- FOR GOESND REPORTS, NOW KEEPS SEPARATE
C     COUNT OF REPORTS WITH MISSING # FOV (E.G., CLOUD-TOP REPORTS),
C     BEFORE THESE WERE GROUPED WITH # FOV 10-25
C 2001-08-20  D. A. KEYSER -- FOR QUIKSCAT REPORTS, HEADER WORD 10
C     NOW RETURNS NUMBER OF ORIGINAL REPORTS USED TO GENERATE SUPEROBS
C     SINCE THIS IS NOW AVAILABLE IN INPUT REPROCESSED QKSWND DUMP
C     FILE (FOR NON-SUPEROBS, HARDWIRED TO 1)
C 2002-01-28  D. A. KEYSER -- THE QUALITY CODE FOR WIND PROFILER LEVELS
C     IS NOW SET TO 14 IF THE DECODED QN29 WIND QUALITY MARKER IS 12
C     (REJECT LIST) OR 14 (SDM PURGE), OTHERWISE IT IS SET TO THE
C     DECODED QUALITY CODE VALUE (BEFORE THE ON29 Q.M. WAS IGNORED);
C     THE WIND Q.M. FOR VAD WINDS LEVELS IS NOW SET TO THE DECODED QN29
C     WIND QUALITY MARKER IF IT IS 12 (REJECT LIST) OR 14 (SDM PURGE),
C     OTHERWISE IT IS SET TO THE NUMERICAL INDICATOR FOR THE DECODED
C     RMS VECTOR WIND ERROR (BEFORE THE ON29 Q.M. WAS IGNORED)
C 2002-03-05  D. A. KEYSER -- ACCOUNTS FOR CHANGES IN INPUT PROFLR
C     (WIND PROFILER BUFR DUMP FILE AFTER 5/2002: CAT. 10 SURFACE DATA
C     NOW ALL MISSING (MNEMONICS "PMSL","WDIR1","WSPD1", "TMDB",
C     "REHU", "REQV" NO LONGER AVAILABLE); CAT. 11 MNEMONICS "ACAVH",
C     "ACAVV", "SPP0", AND "NPHL" NO LONGER AVAILABLE; HEADER MNEMONIC
C     "NPSM" IS NO LONGER AVAILABLE; HEADER MNEMONIC "TPSE" REPLACES
C     "TPMI" (AVG. TIME IN MINUTES STILL OUTPUT); NUMBER OF UPPER-AIR
C     LEVELS INCR. FROM 43 TO UP TO 64 (SIZE OF OUTPUT "RDATA" ARRAY
C     INCR. FROM 720 TO 1200 TO ACCOUNT FOR THIS) (WILL STILL WORK
C     PROPERLY FOR INPUT PROFLR DUMP FILES PRIOR TO 5/2002)
C 2002-07-03  D. A. KEYSER -- COMBINED INDIVIDUAL SUBROUTINES FOR
C     PROCESSING HEADER INFORMATION FOR ALL TYPES INTO A SINGLE NEW
C     SUBROUTINE SINCE ALL WERE VERY SIMILAR; ADDED PROCESSING OF GPS-
C     IPW REPORTS HERE NOW THAT THEY ARE PACKED IN AN NCEP BUFR FILE
C     (GPSIPW - RETURNED IN NEW CATEGORY 14)
C 2004-02-02  D. A. KEYSER -- ADDED COOPERATIVE AGENCY (002/011) AND
C     JAPANESE (002/013) WIND PROFILERS TO PROCESSING FOR WIND
C     PROFILERS NOT ORIGINATING FROM PILOT (PIBAL) BULLETINS; ADDED
C     PROCESSING OF NPN AND CAP RASS REPORTS HERE (002/012) NOW THAT
C     THEY ARE PACKED IN AN NCEP BUFR FILE (RASSDA - RETURNED IN NEW
C     DATA LEVEL CATEGORY 15); ADDED NEW INPUT ARGUMENT "SUBSKP" - SEE
C     DESCRIPTION BELOW
C 2004-09-09  D. A. KEYSER -- ADDED LOGIC TO HANDLE GOES 1x1 (SFOV)
C     SOUNDING (RADIANCE/RETRIEVAL) DATA: DOES NOT Q.C. ANY 1x1 DATA
C     (CLOUD AS BEFORE, BUT NOW ALSO SNDGS) BY NUMBER OF FOV's (STILL
C     DOES SO FOR NON-RADIANCE 5x5 DATA); FOR GOES PW RETRIEVALS, IF
C     TPW IS NOT FOUND UNDER LOCAL MNEMONIC "PH2O", NOW LOOKS FOR IT IN
C     WMO MNEMONIC "TPWT", THIS ALLOWS FOR TRANSITION FROM "PH2O" TO
C     "TPWT" IN REPORTS IN DUMP FILES (~ MID-2004) AND ALSO ALLOWS
C     HISTORICAL RERUNS TO READ OLD DUMP FILES
C 2005-03-14  D. A. KEYSER (THIS FUNCTION IN PROGRAM BUFR_LISTDUMPS):
C 2007-09-14  D. A. KEYSER (THIS FUNCTION IN PROGRAM PREPOBS_PREPDATA):
C     BUG FIX: REMOVED THIRD ARG. IN CALLS TO UNPKB709 AND UNPKB710
C     (SUBROUTINES ONLY HAVE TWO ARG.)
C 2006-07-14  D. A. KEYSER (THIS FUNCTION IN PROGRAM BUFR_LISTDUMPS):
C 2007-09-14  D. A. KEYSER (THIS FUNCTION IN PROGRAM PREPOBS_PREPDATA):
C     MODIFIED TO HANDLE NAVY WINDSAT SCATTEROMETER WINDS (READ FROM
C     MESSAGE TYPES NC012138, GETS DUMP REPORT TYPE 583, OUTPUT IN
C     "RDATA" CAT. 10 AND SOME ELEMENTS IN "RDATA2"); ADDED RETURN
C     ARGUMENT "RDATA2", 1-DIM 21-WORD ARRAY WHICH HOLDS ADDITIONAL
C     VALUES DECODED DIRECTLY FROM BUFR (AND NOT IN "RDATA" ARRAY);
C     MOVED REPORT-TYPE SPECIFIC VALUES OUT OF RETURNED HEADER IN
C     "RDATA" TO NEW "RDATA2" ARRAY (CLEANS UP HEADER PROCESSING);
C     RAINFALL RATE IN CAT. 10 NOW RETURNED IN ORIGINAL BUFR UNITS OF
C     KG/((M**2)*SEC) INSTEAD OF MM/HOUR (WINDSAT IS ONLY TYPE TO
C     RETURN THIS); FOLDED SUBROUTINE UNPKB708 INTO UNPKB704 SINCE BOTH
C     HAD PROCESSED DATA INTO CATEGORY 10 (UNPKB708 HANDLED
C     SCATTEROMETER REPORTS, UNPKB704 HANDLED WIND PROFILER REPORTS)
C 2007-09-14  D. A. KEYSER (THIS FUNCTION IN PROGRAM BUFR_LISTDUMPS):
C 2007-09-14  D. A. KEYSER (THIS FUNCTION IN PROGRAM PREPOBS_PREPDATA):
C     MODIFIED TO HANDLE NESDIS WINDSAT SCATTEROMETER WINDS (READ FROM
C     MESSAGE TYPE NC012139), PROCESSING IS IDENTICAL TO NAVY WINDSAT
C     SCATTEROMETER WINDS; HANDLES GOES 1x1 F-O-V SNDGS/RADIANCES IN
C     DUMP FILE "GOESFV" (SUBSET "NC003003"); CODE FIGURE 258 REFERS
C     ONLY TO CLOUD AMOUNT (HAD ALSO PREVIOUSLY REFERRED TO CLOUD COVER
C     FOR GOES 1x1 SNDGS - GOES 1x1 AND 5x5 SNDGS NOW BOTH PROCESS
C     CLOUD AMOUNT)
C 2008-09-25  D. A. KEYSER -- ADDED ASCAT SCATTEROMETER WINDS HERE NOW
C     THAT THEY ARE PACKED IN A NCEP BUFR FILE (GET DUMP REPORT TYPE
C     584), RETURNED IN CATEGORY 10, EXPANDED 1-DIM OUTPUT ARRAY RDATA2
C     FROM 21 TO 24 WORDS TO HOLD NEW ANCILLARY INFO FOR ASCAT REPORTS
C     {WIND VECTOR CELL QUALITY (MNEMONIC WVCQ, BUFR F.T. 0-21-155),
C     BACKSCATTER DISTANCE (MNEMONIC BSCD, NUMERIC), LIKELIHOOD
C     COMPUTED FOR SOLUTION (MNEMONIC LKCS, NUMERIC)
C 2012-11-30  J. WOOLLEN   -- INITIAL PORT TO WCOSS; RESET BMISS TO
C     A VALUE (10E08) WHICH WILL NOT CAUSE INTEGER OVERFLOW WHICH CAN
C     BE UNPREDICTABLE (PRIOR BMISS VALUE WAS 10E10)
C 2013-02-14  D. A. KEYSER -- FINAL CHANGES TO RUN ON WCOSS; OBTAIN
C     VALUE OF BMISS SET IN CALLING PROGRAM VIA CALL TO BUFRLIB ROUTINE
C     GETBMISS RATHER THAN HARDWIRING IT TO 10E08 (OR 10E10); USE
C     BUFRLIB FUNCTION IBFMS TO DETERMINE IF A VARIABLE READ FROM BUFR
C     FILE IS MISSING (I.E. RETURNED AS BMISS);  USE FORMATTED PRINT
C     STATEMENTS WHERE PREVIOUSLY UNFORMATTED PRINT WAS USED (WCOSS
C     SPLITS UNFORMATTED PRINT AT 80 CHARACTERS); MAXIMUM NUMBER OF
C     CAT. 11 WIND PROFILER LEVELS THAT CAN BE PROCESSED (EXCLUDING
C     BOTTOM SURFACE LEVEL) REDUCED FROM 103 TO 102 AS FORMER CAUSED AN
C     OVERFLOW OF THE CURRENT 1200 WORD LIMIT IN RDATA ARRAY; FOR ANY
C     "GOESND" OR "GOESFV" DUMP FILES WITH CENTER TIME 2013022512 OR
C     LATER, NO ATTEMPT IS MADE TO DECODE GOES SOUNDINGS (PROFILES) AS
C     THESE WERE REMOVED AT THIS TIME FROM THE 1X1 GOES RADIANCE FILES
C     PROVIDED BY NESDIS (INGESTED INTO FROM TANK b003/xx003)
C 2014-03-13  D. A. KEYSER -- MODIFIED TO HANDLE VAD WINDS FROM LEVEL
C     2 DECODER (SUBSET "NC002017") {IN ADDITION TO THOSE FROM RADAR
C     CODED MESSAGE (SUBSET "NC002008")}; PARAMETERIZED MAXIMUM NUMBER
C     OF LEVELS ALLOWED FOR EACH CATEGORY AND CALCULATED PARAMETER
C     "IDMAX" (SIZE OF OUTPUT "RDATA" ARRAY) BASED ON THESE, ALL ARE
C     NOW PLACED IN INCLUDE FILE 'inc_w3unpkb7.inc' {IN HERE, MAXIMUM
C     NUMBER OF CAT. 04 WINDS-BY-HEIGHT LEVELS (EXCLUDING FIRST,
C     SURFACE, LEVEL), "ILVLMX_04", INCREASED FROM 64 TO 254 TO ACCOUNT
C     FOR MORE LEVELS IN NEW VAD WINDS FROM LEVEL 2 DECODER, AND
C     MAXIMUM NUMBER OF CAT. 11 WIND PROFILER LEVELS (EXCLUDING FIRST,
C     SURFACE, LEVEL), "ILVLMX_11", INCREASED FROM 102 TO 200 TO
C     ACCOUNT FOR SOME MAP PROFILERS WITH MORE LEVELS THAN BEFORE, THE
C     RESULTING "IDMAX" IS NOW 2270, UP FROM 1200 BEFORE}
C 2015-04-16 JWhiting --  RDATA2 is expanded to size 25 in order to
C     store total cloud cover (TOCC) (present in dumps of GOES cloud
C     reports) (stored in subr. UNPKB707).
C 2015-12-18 D. A. Keyser -- Updated to decode variables specific to 
C     the new WMO BUFR format for GNSS ground-based data (in dump file 
C     "gpsipw" under subset "NC012004") in order to process GPS-Met 
C     reports from this feed. Namely:
C       CLATH (high-res lat) --> stored as lat in header array returned
C        to calling program
C       CLONH (high-res lon) --> stored as lon in header array returned
C        to calling program
C       STSN (station name) --> stored as STNID returned to calling
C        program
C       TMDBST (dry-bulb temperature to nearest 0.1K) --> stored in 
C        cat. 14 returned to calling program
C       APDS (atmospheric path delay in satellite signal, m, from
C        replication where azimuth angle is zero deg. and elevation
C        angle is 90 deg.) --> this is defined as ZENITH TOTAL DELAY and
C        is stored in cat. 14 returned to calling program
C       APDE (error in atmospheric path delay in satellite signal, m,
C        from replication where azimuth angle is zero deg. and elevation
C        angle is 90 deg.) --> this is defined as ERROR IN ZENITH TOTAL
C        DELAY and is stored in cat. 14 returned to calling program
C     (Note: will still also properly decode variables in current
C     production non-standard BUFR format GPS ground-based data (in dump 
C     file "gpsipw" under subset "NC012003").
C 2016-08-15 JWhiting -- Added variable 'subset' to UNPKB709 argument
C     list so as to allow its use in testing for whether reports are 
C     from new GNSS ground-based data streams (subset=NC012004); this 
C     replaces potentially ambiguous test on missing TDEL data from 
C     previous GPS-IPW data streams.
C 2016-11-30  D. A. KEYSER --
C     Added new output real, double-precision argument array RDATA8_8 of
C     length 2 to return full-precision latitude and longitude for a
C     report.
C     BENEFIT: Although lat and lon are returned in RDATA(1:2) these are
C              at machine precison, which is normally R*4.  Now that
C              many reports in the dumps store lat/lon at 0.001 or even
C              0.00001 degree precision, and now that PREPBUFR encodes
C              YOB (lat) and XOB (lon) at 0.00001 degree precision, this
C              change will ensure that lat/lon is always accurate to
C              0.00001 degrees in all downstream processing.
C 2020-01-06  J. Dong -- In subroutine W3UNPKB7, changed the windowing
C     decade from 20 to 40 for cases when the year is represented by
C     2 digits instead of 4.
C 2020-08-20 J. DONG -- 
C     - Added processing to encode BUFR format VAD  wind (NC002018)
C       profiler wind (NC002014) tanks into prepbufr files.
C     - Defined IDSDAT to eliminate Boundary Run-Time Check Failures.
C
C
C
C USAGE:    CALL W3UNPKB7(IDATE,IHE,IHL,LUNIT,RDATA,STNID,DSNAME,
C                         RDATA2,RDATA8_8,IDSDAT,IDSDMP_8,SUBSET,SUBSKP,
C                         IRET)
C   INPUT ARGUMENT LIST:
C     IDATE    - 4-WORD ARRAY HOLDING "CENTRAL" DATE TO PROCESS
C              - (YYYY, MM, DD, HH)
C     IHE      - NUMBER OF WHOLE HOURS RELATIVE TO "IDATE" FOR DATE OF
C              - EARLIEST BUFR MESSAGE THAT IS TO BE DECODED; EARLIEST
C              - DATE IS "IDATE" + "IHE" HOURS (IF "IHE" IS POSITIVE,
C              - EARLIEST MESSAGE DATE IS AFTER "IDATE"; IF "IHE" IS
C              - NEGATIVE, EARLIEST MESSAGE DATE IS PRIOR TO "IDATE")
C              - EXAMPLE: IF IHE=1, THEN EARLIEST DATE IS 1-HR AFTER
C              - IDATE; IF IHE=-2, THEN EARLIEST DATE IS 2-HR PRIOR
C              - TO IDATE
C     IHL      - NUMBER OF WHOLE HOURS RELATIVE TO "IDATE" FOR DATE OF
C              - LATEST BUFR MESSAGE THAT IS TO BE DECODED; LATEST
C              - DATE IS "IDATE" + ("IHL" HOURS PLUS 59 MIN) IF "IHL"
C              - IS POSITIVE (LATEST MESSAGE DATE IS AFTER "IDATE"),
C              - AND "IDATE" + ("IHL"+1 HOURS MINUS 1 MIN) IF "IHL"
C              - IS NEGATIVE (LATEST MESSAGE DATE IS PRIOR TO "IDATE")
C              - EXAMPLE: IF IHL=2, THEN LATEST DATE IS 2-HR 59-MIN
C              - AFTER IDATE; IF IHL=-2, THEN LATEST DATE IS 1-HR 1-MIN
C              - PRIOR TO IDATE
C       NOTE: THERE IS NO LIMIT ON THE VALUES FOR "IHE" AND "IHL",
C              HOWEVER IF IHE IS .LE. -3 AND IHL IS .GE. +2, THEN IT
C              IS ASSUMED THAT ALL BUFR MESSAGES IN THE FILE ARE TO BE
C              PROCESSED REGARDLESS OF THEIR TIME SO IT DOESN'T MAKE
C              ANY SENSE TO SPECIFY VALUES OUTSIDE THIS RANGE.
C     LUNIT    - FORTRAN UNIT NUMBER FOR INPUT DATA FILE
C     SUBSKP   - TWO-DIMENSIONAL LOGICAL ARRAY WHERE ELEMENT 1 REFERS
C              - TO A PARTICULAR BUFR TYPE (RANGE 0-255) AND ELEMENT 2
C              - REFERS TO A PARTICULAR BUFR SUBTYPE (RANGE 0-200). IF
C              - SUBSKP IS SET TO TRUE FOR A PARTICULAR BUFR TYPE AND
C              - SUBTYPE, THEN ANY BUFR MESSAGE OF THIS TYPE READ IN
C              - WILL BE SKIPPED OVER {NO SUBSETS (REPORTS) WILL BE
C              - DECODED OUT OF IT AND RETURNED TO THE CALLING PROGRAM,
C              - INSTEAD THIS SUBROUTINE WILL MOVE ON TO READ THE NEXT
C              - BUFR MESSAGE IN THE FILE AND AGAIN USE SUBSKP TO SEE
C              - IF ANY SUBSETS SHOULD BE DECODED OUT OF IT}. THIS
C              - ALLOWS THIS SUBROUTINE TO QUICKLY PASS BY ANY BUFR
C              - MESSAGES WITH A TYPE/SUBTYPE THAT THE CALLING PROGRAM
C              - DOES NOT WANT DECODED.  THE LENGTH OF THIS ARRAY
C              - SHOULD ALWAYS BE HARDWIRED TO (0:255,0:200).
C     IRET     - CONTROLS DEGREE OF UNIT 6 PRINTOUT (.GE. 0 -LIMITED
C              - PRINTOUT; = -1 SOME ADDITIONAL DIAGNOSTIC PRINTOUT;
C              = .LT. -1 -EXTENSIVE PRINTOUT) (SEE REMARKS 3)
C
C   OUTPUT ARGUMENT LIST:
C     RDATA    - SINGLE REPORT RETURNED AN A QUASI-IW3UNPBF
C              - UNPACKED FORMAT (SEE REMARKS 5) (MINIMUM SIZE IS
C              - 1500 WORDS) (NOTE: DOES NOT INCLUDE STATION ID)
C     STNID    - CHARACTER*8 SINGLE REPORT STATION IDENTIFICATION (UP
C              - TO 8 CHARACTERS, LEFT-JUSTIFIED) (SEE REMARKS 4 FOR
C              - INFORMATION ON STRUCTURE OF GOES SOUNDING STNID)
C     DSNAME   - CHARACTER*8 DATA SET NAME (SAME FOR ALL REPORTS IN
C              - A COMMON INPUT DATA SET - SEE OUTPUT ARGUMENT LIST
C              - BELOW FOR IRET=1 CASE)
C     RDATA2   - 25-WORD ARRAY CONTAINING ADDITIONAL REPORT DATA NOT
C              - PRESENT IN RDATA ARRAY (DECODED DIRECTLY FROM BUFR)
C              - (SEE REMARKS 6 FOR CONTENT)
C     RDATA8_8 - 2-WORD REAL*8 ARRAY CONTAINING ADDITIONAL REPORT DATA
C                (LATITUDE AND LONGITUDE) (SEE REMARKS 7 FOR CONTENT)
C     IDSDAT   - INTEGER DATA SET CENTER DATE IN FORM YYYYMMDDHH (SAME
C              - FOR ALL REPORTS IN A COMMON INPUT DATA SET - SEE
C              - OUTPUT ARGUMENT LIST BELOW FOR IRET=1 CASE)
C     IDSDMP_8 - INTEGER*8 DATA SET DUMP TIME IN FORM YYYYMMDDHHMM
C              - (SAME FOR ALL REPORTS IN A COMMON INPUT DATA SET - SEE
C              - OUTPUT ARGUMENT LIST BELOW FOR IRET=1 CASE)
C     SUBSET   - CHARACTER*8 BUFR MESSAGE TYPE (SAME FOR ALL REPORTS
C              - IN A COMMON BUFR MESSAGE)
C     IRET     - RETURN CODE AS FOLLOWS:
C            =  0 OBSERVATION READ AND UNPACKED INTO OUTPUT ARGUMENT
C                 LOCATIONS (SEE ABOVE).  SEE REMARKS FOR CONTENTS.
C                 NEXT CALL TO W3UNPKB7 WILL RETURN NEXT OBSERVATION
C                 IN DATA SET.
C            =  1 INFORMATION ABOUT THE BUFR DATASET IS RETURNED IN
C                 THE OUTPUT ARGUMENTS DSNAME, IDSDAT, IDSDMP_8 (SEE
C                 OUTPUT ARGUMENT LIST ABOVE)
C
C                 THIS SHOULD ALWAYS OCCUR AFTER THE FIRST CALL TO
C                 THIS SUBROUTINE FOR A NEW UNIT NUMBER (I.E., A NEW
C                 DATA SET) OR IF THE INPUT DATE/TIME OR RANGE IN TIME
C                 HAS BEEN CHANGED FROM LAST CALL (I.E., A DATA SET
C                 IS ABOUT TO BE READ FROM THE TOP).  NO REPORT IS
C                 UNPACKED AT THIS POINT, AND ONLY DSNAME, IDSDAT, AND
C                 IDSDMP_8 CONTAIN INFORMATION.  ALL SUBSEQUENT CALLS
C                 TO W3UNPKB7 SHOULD RETURN THE OBSERVATIONS IN THIS
C                 DATA SET, SEQUENTIALLY, (IRET=0) UNTIL THE END OF
C                 FILE IS ENCOUNTERED (IRET=2).  THE VALUES STORED IN
C                 DSNAME, IDSDAT, AND IDSDMP_8 WILL CONTINUE TO BE
C                 RETURNED ALONG WITH EACH REPORT WHEN IRET = 0.
C            =  2 FOR NORMAL END-OF-FILE ENCOUNTERED.
C            =  3 LAT AND/OR LON DATA MISSING -- NO REPORT RETURNED.
C            =  4 SOME/ALL DATE INFORMATION MISSING -- NO REPORT
C                 RETURNED.
C            =  5 NO "CATEGORY" DATA LEVELS PROCESSED (ALL LEVELS ARE
C                 MISSING) -- NO REPORT RETURNED.
C            =  6 NUMBER OF LEVELS IN REPORT HEADER IS NOT 1 -- NO
C                 REPORT RETURNED.
C            =  7 NUMBER OF LEVELS IN ANOTHER SINGLE LEVEL SEQUENCE IS
C                 NOT 1 -- NO REPORT RETURNED.
C            =  8 REPORT IS A WIND PROFILER ORIGINATING FROM PILOT
C                 (PIBAL) FORMAT BULLETINS -- NO REPORT RETURNED.
C
C   INPUT FILES:
C     UNIT AA  - (WHERE AA IS LUNIT ABOVE) FILE HOLDING THE DATA
C              - IN THE FORM OF BUFR MESSAGES
C
C   OUTPUT FILES:
C     UNIT 06  - STANDARD OUTPUT PRINT
C
C   SUBPROGRAMS CALLED:
C     UNIQUE        - UNPKB701 UNPKB702 UNPKB703 UNPKB704 UNPKB705
C                   - UNPKB706 UNPKB707 UNPKB709 UNPKB710
C     LIBRARY:
C       W3NCO       - W3FI04   W3MOVDAT W3DIFDAT ERREXIT
C       BUFRLIB     - DATELEN  DUMPBF   OPENBF   READMG   UFBCNT
C                   - READSB   UFBINT   CLOSBF   NMSUB    GETBMISS
C                   - IBFMS    CBFMS    READLC   UFBREP
C
C REMARKS:
C    1) A CONDITION CODE (STOP) OF 15 WILL OCCUR IF THE INPUT DATES FOR
C       START AND/OR STOP TIME ARE SPECIFIED INCORRECTLY.
C
C
C
C    2) A CONDITION CODE (STOP) OF 22 WILL OCCUR IF THE CHARACTERS ON
C       THIS MACHINE ARE NEITHER ASCII NOR EBCDIC.
C
C
C
C    3) THE INPUT ARGUMENT "IRET" SHOULD BE SET PRIOR TO EACH CALL TO
C       THIS SUBROUTINE.
C      
C      
C      
C    4) FOR GOES SOUNDING/RADIANCE REPORTS, THE EIGHTH CHARACTER OF
C       STATION ID (stnid) IS A TAGGED AS FOLLOWS:
C          "I" - GOES-EVEN-1 (252, 256, ...) SAT. , CLEAR COLUMN  RETR.
C          "J" - GOES-EVEN-1 (252, 256, ...) SAT. , CLOUDY RETRIEVAL
C          "K" - GOES-EVEN-1 (252, 256, ...) SAT. , UNKNOWN PATH
C
C          "L" - GOES-ODD-1  (253, 257, ...) SAT. , CLEAR COLUMN  RETR.
C          "M" - GOES-ODD-1  (253, 257, ...) SAT. , CLOUDY RETRIEVAL
C          "N" - GOES-ODD-1  (253, 257, ...) SAT. , UNKNOWN PATH
C
C          "O" - GOES-EVEN-2 (254, 258, ...) SAT. , CLEAR COLUMN  RETR.
C          "P" - GOES-EVEN-2 (254, 258, ...) SAT. , CLOUDY RETRIEVAL
C          "S" - GOES-EVEN-2 (254, 258, ...) SAT. , UNKNOWN PATH
C
C          "Q" - GOES-ODD-2  (251, 255, ...) SAT. , CLEAR COLUMN  RETR.
C          "R" - GOES-ODD-2  (251, 255, ...) SAT. , CLOUDY RETRIEVAL
C          "T" - GOES-ODD-2  (251, 255, ...) SAT. , UNKNOWN PATH
C
C          "?" - SATELLITE UNKNOWN
C
C
C
C    5) CONTENTS OF AN UNPACKED REPORT IN THE "RDATA" ARRAY (MISSING
C       INTEGER DATA ARE SET TO IMISS (99999); MISSING REAL DATA ARE
C       SET TO XMISS (99999.)
C
C     (NOTE: DOES NOT INCLUDE STATION IDENTIFICATION AND "RDATA2" ARRAY
C            OUTPUT; LATITUDE AND LONGITUDE IN RDATA(1:2) ARE ALSO
C            OUTPUT IN REAL*8 IN "RDATA8_8" - SEE OUTPUT ARGUMENT
C            "STNID" ABOVE, "RDATA2" CONTENTS IN REMARKS 6. BELOW AND
C            "RDATA8_8" CONTENTS IN REMARKS 7. BELOW)
C
C   ***************************************************************
C   WORD   CONTENT                   UNIT                 FORMAT
C   ----   ----------------------    -------------------  ---------
C     1    LATITUDE                  DEGREES (N+,S-)      REAL
C     2    LONGITUDE                 DEGREES EAST         REAL
C     3    NOT USED                  MISSING              REAL
C     4    OBSERVATION TIME          HOURS (UTC)          REAL
C     5    DATE                      YYYYMMDDHH           INTEGER
C     6    SATELLITE ID      (BUFR CODE TABLE 0-01-007)   INTEGER
C                                    (SEE @)
C     7    STATION ELEVATION         METERS               REAL
C     8    INSTRUMENT TYPE           (SEE $)              INTEGER
C     9    DUMP REPORT TYPE          (SEE &)              INTEGER
C    10    DUMP REPORT SUBTYPE       MISSING              INTEGER
C    11    RECEIPT TIME              HOURS (UTC)          REAL
C    12    NOT USED                  MISSING              REAL
C
C 13-18    ZEROED OUT - NOT USED
C    19    CATEGORY  4, NO. LEVELS   COUNT                INTEGER
C    20    CATEGORY  4, DATA INDEX   COUNT                INTEGER
C 21-26    ZEROED OUT - NOT USED
C    27    CATEGORY  8, NO. LEVELS   COUNT                INTEGER
C    28    CATEGORY  8, DATA INDEX   COUNT                INTEGER
C 29-34    ZEROED OUT - NOT USED                          INTEGER
C    35    CATEGORY 10, NO. LEVELS   COUNT                INTEGER
C    36    CATEGORY 10, DATA INDEX   COUNT                INTEGER
C    37    CATEGORY 11, NO. LEVELS   COUNT                INTEGER
C    38    CATEGORY 11, DATA INDEX   COUNT                INTEGER
C    39    CATEGORY 12, NO. LEVELS   COUNT                INTEGER
C    40    CATEGORY 12, DATA INDEX   COUNT                INTEGER
C    41    CATEGORY 13, NO. LEVELS   COUNT                INTEGER
C    42    CATEGORY 13, DATA INDEX   COUNT                INTEGER
C    43    CATEGORY 14, NO. LEVELS   COUNT                INTEGER
C    44    CATEGORY 14, DATA INDEX   COUNT                INTEGER
C    45    CATEGORY 15, NO. LEVELS   COUNT                INTEGER
C    46    CATEGORY 15, DATA INDEX   COUNT                INTEGER
C 47-52    ZEROED OUT - NOT USED                          INTEGER
C
C 53-END   UNPACKED DATA GROUPS      (SEE BELOW)          MIXED
C
C    @ - WORD  6, SATELLITE ID, IS CURRENTLY SET TO MISSING FOR
C         ALL TYPES EXCEPT:
C             GOES SOUNDING/RADIANCE                 (DUMP RPT TYPE 061)
C             ERS SCATTEROMETER                      (DUMP RPT TYPE 581)
C             QUIKSCAT SCATTEROMETER                 (DUMP RPT TYPE 582)
C             WINDSAT SCATTEROMETER (NAVY or NESDIS) (DUMP RPT TYPE 583)
C             ASCAT SCATTEROMETER                    (DUMP RPT TYPE 584)
C
C    $ - WORD  8, INSTRUMENT TYPE, IS CURRENTLY SET TO MISSING FOR
C         ALL TYPES EXCEPT:
C             GOES SOUNDING/RADIANCE (DUMP REPORT TYPE 061)
C               Processing technique
C                  21       Clear
C                  23       Cloudy
C
C    & - DUMP REPORT TYPES:
C          061 - GOES sounding/radiance
C          071 - NOAA Profiler Network (NPN) wind
C          072 - NEXRAD (VAD) wind (from both Radar Coded Message and
C                from Level 2 decoder)
C          074 - GPS-IPW
C          075 - Cooperative Agency Profiler (CAP) wind
C          076 - Japanese Meteological Agency (JMA) profiler wind
C          077 - NOAA Profiler Network (NPN) or Cooperative Agency
C                Profiler (CAP) RASS temperature
C          581 - ERS scatterometer
C          582 - QuikSCAT scatterometer
C          583 - WindSat scatterometer (NAVY or NESDIS)
C          584 - ASCAT scatterometer
C
C   ***************************************************************
C
C     DATA ARE UNPACKED INTO FIXED LOCATIONS IN WORDS 1-12 AND INTO
C     INDEXED LOCATIONS IN WORD 53 AND FOLLOWING.  EACH LEVEL IN
C     THE INPUT BUFR REPORT IS STORED IN THE "DATA LEVEL CATEGORIES"
C     DESCRIBED BELOW, BASED ON THE TYPE OF DATA.  EACH DATA LEVEL
C     CATEGORY HAS A LAYOUT IN LOCATIONS IN ARRAY RDATA THAT MAY BE
C     FOUND BY USING THE CORRESPONDING INDEX AMOUNT FROM WORDS 14,
C     16, ..., 46, IN ARRAY RDATA.  FOR INSTANCE, IF A REPORT IS
C     UNPACKED INTO ONE OR MORE CATEGORY 4 DATA LEVEL GROUPS (WIND
C     DATA AT VARIABLE HEIGHT LEVELS) THAT DATA WILL BE SPECIFIED IN
C     THE UNPACKED BINARY FORMAT AS DESCRIBED BELOW UNDER DATA LEVEL
C     CATEGORY 4.  THE NUMBER OF LEVELS WILL BE STORED IN WORD
C     19 OF OBS AND THE INDEX OF THE FIRST LEVEL OF UNPACKED DATA IN
C     THE OUTPUT ARRAY WILL BE STORED IN WORD 20.  THE SECOND LEVEL,
C     IF ANY, WILL BE STORED BEGINNING FIVE WORDS FURTHER ON, AND SO
C     FORTH UNTIL THE COUNT IN WORD 19 IS EXHAUSTED.  THE FIELD
C     LAYOUT IN EACH DATA LEVEL CATEGORY IS GIVEN BELOW...
C
C
C     DATA LEVEL CATEGORY 4 - WINDS AT VARIABLE HEIGHTS (FIRST LEVEL
C                             IS SURFACE) (EACH LEVEL, SEE WORD 19
C                             ABOVE)
C      (Currently used only by VAD wind reports)
C
C     WORD   PARAMETER            UNITS               FORMAT
C     ----   ---------            -----------------   -------------
C       1    HEIGHT ABOVE SEA     METERS              REAL
C            LEVEL
C       2    HORIZONTAL WIND      DEGREES             REAL
C            DIRECTION (VAD FROM RADAR CODED MESSAGE)
C            U-COMPONENT WIND     METERS/SEC          REAL
C            (VAD FROM LEVEL 2 DECODER)
C       3    HORIZONTAL WIND      0.1 METERS/SEC      REAL
C            SPEED (VAD FROM RADAR CODED MESSAGE)
C            V-COMPONENT WIND     METERS/SEC          REAL
C            (VAD FROM LEVEL 2 DECODER)
C       4    QUALITY MARKER FOR   (hardwired to 2.)   REAL
C            HEIGHT
C       5    QUALITY MARKER FOR   (SEE %)             REAL
C            WIND
C
C  %-  VALUES FROM 1-7 INDICATE A "CONFIDENCE LEVEL" WHICH IS RELATED
C       TO THE ROOT-MEAN-SQUARE VECTOR ERROR FOR THE HORIZONTAL WIND.
C       IT IS DEFINED AS FOLLOWS:
C                1.0  = RMS OF  1.9 KNOTS
C                2.0  = RMS OF  3.9 KNOTS
C                3.0  = RMS OF  5.8 KNOTS
C                4.0  = RMS OF  7.8 KNOTS (DEFAULT)
C                5.0  = RMS OF  9.7 KNOTS
C                6.0  = RMS OF 11.7 KNOTS
C                7.0  = RMS  > 13.6 KNOTS
C      VALUE 12 INDICATES THE WIND IS FLAGGED DUE TO ITS BEING ON THE
C               REJECT LIST
C      VALUE 14 INDICATES THE WIND IS FLAGGED DUE TO ITS BEING PURGED
C               MANUALLY BY THE NCEP SDM
C
C
C     DATA LEVEL CATEGORY 10 - SURFACE LEVEL (EACH LEVEL, SEE WORD 35
C                              ABOVE)
C      (Currently used by wind profiler, ERS scatterometer, QuikSCAT
C       scatterometer, WindSat scatterometer and ASCAT scatterometer
C       reports)
C
C     WORD   PARAMETER            UNITS               FORMAT
C     ----   ---------            -----------------   -------------
C       1    SEA-LEVEL PRESSURE   0.1 MILLIBARS       REAL
C       2    STATION PRESSURE     0.1 MILLIBARS       REAL
C       3    HORIZ. WIND DIR.     DEGREES             REAL
C       4    HORIZ. WIND SPEED    0.1 METERS/SEC      REAL
C       5    AIR TEMPERATURE      0.1 KELVIN          REAL
C       6    RELATIVE HUMIDITY    PERCENT             REAL
C       7    RAINFALL RATE        KG/((METER**2)*SEC) REAL
C
C  Note: For wind profiler, word 2 always missing; words 1, 3-7
C         no longer available after 5/2002 (missing)
C        For ERS, QuikSCAT and ASCAT scatterometer, words 1,2, 5-7
C         always missing
C        For WindSat scatterometer, words 1,2, 5-6 always missing
C
C
C     DATA LEVEL CATEGORY 11 - UPPER-AIR LEVEL (FIRST LEVEL IS SURFACE)
C                              (EACH LEVEL, SEE WORD 37 ABOVE)
C      (Currently used only by wind profiler reports)
C
C     WORD   PARAMETER            UNITS               FORMAT
C     ----   ---------            -----------------   -------------
C       1    HEIGHT ABOVE SEA-LVL METERS              REAL
C       2    HORIZ. WIND DIR.     DEGREES             REAL
C       3    HORIZ. WIND SPEED    0.1 METERS/SEC      REAL
C       4    QUALITY CODE         (SEE %)             INTEGER
C       5    VERT. WIND COMP. (W) 0.01 METERS/SEC     REAL
C(SEE @)6    HORIZ. CONSENSUS NO. (SEE $)             INTEGER
C(SEE @)7    VERT.  CONSENSUS NO. (SEE $)             INTEGER
C       8 - NOAA Profiler Network (NPN) and Cooperative Agency (CAP):
C    (SEE @) SPECTRAL PEAK POWER  DB                  REAL
C         - Japanese:
C            SIG-TO-NOISE RATIO   DB                  REAL
C       9    HORIZ. WIND SPEED    0.1 METERS/SEC      REAL
C            STANDARD DEVIATION
C      10    VERT. WIND COMPONENT 0.1 METERS/SEC      REAL
C            STANDARD DEVIATION
C(SEE @)11   MODE                 (SEE #)             INTEGER
C
C  *-  ALWAYS MISSING
C  %-  0 - MEDIAN AND SHEAR CHECKS BOTH PASSED (NPN and CAP)
C        - DATA NOT SUSPECT (JAPANESE)
C      1 - DATA SUSPECT (JAPANESE)
C      2 - MEDIAN AND SHEAR CHECK RESULTS INCONCLUSIVE (NPN and CAP)
C      3 - QUALITY INFORMATION NOT GIVEN (JAPANESE)
C      4 - MEDIAN CHECK PASSED; SHEAR CHECK FAILED (NPN and CAP)
C      8 - MEDIAN CHECK FAILED; SHEAR CHECK PASSED (NPN and CAP)
C     12 - MEDIAN AND SHEAR CHECKS BOTH FAILED (NPN and CAP)
C     14 - THE WIND IS FLAGGED DUE TO EITHER:
C               BEING ON THE REJECT LIST, OR
C               BEING PURGED MANUALLY BY THE NCEP SDM
C  $-  NO. OF INDIVIDUAL 6-MINUTE AVERAGE MEASUREMENTS THAT WERE
C      INCLUDED IN FINAL ESTIMATE OF AVERAGED WIND (RANGE: 0, 2-10)
C      (BASED ON A ONE-HOUR AVERAGE)
C  #-  1 - DATA FROM LOW MODE
C      2 - DATA FROM HIGH MODE
C      3 - MISSING
C  @-  THIS PARAMETER IS NO LONGER AVAILABLE AFTER 5/2002 AND IS SET
C      TO MISSING
C
C
C     DATA LEVEL CATEGORY 12 - SATELLITE SOUNDING LEVEL (FIRST LEVEL IS
C                              SURFACE) (EACH LEVEL, SEE WORD 39 ABOVE)
C      (Currently used only by GOES sounding/radiance reports)
C
C     WORD   PARAMETER            UNITS               FORMAT
C     ----   ---------            -----------------   -------------
C       1    PRESSURE             0.1 MILLIBARS       REAL
C       2    GEOPOTENTIAL         METERS              REAL
C       3    TEMPERATURE          0.1 DEGREES C       REAL
C       4    DEWPOINT TEMPERATURE 0.1 DEGREES C       REAL
C       5    NOT USED             SET TO MISSING      REAL
C       6    NOT USED             SET TO MISSING      REAL
C       7    Q.M. FOR GEOPOT      (SEE &)             REAL
C       8    Q.M. FOR TEMPERATURE (SEE &)             REAL
C       9    Q.M. FOR DEWPT TEMP  (SEE &)             REAL
C
C  &-  2.0 - INDICATES DATA NOT SUSPECT
C      3.0 - INDICATES DATA ARE SUSPECT
C     13.0 - INDICATES DATA ARE BAD
C
C
C     DATA LEVEL CATEGORY 13 - SATELLITE RADIANCE "LEVEL" (EACH
C                              "LEVEL", SEE WORD 41 ABOVE)
C      (Currently used only by GOES sounding/radiance reports)
C
C     WORD   PARAMETER            UNITS               FORMAT
C     ----   ---------            -----------------   -------------
C       1    CHANNEL NUMBER       NUMERIC             INTEGER
C       2    BRIGHTNESS TEMP.     KELVIN              REAL
C       3    Q.M. FOR BTEMP       (SEE &)             REAL
C
C  &-  2.0 - INDICATES DATA NOT SUSPECT
C      3.0 - INDICATES DATA ARE SUSPECT
C     13.0 - INDICATES DATA ARE BAD
C
C
C     DATA LEVEL CATEGORY 14 - GPS-IPW DATA (FIRST LEVEL IS SURFACE)
C                              (EACH LEVEL, SEE WORD 43 ABOVE)
C      (Currently used only by GPS-IPW reports)
C
C     WORD   PARAMETER            UNITS               FORMAT
C     ----   ---------            -----------------   -------------
C       1    STATION PRESSURE     MILLIBARS           REAL
C       2    AIR TEMPERATURE      KELVIN              REAL
C       3    RELATIVE HUMIDITY    PERCENT             REAL
C       4    TOTAL PRECIP. WATER  MILLIMETERS         REAL
C       5    ZENITH TOTAL DELAY   METERS              REAL
C       6    ERROR IN ZENITH      METERS              REAL
C            TOTAL DELAY
C       7    HYDROSTATIC DELAY    METERS              REAL
C       8    ERROR IN HYDROSTATIC METERS              REAL
C            DELAY
C       9    WEIGHTED MEAN        KELVIN              REAL
C            TEMPERATURE
C      10    WET DELAY MAPPING    NUMERIC             REAL
C            FUNCTION    
C
C
C     DATA LEVEL CATEGORY 15 - RASS DATA (FIRST LEVEL IS SURFACE)
C                              (EACH LEVEL, SEE WORD 45 ABOVE)
C      (Currently used only by RASS reports)
C
C     WORD   PARAMETER            UNITS               FORMAT
C     ----   ---------            -----------------   -------------
C       1    HEIGHT ABOVE SEA-LVL METERS              REAL
C       2    VIRTUAL TEMPERATURE  KELVIN              REAL
C       3    QUALITY CODE         (SEE %)             INTEGER
C
C  %-  0 - MEDIAN AND SHEAR CHECKS BOTH PASSED
C      2 - MEDIAN AND SHEAR CHECK RESULTS INCONCLUSIVE
C      4 - MEDIAN CHECK PASSED; SHEAR CHECK FAILED
C      8 - MEDIAN CHECK FAILED; SHEAR CHECK PASSED
C     12 - MEDIAN AND SHEAR CHECKS BOTH FAILED
C     14 - THE WIND IS FLAGGED DUE TO EITHER:
C               BEING ON THE REJECT LIST, OR
C               BEING PURGED MANUALLY BY THE NCEP SDM
C
C
C     DATA LEVEL CATEGORY 08 - ADDITIONAL (MISCELLANEOUS) DATA (EACH
C                              "LEVEL", SEE @ BELOW)
C      (Currently used only by GOES sounding/radiance reports)
C
C     WORD   PARAMETER            UNITS               FORMAT
C     ----   ---------            -----------------   -------------
C       1    VARIABLE             (SEE @)             REAL
C       2    CODE FIGURE          (SEE @)             REAL
C       3    Q.M. FOR THE DATUM   (SEE &)             REAL
C       4    NOT USED                                 REAL
C
C  @-  NUMBER OF "LEVELS" FROM WORD 27.  MAXIMUM IS "ILVLMX_08"
C       (CURRENTLY SET TO 13), AND ARE ORDERED AS FOLLOWS (IF A DATUM
C        ARE MISSING THAT LEVEL NOT STORED)
C           1 - LIFTED INDEX ---------- KELVIN ----------- C. FIG. 250.
C           2 - TOTAL PRECIP. WATER  -- MILLIMETERS ------ C. FIG. 251.
C           3 - 1. TO .9 SIGMA P.WATER- MILLIMETERS ------ C. FIG. 252.
C           4 - .9 TO .7 SIGMA P.WATER- MILLIMETERS ------ C. FIG. 253.
C           5 - .7 TO .3 SIGMA P.WATER- MILLIMETERS ------ C. FIG. 254.
C           6 -  SKIN TEMPERATURE ----- KELVIN ----------- C. FIG. 255.
C           7 -  CLOUD TOP TEMPERATURE- KELVIN ----------- C. FIG. 256.
C           8 -  CLOUD TOP PRESSURE --- MILLIBARS -------- C. FIG. 257.
C           9 -  CLOUD AMOUNT (BUFR TBL. C.T. 0-20-011) -- C. FIG. 258.
C          10 -  INSTR. DATA USED IN PROC.
C                             (BUFR TBL. C.T. 0-02-021) -- C. FIG. 259.
C          11 -  SOLAR ZENITH ANGLE --- DEGREE ----------- C. FIG. 260.
C          12 -  SAT. ZENITH ANGLE ---- DEGREE ----------- C. FIG. 261.
C          13 -  SURFACE PRESSURE ----- MILLIBARS -------- C. FIG. 262.
C
C  &-  2.0 - INDICATES DATA NOT SUSPECT
C      3.0 - INDICATES DATA ARE SUSPECT
C     13.0 - INDICATES DATA ARE BAD
C
C
C
C    6) CONTENTS OF AN UNPACKED REPORT IN THE "RDATA2" ARRAY (DECODED
C       DIRECTLY FROM BUFR, ALL VALUES ARE IN REAL FORMAT; MISSING DATA
C       ARE SET TO "BMISS", AS IN BUFR)
C
C   WORD   CONTENT                                  BUFR FXY UNIT
C   ----   ---------------------------------------- -------- ----------
C     1    TIME SIGNIFICANCE                        0-08-021 CODE TABLE
C     2    TOTAL NUMBER (WITH RESPECT TO            0-08-022 NUMERIC
C          ACCUMULATION OR AVERAGE) (i.e., F-O-V
C          number for GOES sounding/radiance; # of
C          orig. reports used to generate superob
C          for QuikSCAT, WindSAT and ASCAT - for
C          non-superobs, hardwired to 1)
C     3    ACROSS-SWATH CELL NUMBER                 0-06-034 NUMERIC
C     4    ALONG-TRACK ROW NUMBER                   0-05-034 NUMERIC
C     5    WIND PROFILER SUBMODE INFORMATION        0-25-033 CODE TABLE
C            Note: Submode is missing after 5/2002
C                  (no longer available)
C     6    TIME PERIOD OR DISPLACEMENT              0-04-025 MINUTE
C            (i.e., AVERAGING TIME)
C            Note: A negative number means prior to
C                  observation time
C     7    QUALITY INFORMATION                      0-33-002 CODE TABLE
C     8    SEAWINDS PROBABILITY OF RAIN             0-21-120 NUMERIC
C
C     9    SEA SURFACE TEMPERATURE                  0-22-043 KELVIN
C    10    TOTAL WATER VAPOR                        0-13-096 KG/METER**2
C    11    TOTAL CLOUD LIQUID WATER                 0-13-097 KG/METER**2
C    12    WINDSAT SURFACE TYPE                     0-20-219 CODE TABLE
C    13    MODEL WIND DIRECTION AT 10 METERS        0-11-081 DEGREES
C    14    MODEL WIND SPEED AT 10 METERS            0-11-082 METERS/SEC
C    15    WINDSAT EDR Q.C. FLAG # 1                0-33-200 FLAG TABLE
C    16    CHI-SQUARED (OF THE WIND VECTOR          0-33-199 NUMERIC
C          RETRIEVAL)
C    17    ESTIMATED ERROR COVARIANCE FOR WIND      0-33-201 DEGREES
C          DIRECTION RETRIEVAL
C    18    ESTIMATED ERROR COVARIANCE FOR WIND      0-33-246 METERS/SEC
C          SPEED RETRIEVAL
C    19    ESTIMATED ERROR COVARIANCE FOR SEA       0-33-245 KELVIN
C          SURFACE TEMPERATURE RETRIEVAL
C    20    ESTIMATED ERROR COVARIANCE FOR TOTAL     0-33-248 KG/METER**2
C          CLOUD LIQUID WATER RETRIEVAL
C    21    ESTIMATED ERROR COVARIANCE FOR TOTAL     0-33-247 KG/METER**2
C          WATER VAPOR RETRIEVAL
C    22    WIND VECTOR CELL QUALITY                 0-21-155 FLAG TABLE
C    23    BACKSCATTER DISTANCE                     0-21-156 NUMERIC
C    24    LIKELIHOOD COMPUTED FOR SOLUTION         0-21-104 NUMERIC
C    25    TOTAL CLOUD COVER                        0-21-010 PERCENT
C
C
C
C    7) CONTENTS OF AN UNPACKED REPORT IN THE "RDATA8_8" ARRAY
C       (ALL VALUES ARE IN REAL*8`FORMAT; MISSING DATA ARE SET TO
C        "BMISS")
C
C   WORD   CONTENT                            UNIT
C   ----   --------------------------------   -------------------
C     1    LATITUDE                           DEGREES (N+,S-)
C     2    LONGITUDE                          DEGREES (E+,W-)
C
C
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE:  NCEP WCOSS
C
C$$$
      SUBROUTINE W3UNPKB7(IDATE,IHE,IHL,LUNIT,RDATA,STNID,DSNAME,RDATA2,
     $ rdata8_8,IDSDAT,IDSDMP_8,SUBSET,SUBSKP,IRET)

C  Include parameters common to more than one subroutine
C  -----------------------------------------------------

      include 'inc_w3unpkb7.inc'

      CHARACTER*8 STNID,SUBSET,DSNAME,CBUFR

      REAL        RINC_O(5),RINC_I(5),RDATA2(25),RDATA(*),RDATX(IDMAX)
      REAL(8)     RDATA2_8(25),rdata8_8(2)
      REAL(8)     BMISS,GETBMISS

      INTEGER     IDATE(4),LSDATE(4),IDATA(IDMAX),JDATE(8)
      INTEGER(8)  IDSDAT,IDSDMP_8,IDDATE_8(5)

      LOGICAL     SUBSKP(0:255,0:200),SKIP_CAT12

      COMMON /PKB7AA/BMISS
      COMMON /PKB7BB/KDATE(8),LDATE(8),KTIMCH,IPRINT,SKIP_CAT12
      COMMON /PKB7CC/INDEX
      COMMON /PKB7DD/LSHE,LSHL,ICDATE(5),IDDATE(5)
      COMMON /PKB7FF/IFOV(4,2),KNTSAT(250:260)
      COMMON /PKB7HH/NPRINT(0:255,0:200)

      SAVE
 
      EQUIVALENCE (RDATX,IDATA)

      DATA ITM/0/,LUNITL/-99/

      IF(IRET.LT.0)  IPRINT = IABS(IRET)
      IRET = 0
      IF(ITM.EQ.0)  THEN
C-----------------------------------------------------------------------

C FIRST AND ONLY TIME INTO THIS SUBROUTINE DO A FEW THINGS....

         ITM = 1
         IFOV = 0
         KNTSAT = 0
C DETERMINE MACHINE WORD LENGTH IN BYTES AND TYPE OF CHARACTER SET
C  {ASCII(ICHTP=0) OR EBCDIC(ICHTP=1)}
         CALL W3FI04(IENDN,ICHTP,LW)
         PRINT 2213, LW, ICHTP, IENDN
 2213    FORMAT(/' ---> W3UNPKB7: CALL TO W3FI04 RETURNS: LW = ',I3,
     $    ', ICHTP = ',I3,', IENDN = ',I3/)
         IF(ICHTP.GT.1)  THEN
C CHARACTERS ON THIS MACHINE ARE NEITHER ASCII OR EBCDIC!! -- STOP 22
            PRINT 217
  217       FORMAT(' *** W3UNPKB7 ERROR: CHARACTERS ON THIS MACHINE ',
     $       'ARE NEITHER ASCII NOR EBCDIC - STOP 22'/)
            CALL ERREXIT(22)
         END IF
         IDAT10 = 1000000*IDATE(1)+10000*IDATE(2)+100*IDATE(3)+IDATE(4)
         SKIP_CAT12 = IDAT10.GE.2013022512
C-----------------------------------------------------------------------
      END IF
      IF(LUNIT.NE.LUNITL)  THEN
C-----------------------------------------------------------------------

C IF THE INPUT DATA UNIT NUMBER ARGUMENT IS DIFFERENT THAN THE LAST TIME
C  THIS SUBR. WAS CALLED, PRINT NEW HEADER, SET JRET = 1

         LUNITL = LUNIT
         JRET = 1
         PRINT 101, LUNIT
  101    FORMAT(//' ---> W3UNPKB7: WCOSS VERSION 01/06/2020: NCEP ',
     $    'BUFR DATA SET READ FROM UNIT ',I4/)

         BMISS = GETBMISS()
         print'(1X)'
         print'(" BUFRLIB value for missing passed into W3UNPKB7 is: ",
     $    G0)', bmiss
         print'(1X)'
         IF(IPRINT.GE.1)  THEN
            print *, 'IDATS= ',IDATS
            print *, 'ILVLMX_04= ',ILVLMX_04
            print *, 'ILVLMX_08= ',ILVLMX_08
            print *, 'ILVL_10  = ',ILVL_10
            print *, 'ILVLMX_11= ',ILVLMX_11
            print *, 'ILVLMX_12= ',ILVLMX_12
            print *, 'ILVLMX_13= ',ILVLMX_13
            print *, 'ILVL_14  = ',ILVL_14
            print *, 'ILVLMX_15= ',ILVLMX_15
            print *, 'IDMAX_VAD= ',IDMAX_VAD
            print *, 'IDMAX_PROF= ',IDMAX_PROF
            print *, 'IDMAX_SCAT= ',IDMAX_SCAT
            print *, 'IDMAX_GOES= ',IDMAX_GOES
            print *, 'IDMAX_GPS= ',IDMAX_GPS
            print *, 'IDMAX_RASS= ',IDMAX_RASS
            print *, 'IDMAX= ',IDMAX
         END IF

C-----------------------------------------------------------------------
      ELSE

C FOR SUBSEQUENT TIMES INTO THIS SUBR. W/ SAME LUNIT AS LAST TIME,
C  TEST INPUT DATE & HR RANGE ARGUMENTS AGAINST THEIR VALUES THE LAST
C  TIME SUBR. CALLED -- IF THEY ARE DIFFERENT, SET JRET = 1 (ELSE
C  JRET = 0), WILL TEST JRET SOON

         JRET = 1
         DO I = 4,1,-1
            IF(IDATE(I).NE.LSDATE(I))  GO TO 88
         ENDDO
         IF(IHE.NE.LSHE.OR.IHL.NE.LSHL)  GO TO 88
         JRET = 0
   88    CONTINUE
C-----------------------------------------------------------------------
      END IF
      IF(JRET.EQ.1)  THEN
         PRINT 6680
 6680 FORMAT(/' JRET = 1 - REWIND DATA FILE & SET-UP TO DO DATE CHECK'/)
C-----------------------------------------------------------------------

C COME HERE IF FIRST CALL TO SUBROUTINE OR IF INPUT DATA UNIT NUMBER OR
C  IF INPUT DATE/TIME OR RANGE IN TIME HAS BEEN CHANGED FROM LAST CALL
 
C           CLOSE BUFR DATA SET (IN CASE OPEN FROM PREVIOUS RUN)
C                     REWIND INPUT BUFR DATA SET

C          TEST THAT THE DATA SET IS NOT-NULL AND THAT IT IS BUFR

C         GET CENTER TIME, DUMP TIME, AND DATA SET NAME FOR RETURN

C                          OPEN BUFR DATA SET

C        SET INDEX=0, FORCES THE NEXT CALL TO THIS SUBROUTINE TO
C         READ IN A BUFR MESSAGE BEFORE ANY REPORTS ARE DECODED)

C     SET-UP TO DETERMINE IF BUFR MESSAGE IS WITHIN REQUESTED DATES

C       RETURN WITH IRET = 1 (NO REPORTS RETURNED UNTIL NEXT CALL)

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

         CALL CLOSBF(LUNIT)

         REWIND LUNIT

         READ(LUNIT,END=9999,ERR=8888,FMT='(A8)') CBUFR
         IF(CBUFR(1:4).EQ.'BUFR') THEN
C COME HERE IF UNBLOCKED BUFR FILE IS INPUT
            PRINT'(" W3UNPKB7 - INPUT FILE ON UNIT ",I0, " IS",
     $      " UNBLOCKED NCEP BUFR"/)', LUNIT
         ELSE  IF(CBUFR(5:8).EQ.'BUFR') THEN
C COME HERE IF BLOCKED BUFR FILE IS INPUT
            PRINT'(" W3UNPKB7 - INPUT FILE ON UNIT ",I0, " IS",
     $      " BLOCKED NCEP BUFR"/)', LUNIT
         ELSE
C COME HERE IF NON-BUFR FILE IS INPUT - RETURN WITH IRET = 2
            PRINT 8764, LUNIT
 8764 FORMAT(' *** W3UNPKB7 ERROR: INPUT FILE ON UNIT  ',I2,'  IS ',
     $ 'NOT BUFR -- ALL DONE WITH THIS FILE (IRET = 2)')
            GO TO 9998
         END IF

         CALL DATELEN(10)

         CALL DUMPBF(LUNIT,ICDATE,IDDATE)
         print'(" CENTER DATE (ICDATE) = ",5(I0,1X))', icdate
         print'(" DUMP DATE (IDDATE)   = ",5(I0,1X))', iddate

         IF(ICDATE(1).LE.0)  THEN
C COME HERE IF CENTER DATE COULD NOT BE READ FROM FIRST DUMMY MESSAGE
C  - RETURN WITH IRET = 2
            PRINT'(" *** W3UNPKB7 ERROR: CENTER DATE COULD NOT BE ",
     $       "OBTAINED FROM INPUT FILE ON UNIT ",I0)', LUNIT
            GO TO 9998
         END IF
         IF(IDDATE(1).LE.0)  THEN
C COME HERE IF DUMP DATE COULD NOT BE READ FROM SECOND DUMMY MESSAGE
C  - RETURN WITH IRET = 2
            PRINT'(" *** W3UNPKB7 ERROR: DUMP DATE COULD NOT BE ",
     $       "OBTAINED FROM INPUT FILE ON UNIT ",I0)', LUNIT
            GO TO 9998
         END IF
         IF(ICDATE(1).LT.100)  THEN

C IF 2-DIGIT YEAR RETURNED IN ICDATE(1), MUST USE "WINDOWING" TECHNIQUE
C  TO CREATE A 4-DIGIT YEAR

C IMPORTANT: IF DATELEN(10) IS CALLED, THE DATE HERE SHOULD ALWAYS
C            CONTAIN A 4-DIGIT YEAR, EVEN IF INPUT FILE IS NOT
C            Y2K COMPLIANT (BUFRLIB DOES THE WINDOWING HERE)

            PRINT'(" ##W3UNPKB7 - THE FOLLOWING SHOULD NEVER ",
     $       "HAPPEN!!!!!")'
            PRINT'(" ##W3UNPKB7 - 2-DIGIT YEAR IN ICDATE(1) RETURNED ",
     $       "FROM DUMPBF (ICDATE IS: ",I5,4I3.2,") - USE WINDOWING ",
     $       "TECHNIQUE TO OBTAIN 4-DIGIT YEAR")', ICDATE
C IF ICDATE=41~99 THEN ICDATE=1941~1999
C IF ICDATE=00~40 THEN ICDATE=2000~2040
            IF(ICDATE(1).GT.40)  THEN
               ICDATE(1) = 1900 + ICDATE(1)
            ELSE
               ICDATE(1) = 2000 + ICDATE(1)
            ENDIF
            PRINT'(" ##W3UNPKB7 - CORRECTED ICDATE(1) WITH 4-DIGIT ",
     $       "YEAR, ICDATE NOW IS: ",I5,4I3.2)', ICDATE
         ENDIF
         IDSDAT = ICDATE(1)*1000000+ICDATE(2)*10000+ICDATE(3)*100+
     $    ICDATE(4)

         IF(IDDATE(1).LT.100)  THEN

C IF 2-DIGIT YEAR RETURNED IN IDDATE(1), MUST USE "WINDOWING" TECHNIQUE
C  TO CREATE A 4-DIGIT YEAR

C IMPORTANT: IF DATELEN(10) IS CALLED, THE DATE HERE SHOULD ALWAYS
C            CONTAIN A 4-DIGIT YEAR, EVEN IF INPUT FILE IS NOT
C            Y2K COMPLIANT (BUFRLIB DOES THE WINDOWING HERE)

            PRINT'(" ##W3UNPKB7 - THE FOLLOWING SHOULD NEVER ",
     $       "HAPPEN!!!!!")'
            PRINT'(" ##W3UNPKB7 - 2-DIGIT YEAR IN IDDATE(1) RETURNED ",
     $       "FROM DUMPBF (IDDATE IS: ",I5,4I3.2,") - USE WINDOWING ",
     $       "TECHNIQUE TO OBTAIN 4-DIGIT YEAR")', IDDATE
C IF IDDATE=41~99 THEN IDDATE=1941~1999
C IF IDDATE=00~40 THEN IDDATE=2000~2040
            IF(IDDATE(1).GT.40)  THEN
               IDDATE(1) = 1900 + IDDATE(1)
            ELSE
               IDDATE(1) = 2000 + IDDATE(1)
            ENDIF
            PRINT'(" ##W3UNPKB7 - CORRECTED IDDATE(1) WITH 4-DIGIT ",
     $       "YEAR, IDDATE NOW IS: ",I5,4I3.2)', IDDATE
         END IF
         IDDATE_8 = IDDATE
         IDSDMP_8 = IDDATE_8(1)*100000000+IDDATE_8(2)*1000000+
     $    IDDATE_8(3)*10000+IDDATE_8(4)*100+IDDATE_8(5)
 
C  OPEN BUFR FILE - READ IN DICTIONARY MESSAGES (TABLE A, B, D ENTRIES)
 
         CALL OPENBF(LUNIT,'IN',LUNIT)
         PRINT 100, LUNIT
  100    FORMAT(/5X,'===> BUFR DATA SET IN UNIT',I3,' SUCCESSFULLY ',
     $    'OPENED FOR INPUT; DCTNY MESSAGES CONTAIN BUFR TABLES A,B,D'/)
 
c.......................................................................
C This next call, I believe, is needed only because SUBSET is not
C  returned in DUMPBF and we need it in order to return dsname -
C  after dsname is retrieved then close and reopen data set ..
 
         call readmg(lunit,subset,ibdate,kret)
         if(subset.eq.'NC002007' .or. subset.eq.'NC002009' .or. 
     $      subset.eq.'NC002011' .or. subset.eq.'NC002013' .or.
     $      subset.eq.'NC002014' )  then
            dsname = 'PROFLR  '
         else  if(subset.eq.'NC002008' .or. subset.EQ.'NC002017' .or.
     $            subset.EQ.'NC002018' )  then
            dsname = 'VADWND  '
         else  if(subset.EQ.'NC003001' .or. subset.EQ.'NC003002')  then
            dsname = 'GOESND  '
         else  if(subset.EQ.'NC003003')  then
            dsname = 'GOESFV  '
         else  if(subset.EQ.'NC012008')  then
            dsname = 'ERS1DA  '
         else  if(subset.EQ.'NC012137')  then
            dsname = 'QKSWND  '
         else  if(subset.EQ.'NC012003' .or. subset.EQ.'NC012004')  then
            dsname = 'GPSIPW  '
         else  if(subset.EQ.'NC002012')  then
            dsname = 'RASSDA  '
         else  if(subset.EQ.'NC012138' .or. subset.EQ.'NC012139')  then
            dsname = 'WDSATR  '
         else  if(subset.EQ.'NC012122')  then
            dsname = 'ASCATW  '
         else
            dsname = '????????'
         end if
         call closbf(lunit)
         call openbf(lunit,'IN',lunit)
ccccc    CALL OPENBF(0,'QUIET',1) ! will generate diagnostic print if
ccccc                             ! an embedded BUFR table is read
c.......................................................................

         INDEX = 0
         JDATE(1:3) = IDATE(1:3)
         JDATE(4) = 0
         JDATE(5) = IDATE(4)
         JDATE(6:8) = 0
         PRINT 6681, IDATE
 6681 FORMAT(/' %%% REQUESTED "CENTRAL" DATE IS :',I5,3I3,'  0'/)

         IF(IHE.LE.-3.AND.IHL.GE.2)  THEN
            KTIMCH = 0
            PRINT 6998
 6998 FORMAT(/' --> W3UNPKB7: THERE IS NO TIME WINDOW CONSTRAINT FOR ',
     $ 'ACCEPTING BUFR MESSAGES'/)
            KDATE = 0
            LDATE = 0
         ELSE
            KTIMCH    = 1
            RINC_I    = 0.
            RINC_I(2) = REAL(IHE)
C DETERMINE EARLIEST DATE FOR ACCEPTING BUFR MESSAGES FOR DECODING
            CALL W3MOVDAT(RINC_I,JDATE,KDATE)
            PRINT 6682, (KDATE(I),I=1,3),KDATE(5),KDATE(6)
 6682 FORMAT(/' --> EARLIEST DATE FOR ACCEPTING BUFR MSGS IS:',I5,4I3/)
C DETERMINE LATEST   DATE FOR ACCEPTING BUFR MESSAGES FOR DECODING
            IF(IHL.GE.0)  THEN
              XMINL = (IHL * 60) + 59
            ELSE
              XMINL = ((IHL + 1) * 60) - 1
            END IF
            RINC_I    = 0.
            RINC_I(3) = XMINL
            CALL W3MOVDAT(RINC_I,jdate,ldate)
            PRINT 6683, (LDATE(I),I=1,3),LDATE(5),LDATE(6)
 6683 FORMAT(/' -->  LATEST  DATE FOR ACCEPTING BUFR MSGS IS:',I5,4I3/)
            CALL W3DIFDAT(LDATE,KDATE,3,RINC_O)
            IF(RINC_O(3).LT.0)  THEN
               PRINT 104
  104 FORMAT(' *** W3UNPKB7 ERROR: DATES SPECIFIED INCORRECTLY - STOP ',
     $ '15'/)
               CALL ERREXIT(15)
            END IF
            NPRINT = 0
         END IF
         IRET = 1
         GO TO 99

C-----------------------------------------------------------------------
      END IF
C SUBR. UNPKB701 RETURNS A SINGLE DECODED REPORT FROM BUFR MESSAGE
      CALL UNPKB701(LUNIT,ITP,SUBSET,SUBSKP,IRET)
      IF(IRET.EQ.2)  THEN
C IRET=2 MEANS ALL DATA HAVE BEEN DECODED FOR SPECIFIED TIME PERIOD
C  (REWIND DATA FILE AND RETURN W/ IRET=2)
         REWIND LUNIT
         IF(ITP.EQ.4)  THEN
            IF(MAX(IFOV(1,1),IFOV(2,1),IFOV(3,1),IFOV(4,1)).GT.0)  THEN
               PRINT 8101, (IFOV(III,1),III=1,4)
 8101 FORMAT(/' ---> W3UNPKB7: SUMMARY OF GOES 5X5 REPORT COUNTS ',
     $ 'GROUPED BY F-O-V NO. (PRIOR TO ANY FILTERING BY CALLING ',
     $ 'PROGRAM)'/15X,
     $ '# WITH F-O-V NO. 00 TO 02:',I8,' - GET "BAD" Q.MARK'/15X,
     $ '# WITH F-O-V NO. 03 TO 09:',I8,' - GET "SUSPECT" Q.MARK'/15X,
     $ '# WITH F-O-V NO. 10 TO 25:',I8,' - GET "NEUTRAL" Q.MARK'/15X,
     $ '# WITH MISSING F-O-V:     ',I8,' - GET "NEUTRAL" Q.MARK'/20X,
     $ '(NOTE: RADIANCES ALWAYS HAVE NEUTRAL Q.MARK REGARDLESS OF FOV ',
     $ 'NUMBER)'/)
            END IF
            IF(MAX(IFOV(1,2),IFOV(2,2),IFOV(3,2),IFOV(4,2)).GT.0)  THEN
               PRINT 8201, (IFOV(III,2),III=1,4)
 8201 FORMAT(/' ---> W3UNPKB7: SUMMARY OF GOES 1X1 REPORT COUNTS ',
     $ 'GROUPED BY F-O-V NO. (PRIOR TO ANY FILTERING BY CALLING ',
     $ 'PROGRAM)'/15X,'(ALL GET "NEUTRAL" Q. MARK)'/15X,
     $ '# WITH F-O-V NO. 01:             ',I8/15X,
     $ '# WITH F-O-V NO. 02:             ',I8/15X,
     $ '# WITH F-O-V NO. 03:             ',I8/15X,
     $ '# WITH F-O-V > 3 (INCL. MISSING):',I8,/20X,
     $ '(NOTE: RADIANCES ALWAYS HAVE NEUTRAL Q.MARK REGARDLESS OF FOV ',
     $ 'NUMBER)'/)
            END IF
            PRINT 8102
 8102 FORMAT(/' ---> W3UNPKB7: SUMMARY OF GOES REPORT COUNTS GROUPED',
     $ ' BY SATELLITE ID (PRIOR TO ANY FILTERING BY CALLING PROGRAM)'/)
            DO  IDSAT = 250,259
               IF(KNTSAT(IDSAT).GT.0) PRINT 8103, IDSAT,KNTSAT(IDSAT)
            ENDDO
 8103 FORMAT(15X,'NUMBER FROM SAT. ID ',I4,' :  ',I8)
            IF(KNTSAT(260).GT.0)  PRINT 8104, KNTSAT(260)
 8104 FORMAT(15X,'NUMBER FROM UNKNOWN SAT. ID:',I8)
            PRINT 8105
 8105       FORMAT(/)
         END IF
         GO TO 99
      ELSE  IF(IRET.EQ.8)  THEN
         GO TO 99
      END IF
C INITIALIZE THE OUTPUT ARRAY
      CALL UNPKB702(RDATA,STNID,ITP)
C STORE THE HEADER INFORMATION INTO UNPACKED QUASI-IW3UNPBF FORMAT
      rdata8_8 = bmiss
      CALL UNPKB703(LUNIT,RDATA,rdata8_8,STNID,SUBSET,ITP,IRET)
C IRET.GE.3 MEANS RPT NOT RETURNED DUE TO MISSING DATA IN HEADR (RETURN)
      IF(IRET.GE.3)  GO TO 99
      IF(ITP.EQ.1.OR.ITP.EQ.2.OR.ITP.EQ.3.OR.ITP.EQ.14)  THEN
C-----------------------------------------------------------------------
C   THE FOLLOWING PERTAINS TO WIND PROFILER REPORTS NOT ORIGINATING
C                 FROM PILOT (PIBAL) FORMAT BULLETINS)
C-----------------------------------------------------------------------
C STORE THE SURFACE DATA INTO UNPACKED QUASI-IW3UNPBF FORMAT (CAT. 10)
         CALL UNPKB704(LUNIT,RDATA,ITP,IRET)
C STORE THE UPPER-AIR DATA INTO UNPACKED QUASI-IW3UNPBF FORMAT (CAT. 11)
         CALL UNPKB705(LUNIT,RDATA,ITP)
         RDATX(1:IDMAX) = RDATA(1:IDMAX)
         IF(IDATA(35)+IDATA(37).EQ.0)  THEN
            IRET = 5
            GO TO 99
         END IF
C STORE BUFR DATA DIRECTLY INTO RDATA2 ARRAY
         RDATA2_8 = BMISS
         CALL UFBINT(LUNIT,RDATA2_8(1),1,1,NLEV,'TSIG')
         IF(NLEV.GT.1)  THEN
            IRET = 7
            GO TO 99
         END IF
         CALL UFBINT(LUNIT,RDATA2_8(5),2,1,NLEV,'NPSM TPSE')
         IF(NLEV.GT.1)  THEN
            IRET = 7
            GO TO 99
         END IF
C For NPN and CAP wind profilers prior to 5/2002, AVERAGING TIME is
C  decoded in minutes, after 5/2002 it is decoded in seconds (in either
C  case it is stored in minutes)
         IF(IBFMS(RDATA2_8(6)).EQ.0)  THEN
            RDATA2_8(6) = NINT(RDATA2_8(6)/60.)
         ELSE
            CALL UFBINT(LUNIT,RDATA2_8(6),1,1,NLEV,'TPMI')
            IF(NLEV.GT.1)  THEN
               IRET = 7
               GO TO 99
            END IF
         END IF
         RDATA2 = RDATA2_8
      ELSE  IF(ITP.EQ.4)  THEN
C-----------------------------------------------------------------------
C        THE FOLLOWING PERTAINS TO GOES SOUNDING/RADIANCE REPORTS
C-----------------------------------------------------------------------
C STORE BUFR DATA DIRECTLY INTO RDATA2 ARRAY
         RDATA2_8 = BMISS
         CALL UFBINT(LUNIT,RDATA2_8(2),1,1,NLEV,'ACAV')
         IF(NLEV.GT.1)  THEN
            IRET = 7
            GO TO 99
         END IF
         CALL UFBINT(LUNIT,RDATA2_8(7),1,1,NLEV,'QMRK')
         IF(NLEV.GT.1)  THEN
            IRET = 7
            GO TO 99
         END IF
         RDATA2 = RDATA2_8
C STORE THE UPPER-AIR DATA/RADIANCES/RETRIEVALS INTO UNPACKED QUASI-
C  IW3UNPBF FORMAT (CATEGORY 12, 13, 08)
         CALL UNPKB707(LUNIT,RDATA,RDATA2,subset,IRET)
         IF(IRET.GE.5) THEN
            RDATA2 = BMISS
            GO TO 99
         END IF
      ELSE  IF(ITP.EQ.5 .OR. ITP.EQ.12 .OR. ITP.EQ.13)  THEN
C-----------------------------------------------------------------------
C       THE FOLLOWING PERTAINS TO NEXRAD (VAD) WIND REPORTS
C           ITP =  5 - VAD WINDS FROM RADAR CODED MESSAGE
C           ITP = 12 - VAD WINDS FROM LEVEL 2 DECODER
C           ITP = 13 - VAD WINDS FROM EUROPE, NEW ZEALAND
C-----------------------------------------------------------------------
C STORE THE UPPER-AIR DATA INTO UNPACKED QUASI-IW3UNPBF FORMAT (CAT. 4)
         CALL UNPKB706(LUNIT,RDATA,ITP,IRET)
      ELSE  IF(ITP.EQ.6)  THEN
C-----------------------------------------------------------------------
C     THE FOLLOWING PERTAINS TO ERS SCATTEROMETER WIND REPORTS
C-----------------------------------------------------------------------
C STORE THE SURFACE DATA INTO UNPACKED QUASI-IW3UNPBF FORMAT (CAT. 10)
         CALL UNPKB704(LUNIT,RDATA,ITP,IRET)
      ELSE  IF(ITP.EQ.7)  THEN
C-----------------------------------------------------------------------
C   THE FOLLOWING PERTAINS TO QUIKSCAT SCATTEROMETER WIND REPORTS
C-----------------------------------------------------------------------
C STORE THE SURFACE DATA INTO UNPACKED QUASI-IW3UNPBF FORMAT (CAT. 10)
         CALL UNPKB704(LUNIT,RDATA,ITP,IRET)
         IF(IRET.GE.5) GO TO 99
C STORE BUFR DATA DIRECTLY INTO RDATA2 ARRAY
         RDATA2_8 = BMISS
         CALL UFBINT(LUNIT,RDATA2_8(2),1,1,NLEV,'ACAV')
         IF(NLEV.GT.1)  THEN
            IRET = 7
            GO TO 99
         END IF
         CALL UFBINT(LUNIT,RDATA2_8(3),2,1,NLEV,'CTCN ATRN')
         IF(NLEV.GT.1)  THEN
            IRET = 7
            GO TO 99
         END IF
         CALL UFBINT(LUNIT,RDATA2_8(8),1,1,NLEV,'SPRR')
         IF(NLEV.GT.1)  THEN
            IRET = 7
            GO TO 99
         END IF
         RDATA2 = RDATA2_8
      ELSE  IF(ITP.EQ.8)  THEN
C-----------------------------------------------------------------------
C   THE FOLLOWING PERTAINS TO GPS INTEGRATED PRECIPITABLE WATER REPORTS
C-----------------------------------------------------------------------
C STORE THE GPS-IPW DATA INTO UNPACKED QUASI-IW3UNPBF FORMAT (CAT. 14)
         CALL UNPKB709(LUNIT,RDATA,subset)
         RDATX(1:IDMAX) = RDATA(1:IDMAX)
         IF(IDATA(43).EQ.0)  THEN
            IRET = 5
            GO TO 99
         END IF
      ELSE  IF(ITP.EQ.9)  THEN
C-----------------------------------------------------------------------
C        THE FOLLOWING PERTAINS TO NPN AND CAP RASS REPORTS
C-----------------------------------------------------------------------
C STORE THE RASS DATA INTO UNPACKED QUASI-IW3UNPBF FORMAT (CAT. 15)
         CALL UNPKB710(LUNIT,RDATA)
         RDATX(1:IDMAX) = RDATA(1:IDMAX)
         IF(IDATA(45).EQ.0)  THEN
            IRET = 5
            GO TO 99
         END IF
C STORE BUFR DATA DIRECTLY INTO RDATA2 ARRAY
         RDATA2_8 = BMISS
         CALL UFBINT(LUNIT,RDATA2_8(1),1,1,NLEV,'TSIG')
         IF(NLEV.GT.1)  THEN
            IRET = 7
            GO TO 99
         END IF
         CALL UFBINT(LUNIT,RDATA2_8(6),1,1,NLEV,'TPSE')
         IF(NLEV.GT.1)  THEN
            IRET = 7
            GO TO 99
         END IF
C For NPN and CAP RASS prior to 5/2002, AVERAGING TIME is decoded in
C  minutes, after 5/2002 it is decoded in seconds (in either case it is
C  stored in minutes)
         IF(IBFMS(RDATA2_8(6)).EQ.0)  THEN
            RDATA2_8(6) = NINT(RDATA2_8(6)/60.)
         ELSE
            CALL UFBINT(LUNIT,RDATA2_8(6),1,1,NLEV,'TPMI')
            IF(NLEV.GT.1)  THEN
               IRET = 7
               GO TO 99
            END IF
         END IF
         RDATA2 = RDATA2_8
      ELSE  IF(ITP.EQ.10)  THEN
C-----------------------------------------------------------------------
C   THE FOLLOWING PERTAINS TO WINDSAT SCATTEROMETER WIND REPORTS
C                         (NAVY OR NESDIS)
C-----------------------------------------------------------------------
C STORE THE SURFACE DATA INTO UNPACKED QUASI-IW3UNPBF FORMAT (CAT. 10)
         CALL UNPKB704(LUNIT,RDATA,ITP,IRET)
         IF(IRET.GE.5) GO TO 99
C STORE BUFR DATA DIRECTLY INTO RDATA2 ARRAY
         RDATA2_8 = BMISS
         CALL UFBINT(LUNIT,RDATA2_8(2), 1,1,NLEV,'ACAV')
         IF(NLEV.GT.1)  THEN
            IRET = 7
            GO TO 99
         END IF
         CALL UFBINT(LUNIT,RDATA2_8(9), 6,1,NLEV,
     $    'SST1 MRWVC MRLWC WSST MWD10 MWS10')
         IF(NLEV.GT.1)  THEN
            IRET = 7
            GO TO 99
         END IF
         CALL UFBINT(LUNIT,RDATA2_8(15),7,1,NLEV,
     $    'WSEQC1 CHSQ PHER SPDE SSTE CLDE VPRE')
         IF(NLEV.GT.1)  THEN
            IRET = 7
            GO TO 99
         END IF
         RDATA2 = RDATA2_8
      ELSE  IF(ITP.EQ.11)  THEN
C-----------------------------------------------------------------------
C     THE FOLLOWING PERTAINS TO ASCAT SCATTEROMETER WIND REPORTS
C-----------------------------------------------------------------------
C STORE THE SURFACE DATA INTO UNPACKED QUASI-IW3UNPBF FORMAT (CAT. 10)
         CALL UNPKB704(LUNIT,RDATA,ITP,IRET)
         IF(IRET.GE.5) GO TO 99
C STORE BUFR DATA DIRECTLY INTO RDATA2 ARRAY
         RDATA2_8 = BMISS
         CALL UFBINT(LUNIT,RDATA2_8(2),1,1,NLEV,'ACAV')
         IF(NLEV.GT.1)  THEN
            IRET = 7
            GO TO 99
         END IF
         CALL UFBINT(LUNIT,RDATA2_8(3),1,1,NLEV,'CTCN')
         IF(NLEV.GT.1)  THEN
            IRET = 7
            GO TO 99
         END IF
         CALL UFBINT(LUNIT,RDATA2_8(22),3,1,NLEV,'WVCQ BSCD LKCS')
         IF(NLEV.GT.1)  THEN
            IRET = 7
            GO TO 99
         END IF
         RDATA2 = RDATA2_8
C-----------------------------------------------------------------------
      END IF
   99 CONTINUE
C PRIOR TO RETURNING SAVE INPUT DATE & HR RANGE ARGUMENTS FROM THIS CALL
      LSDATE = IDATE
      LSHE = IHE
      LSHL = IHL
      RETURN
C-----------------------------------------------------------------------
 8888 CONTINUE
C COME HERE IF ERROR READING 1ST RECORD OF INPUT FILE- RETURN W/ IRET= 2
      PRINT 7765, LUNIT
 7765 FORMAT(' *** W3UNPKB7 ERROR: ERROR READING FIRST RECORD OF INPUT',
     $ ' FILE ON UNIT  ',I2,' -- ALL DONE WITH THIS FILE (IRET = 2)')
      GO TO 9998
C-----------------------------------------------------------------------
 9999 CONTINUE
C COME HERE IF NULL FILE IS INPUT - RETURN WITH IRET = 2
      PRINT 8765, LUNIT
 8765 FORMAT(' *** W3UNPKB7 ERROR: INPUT FILE ON UNIT  ',I2,'  IS ',
     $ 'EMPTY (NULL) -- ALL DONE WITH THIS FILE (IRET = 2)')
C-----------------------------------------------------------------------
 9998 CONTINUE
      REWIND LUNIT
      IRET = 2
      LSDATE = IDATE
      LSHE = IHE
      LSHL = IHL
      RETURN
      END
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    UNPKB701
C   PRGMMR: D. A. KEYSER     ORG: NP22       DATE: 2014-03-13
C
C ABSTRACT: CALLS BUFRLIB ROUTINES TO READ IN A BUFR MESSAGE AND THEN
C   READ A SINGLE REPORT (SUBSET) OUT OF THE MESSAGE.
C
C PROGRAM HISTORY LOG:
C 1996-12-16  D. A. KEYSER NP22 - ORIGINAL AUTHOR
C 1999-02-12  D. A. KEYSER NP22-- ADDED ERS SCATTEROMETER WINDS HERE
C     NOW THAT THEY ARE PACKED IN A NCEP BUFR FILE
C 2000-09-22  D. A. KEYSER NP22-- ADDED QUIKSCAT SCATTEROMETER WINDS
C     HERE NOW THAT THEY ARE PACKED IN A NCEP BUFR FILE
C 2002-07-03  D. A. KEYSER NP22 -- ADDED PROCESSING OF GPS-IPW REPORTS
C     HERE NOW THAT THEY ARE PACKED IN AN NCEP BUFR FILE (GPSIPW -
C     RETURNED IN NEW CATEGORY 14)
C 2004-02-02  D. A. KEYSER -- ADDED NEW INPUT "SUBSKP" - SEE
C     DESCRIPTION BELOW
C 2006-07-14  D. A. KEYSER (THIS FUNCTION IN PROGRAM BUFR_LISTDUMPS):
C 2007-09-14  D. A. KEYSER (THIS FUNCTION IN PROGRAM PREPOBS_PREPDATA):
C     MODIFIED TO HANDLE NAVY WINDSAT SCATTEROMETER WINDS (READ FROM
C     MESSAGE TYPE NC012138)
C 2007-09-14  D. A. KEYSER (THIS FUNCTION IN PROGRAM BUFR_LISTDUMPS):
C 2007-09-14  D. A. KEYSER (THIS FUNCTION IN PROGRAM PREPOBS_PREPDATA):
C     MODIFIED TO HANDLE NESDIS WINDSAT SCATTEROMETER WINDS (READ FROM
C     MESSAGE TYPE NC012139), PROCESSING IS IDENTICAL TO NAVY WINDSAT
C     SCATTEROMETER WINDS; HANDLES GOES 1x1 F-O-V SNDGS RADIANCES IN
C     SUBSET "NC003003"
C 2008-09-25  D. A. KEYSER -- ADDED ASCAT SCATTEROMETER WINDS HERE NOW
C     THAT THEY ARE PACKED IN A NCEP BUFR FILE
C 2014-03-13  D. A. KEYSER -- MODIFIED TO HANDLE VAD WINDS FROM LEVEL
C     2 DECODER (SUBSET "NC002017") {IN ADDITION TO THOSE FROM RADAR
C     CODED MESSAGE (SUBSET "NC002008")}
C 2020-08-20 J. DONG -- ADDED HONG KONG PROFILER WINDS (NC002014) AND
C            VAD WINDS FROM EUROPE AND NEW ZEALAND (NC002018)
C
C USAGE:    CALL UNPKB701(LUNIT,ITP,SUBSET,SUBSKP,IRET)
C   INPUT ARGUMENT LIST:
C     LUNIT    - FORTRAN UNIT NUMBER FOR INPUT DATA FILE
C     SUBSKP   - TWO-DIMENSIONAL LOGICAL ARRAY WHERE ELEMENT 1 REFERS
C              - TO A PARTICULAR BUFR TYPE (RANGE 0-255) AND ELEMENT 2
C              - REFERS TO A PARTICULAR BUFR SUBTYPE (RANGE 0-200). IF
C              - SUBSKP IS SET TO TRUE FOR A PARTICULAR BUFR TYPE AND
C              - SUBTYPE, THEN ANY BUFR MESSAGE OF THIS TYPE READ IN
C              - WILL BE SKIPPED OVER {NO SUBSETS (REPORTS) WILL BE
C              - DECODED OUT OF IT AND RETURNED TO THE CALLING PROGRAM,
C              - INSTEAD THIS SUBROUTINE WILL MOVE ON TO READ THE NEXT
C              - BUFR MESSAGE IN THE FILE AND AGAIN USE SUBSKP TO SEE
C              - IF ANY SUBSETS SHOULD BE DECODED OUT OF IT}. THIS
C              - ALLOWS THIS SUBROUTINE TO QUICKLY PASS BY ANY BUFR
C              - MESSAGES WITH A TYPE/SUBTYPE THAT THE CALLING PROGRAM
C              - DOES NOT WANT DECODED.  THE LENGTH OF THIS ARRAY
C              - SHOULD ALWAYS BE HARDWIRED TO (0:255,0:200).
C
C   OUTPUT ARGUMENT LIST:
C     ITP      - THE TYPE OF REPORT THAT HAS BEEN DECODED {=1 - NPN
C              - WIND PROFILER, =2 - CAP WIND PROFILER, =3 - JMA WIND
C              - PROFILER, =4 - GOES SNDG, =5 - NEXRAD (VAD) WIND FROM
C              - RADAR CODED MESSAGE; =6 - ERS SCATTEROMETER WIND, =7 -
C              - QUIKSCAT SCATTEROMETER WIND, =8 - GPS-IPW, =9 - NPN
C              - or CAP RASS, =10 - WINDSAT SCATTEROMETER WIND (NAVY OR
C              - NESDIS), =11 - ASCAT SCATTEROMETER WIND, =12 - NEXRAD
C              - (VAD) WIND FROM LEVEL 2 DECODER, =13 - NON-NEXRAD (VAD)
C              - WIND FROM OTHER COUNTRIES (EUROPE, NEW ZEALAND), 
C              - =14 - WIND PROFILER FROM HONG KONG}
C     SUBSET   - CHARACTER*8 BUFR MESSAGE TYPE (SAME FOR ALL REPORTS
C              - IN A COMMON BUFR MESSAGE)
C     IRET     - RETURN CODE AS DESCRIBED IN W3UNPKB7 DOCBLOCK
C
C   INPUT FILES:
C     UNIT AA  - (WHERE AA IS LUNIT ABOVE) FILE HOLDING THE DATA
C              - IN THE FORM OF BUFR MESSAGES
C
C   OUTPUT FILES:
C     UNIT 06  - PRINTOUT
C
C REMARKS: CALLED BY SUBROUTINE W3UNPKB7.
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE:  NCEP WCOSS
C
C$$$
      SUBROUTINE UNPKB701(LUNIT,ITP,SUBSET,SUBSKP,IRET)
      CHARACTER*8   SUBSET,SUBSET_LAST
      INTEGER  MDATE(4),NDATE(8)
      LOGICAL  SUBSKP(0:255,0:200),SKIP_CAT12
      DIMENSION  RINC_O(5)
      COMMON /PKB7BB/KDATE(8),LDATE(8),KTIMCH,IPRINT,SKIP_CAT12
      COMMON /PKB7CC/INDEX
      COMMON /PKB7DD/LSHE,LSHL,ICDATE(5),IDDATE(5)
      COMMON /PKB7HH/NPRINT(0:255,0:200)
 
      SAVE

      DATA  IREC/0/,JREC/0/,SUBSET_LAST/'xxxxxxxx'/

   10 CONTINUE
C=======================================================================
      IF(INDEX.EQ.0)  THEN
 
C  READ IN NEXT BUFR MESSAGE
 
         CALL READMG(LUNIT,SUBSET,IBDATE,KRET)
         IF(KRET.NE.0)  THEN
C-----------------------------------------------------------------------
            PRINT 101
  101   FORMAT(' ---> W3UNPKB7: ALL BUFR MESSAGES READ IN AND DECODED'/)
            IRET = 2
            RETURN
C-----------------------------------------------------------------------
         END IF
         IF(IBDATE.LT.100000000)  THEN
C IF INPUT BUFR FILE DOES NOT RETURN MESSAGES WITH A 4-DIGIT YEAR,
C  SOMETHING IS WRONG (EVEN NON-COMPLIANT BUFR MESSAGES SHOULD
C  CONSTRUCT A 4-DIGIT YEAR AS LONG AS DATELEN(10) HAS BEEN CALLED
            PRINT'(" ##W3UNPKB7/UNPKB701 - A 10-DIGIT SECT. 1 BUFR ",
     $       "MESSAGE DATE WAS NOT RETURNED IN UNIT ",I0," - PROBLEM ",
     $       "WITH BUFR FILE - IRET = 2")', LUNIT
            IRET = 2
            RETURN
         END IF
         IF(SUBSET.NE.SUBSET_LAST)   THEN
            JREC = 0
            SUBSET_LAST = SUBSET
         END IF
         CALL UFBCNT(LUNIT,IREC,ISUB)
         JREC = JREC + 1
         MDATE(1) = IBDATE/1000000
         MDATE(2) = MOD((IBDATE/10000),100)
         MDATE(3) = MOD((IBDATE/100),100)
         MDATE(4) = MOD(IBDATE,100)
         IF(IPRINT.GE.1)  THEN
            PRINT'(" HAVE SUCCESSFULLY READ IN A BUFR MESSAGE")'
            PRINT 103
  103       FORMAT(' BUFR FOUND BEGINNING AT BYTE    1 OF MESSAGE')
            PRINT 105, IREC,MDATE,SUBSET
  105       FORMAT(8X,'HAVE READ IN A BUFR MESSAGE NO.',I3,', DATE: ',
     $      I6,3I4,'   0; TABLE A ENTRY = ',A8,' AND EDIT. NO. =    2'/)
         END IF
         IF(SUBSET.EQ.'NC002007')  THEN
            IF(IPRINT.GE.1)  PRINT'(" THIS MESSAGE CONTAINS NOAA ",
     $       "PROFILER NETWORK WIND REPORTS")'
            ITP = 1
         ELSE  IF(SUBSET.EQ.'NC002011')  THEN
            IF(IPRINT.GE.1)  PRINT'(" THIS MESSAGE CONTAINS ",
     $       "COOPERATIVE AGENCY PROFILER WIND REPORTS")'
            ITP = 2
         ELSE  IF(SUBSET.EQ.'NC002013')  THEN
            IF(IPRINT.GE.1)  PRINT'(" THIS MESSAGE CONTAINS JAPANESE ",
     $       "METEOROLOGICAL AGENCY PROFILER WIND REPORTS")'
            ITP = 3
         ELSE  IF(SUBSET.EQ.'NC002014')  THEN
            IF(IPRINT.GE.1)  PRINT'(" THIS MESSAGE CONTAINS OTHER ",
     $       "(e.g., HONG KONG) PROFILER WIND REPORTS")'
            ITP = 14
         ELSE  IF(SUBSET.EQ.'NC002008')  THEN
            IF(IPRINT.GE.1)  PRINT'(" THIS MESSAGE CONTAINS NEXRAD ",
     $       "(VAD) WIND REPORTS FROM RADAR CODED MESSAGE")'
            ITP = 5
         ELSE  IF(SUBSET.EQ.'NC002017')  THEN
            IF(IPRINT.GE.1)  PRINT'(" THIS MESSAGE CONTAINS NEXRAD ",
     $       "(VAD) WIND REPORTS FROM LEVEL 2 DECODER")'
            ITP = 12
         ELSE  IF(SUBSET.EQ.'NC002018')  THEN
            IF(IPRINT.GE.1)  PRINT'(" THIS MESSAGE CONTAINS NEXRAD ",
     $       "(VAD) WIND REPORTS FROM EUROPE AND NEW ZEALAND")'
            ITP = 13
         ELSE  IF(SUBSET.EQ.'NC003001' .or. SUBSET.EQ.'NC003002' .or.
     $            SUBSET.EQ.'NC003003')  THEN
            IF(IPRINT.GE.1)  PRINT'(" THIS MESSAGE CONTAINS GOES ",
     $       "SOUNDING/RADIANCE REPORTS")'
            ITP = 4
         ELSE  IF(SUBSET.EQ.'NC012008')  THEN
            IF(IPRINT.GE.1)  PRINT'(" THIS MESSAGE CONTAINS ERS ",
     $       "SCATTEROMETER WIND REPORTS")'
            ITP = 6
         ELSE  IF(SUBSET.EQ.'NC012137')  THEN
            IF(IPRINT.GE.1)  PRINT'(" THIS MESSAGE CONTAINS QUIKSCAT ",
     $       "SCATTEROMETER WIND REPORTS")'
            ITP = 7
         ELSE  IF(SUBSET.EQ.'NC002009')  THEN
            PRINT 217
  217 FORMAT(/'##W3UNPKB7: THIS MESSAGE CONTAINS WIND PROFILER ',
     $ 'REPORTS ORIGINATING FROM PILOT (PIBAL) BULLETINS - IRET = 8'/)
            IRET = 8
            RETURN
         ELSE  IF(SUBSET.EQ.'NC012003' .OR. SUBSET.EQ.'NC012004')  then
            IF(IPRINT.GE.1)  PRINT'(" THIS MESSAGE CONTAINS GPS-IPW ",
     $       "REPORTS")'
            ITP = 8
         ELSE  IF(SUBSET.EQ.'NC002012')  THEN
            IF(IPRINT.GE.1)  PRINT'(" THIS MESSAGE CONTAINS NOAA ",
     $       "PROFILER NETWORK AND COOPERATIVE AGENCY RASS TEMPERATURE",
     $       " REPORTS")'
            ITP = 9
         ELSE  IF(SUBSET.EQ.'NC012138' .OR. SUBSET.EQ.'NC012139')  THEN
            IF(IPRINT.GE.1)  PRINT'(" THIS MESSAGE CONTAINS WINDSAT ",
     $       "SCATTEROMETER WIND REPORTS FROM THE NAVY OR NESDIS")'
            ITP = 10
         ELSE  IF(SUBSET.EQ.'NC012122')  THEN
            IF(IPRINT.GE.1)  PRINT'(" THIS MESSAGE CONTAINS ASCAT ",
     $       "SCATTEROMETER WIND REPORTS")'
            ITP = 11
         ELSE
            PRINT 107, IREC,SUBSET
  107 FORMAT(' *** W3UNPKB7 WARNING: BUFR MESSAGE NO.',I3,' CONTAINS ',
     $ 'REPORTS THAT CANNOT BE DECODED (SUBSET = ',A8,'), TRY READING ',
     $ 'NEXT MSG'/)
            INDEX = 0
            GO TO 10
         END IF

         JSUB = NMSUB(LUNIT)
         READ(SUBSET(3:5),'(I3)') IINDEX
         READ(SUBSET(6:8),'(I3)') JINDEX
         IF(IINDEX.LE.255 .AND. JINDEX.LE.200) THEN
            IF(SUBSKP(IINDEX,JINDEX))  THEN
               IF(JSUB.GT.0.AND.NPRINT(IINDEX,JINDEX).EQ.0)  THEN

C  There may be messages with no reports present (e.g., the center time
C   and dump time messages which may be present even if no reports are
C   present in subsequent messages), so key on the FIRST message of
C   this type/subtype with reports present for the diagnostic print

                  PRINT 1234, SUBSET
 1234 FORMAT(/' ---> W3UNPKB7: BUFR MESSAGE WITH TABLE ENTRY "',A8,
     $ '" (AND CONTAINING SUBSETS) READ - ALL MESSAGES WITH THIS BUFR ',
     $ 'TYPE/SUBTYPE'/20X,'ARE SKIPPED AS DIRECTED BY CALLING PROGRAM'/)
               NPRINT(IINDEX,JINDEX) = 1
               END IF
               INDEX = 0
               GO TO 10
            END IF
         END IF

         IF(KTIMCH.EQ.1)  THEN

C CHECK DATE OF MESSAGE AGAINST SPEC. TIME RANGES IF DOING TIME CHECK

C ALL NCEP BUFR MESSAGES CURRENTLY HAVE "00" FOR MINUTES IN SECTION 1
            NDATE(1:3) = MDATE(1:3)
            NDATE(4) = 0
            NDATE(5) = MDATE(4)
            NDATE(6:8) = 0
            CALL W3DIFDAT(KDATE,NDATE,3,RINC_O)
            KMIN = RINC_O(3)
            CALL W3DIFDAT(LDATE,NDATE,3,RINC_O)
            LMIN = RINC_O(3)
            IF((KMIN.GT.0.OR.LMIN.LT.0).AND.IREC.GT.2)  THEN
               PRINT 106, IREC,MDATE
  106 FORMAT('  BUFR MESSAGE NO.',I3,' WITH DATE:',I5,3I3,'  0 NOT W/I',
     $ ' REQ. TIME RANGE, TRY READING NEXT MSG'/)
               INDEX = 0
               GO TO 10
            END IF

         END IF

      END IF
C=======================================================================
C  READ NEXT SUBSET (REPORT) IN MESSAGE
 
      IF(IPRINT.GT.1)  PRINT'(" CALL READSB")'
      CALL READSB(LUNIT,KRET)
      IF(IPRINT.GT.1)  PRINT'(" BACK FROM READSB")'
      IF(KRET.NE.0) THEN
         IF(INDEX.GT.0)  THEN
 
C ALL SUBSETS IN THIS MESSAGE PROCESSED, READ IN NEXT MESSAGE (IF ALL
C  MESSAGES READ IN NO MORE DATA TO PROCESS)
 
            IF(IPRINT.GT.1)  PRINT'(" ALL REPORTS IN THIS MESSAGE ",
     $       "DECODED, GO ON TO NEXT MESSAGE")'
         ELSE
 
C THERE WERE NO SUBSETS FOUND IN THIS BUFR MESSAGE, GOOD CHANCE IT IS
C  ONE OF TWO DUMMY MESSAGES AT TOP OF FILE INDICATING CENTER TIME AND
C  DATA DUMP TIME ONLY; READ IN NEXT MESSAGE
 
            IF(JREC.EQ.1)  THEN
               PRINT 4567, IREC,ICDATE,SUBSET
 4567 FORMAT(/'===> BUFR MESSAGE NO. ',I4,' IS A DUMMY CONTAINING ONLY',
     $ ' CENTER DATE (',I4,4I3.2,') FOR MSG TYPE ',A8,' - GO ON TO ',
     $ 'NEXT MESSAGE'/)
            ELSE IF(JREC.EQ.2)  THEN
               PRINT 4568, IREC,IDDATE,SUBSET
 4568 FORMAT(/'===> BUFR MESSAGE NO. ',I4,' IS A DUMMY CONTAINING ONLY',
     $ '  DUMP  DATE (',I4,4I3.2,') FOR MSG TYPE ',A8,' - GO ON TO ',
     $ 'NEXT MESSAGE'/)
            ELSE
               PRINT 4569, IREC,MDATE
 4569 FORMAT(/'===> BUFR MESSAGE NO.',I3,' (DATE:',I5,3I3,'  0) ',
     $ 'CONTAINS ZERO REPORTS FOR SOME UNEXPLAINED REASON - GO ON TO ',
     $ 'NEXT MESSAGE'/)
            END IF
         END IF
         INDEX = 0
         GO TO 10
      END IF
C-----------------------------------------------------------------------
      IF(IPRINT.GT.1)  PRINT'(" READY TO PROCESS NEW DECODED REPORT")'
C***********************************************************************
C            A SINGLE REPORT HAS BEEN SUCCESSFULLY DECODED
C***********************************************************************
      INDEX = INDEX + 1
      IF(IPRINT.GE.1)  PRINT'(" WORKING WITH SUBSET NUMBER ",I0)', INDEX
      RETURN
      END
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    UNPKB702
C   PRGMMR: D. A. KEYSER     ORG: NP22       DATE: 2014-03-13
C
C ABSTRACT: INITIALIZES THE OUTPUT ARRAY WHICH HOLDS A SINGLE REPORT
C   IN THE QUASI-IW3UNPBF UNPACKED FORMAT TO ALL MISSING.
C
C PROGRAM HISTORY LOG:
C 1996-12-16  D. A. KEYSER NP22 - ORIGINAL AUTHOR
C 1999-02-12  D. A. KEYSER NP22-- ADDED ERS SCATTEROMETER WINDS HERE
C     NOW THAT THEY ARE PACKED IN A NCEP BUFR FILE
C 2000-09-22  D. A. KEYSER NP22-- ADDED QUIKSCAT SCATTEROMETER WINDS
C     HERE NOW THAT THEY ARE PACKED IN A NCEP BUFR FILE
C 2002-07-03  D. A. KEYSER NP22 -- ADDED PROCESSING OF GPS-IPW REPORTS
C     HERE NOW THAT THEY ARE PACKED IN AN NCEP BUFR FILE (GPSIPW -
C     RETURNED IN NEW CATEGORY 14)
C 2004-02-02  D. A. KEYSER NP22 -- ADDED PROCESSING OF RASS REPORTS
C     HERE NOW THAT THEY ARE PACKED IN AN NCEP BUFR FILE (RASSDA -
C     RETURNED IN NEW DATA LEVEL CATEGORY 15)
C 2008-09-25  D. A. KEYSER -- ADDED ASCAT SCATTEROMETER WINDS HERE NOW
C     THAT THEY ARE PACKED IN A NCEP BUFR FILE
C 2014-03-13  D. A. KEYSER -- MODIFIED TO HANDLE VAD WINDS FROM LEVEL
C     2 DECODER (SUBSET "NC002017") {IN ADDITION TO THOSE FROM RADAR
C     CODED MESSAGE (SUBSET "NC002008")}; PARAMETERIZED MAXIMUM NUMBER
C     OF LEVELS ALLOWED FOR EACH CATEGORY AND CALCULATED PARAMETER
C     "IDMAX" (SIZE OF OUTPUT "RDATA" ARRAY) BASED ON THESE, ALL ARE
C     NOW PLACED IN INCLUDE FILE 'inc_w3unpkb7.inc' {IN HERE, MAXIMUM
C     NUMBER OF CAT. 04 WINDS-BY-HEIGHT LEVELS (EXCLUDING FIRST,
C     SURFACE, LEVEL), "ILVLMX_04", INCREASED FROM 64 TO 254 TO ACCOUNT
C     FOR MORE LEVELS IN NEW VAD WINDS FROM LEVEL 2 DECODER, AND
C     MAXIMUM NUMBER OF CAT. 11 WIND PROFILER LEVELS (EXCLUDING FIRST,
C     SURFACE, LEVEL), "ILVLMX_11", INCREASED FROM 102 TO 200 TO
C     ACCOUNT FOR SOME MAP PROFILERS WITH MORE LEVELS THAN BEFORE, THE
C     RESULTING "IDMAX" IS NOW 2270, UP FROM 1200 BEFORE}
C
C USAGE:    CALL UNPKB702(RDATA,STNID,ITP)
C   INPUT ARGUMENT LIST:
C     ITP      - THE TYPE OF REPORT THAT HAS BEEN DECODED {=1 - NPN
C              - WIND PROFILER, =2 - CAP WIND PROFILER, =3 - JMA WIND
C              - PROFILER, =4 - GOES SNDG, =5 - NEXRAD (VAD) WIND FROM
C              - RADAR CODED MESSAGE; =6 - ERS SCATTEROMETER WIND, =7 -
C              - QUIKSCAT SCATTEROMETER WIND, =8 - GPS-IPW, =9 - NPN
C              - or CAP RASS, =10 - WINDSAT SCATTEROMETER WIND (NAVY OR
C              - NESDIS), =11 - ASCAT SCATTEROMETER WIND; =12 - NEXRAD
C              - (VAD) WIND FROM LEVEL 2 DECODER}
C   OUTPUT ARGUMENT LIST:
C     RDATA    - SINGLE REPORT RETURNED AN A QUASI-IW3UNPBF
C              - UNPACKED FORMAT; ALL DATA ARE MISSING (NOTE: DOES NOT
C              - INCLUDE STATION ID)
C     STNID    - CHARACTER*8 SINGLE REPORT STATION IDENTIFICATION (UP
C              - TO 8 CHARACTERS, LEFT-JUSTIFIED - HERE INITIALIZED AS
C              - "????????" FOR GOES SOUNDINGS, ERS SCATTEROMETER,
C              - QUIKSCAT SCATTEROMETER, WINDSAT SCATTEROMETER AND
C              - ASCAT SCATTEROMETER AND AS BLANKS FOR ALL OTHER TYPES)
C
C REMARKS: CALLED BY SUBROUTINE W3UNPKB7.
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE:  NCEP WCOSS
C
C$$$
      SUBROUTINE UNPKB702(RDATA,STNID,ITP)

C  Include parameters common to more than one subroutine
C  -----------------------------------------------------

      include 'inc_w3unpkb7.inc'

      REAL  RDATA(*),RDATX(IDMAX)
      INTEGER  IDATA(IDMAX)
      CHARACTER*8  STNID

      COMMON /PKB7GG/IDATS_04,IDATS_08,IDATS_10,IDATS_11,IDATS_12,
     $ IDATS_13,IDATS_14,IDATS_15

      SAVE

      EQUIVALENCE (RDATX,IDATA)

      DATA  XMISS/99999./,IMISS/99999/

      IDATS_04 = 0
      IDATS_08 = 0
      IDATS_10 = 0
      IDATS_11 = 0
      IDATS_12 = 0
      IDATS_13 = 0
      IDATS_14 = 0
      IDATS_15 = 0

      RDATX(1)  = XMISS
      RDATX(2)  = XMISS
      RDATA(3)  = XMISS
      RDATX(4)  = XMISS
      IDATA(5)  = 999999
      IDATA(6)  = 999999
      RDATX(7)  = XMISS
      IDATA(8)  = IMISS
      IDATA(9)  = IMISS
      IDATA(10) = IMISS
      RDATX(11) = XMISS
      RDATX(12) = XMISS
      STNID = '        '
 
C  ALL TYPES -- LOAD ZEROS INTO THE DEFINING WORD PAIRS
 
      IDATA(13:IDATS-1) = 0
 
C  ALL TYPES -- LOAD MISSINGS INTO THE DATA PORTION
 
      RDATX(IDATS:IDMAX) = XMISS

      IF(ITP.EQ.1.OR.ITP.EQ.2.OR.ITP.EQ.3.OR.ITP.EQ.14)  THEN

C  WIND PROFILER -- LOAD INTEGER MISSING WHERE APPROPRIATE
C                   {Current limit of "ILVLMX_11" Cat. 11 levels, not
C                     counting first (surface) level}
C                   (if this is expanded, "IDMAX" will increase)

         IDATS_10 = IDATS
         IDATS_11 = IDATS_10 + (ILVL_10 * 7)
         IDATA(IDATS_11+ 3:IDMAX:11) = IMISS
         IDATA(IDATS_11+ 5:IDMAX:11) = IMISS
         IDATA(IDATS_11+ 6:IDMAX:11) = IMISS
         IDATA(IDATS_11+10:IDMAX:11) = IMISS

      ELSE  IF(ITP.EQ.4)  THEN

C  GOES -- LOAD DEFAULT OF "????????" FOR STN. ID.

         STNID = '????????'

C  GOES -- LOAD DEFAULT OF 2.0 INTO CAT. 12 LEVEL QUALITY MARKERS
C          (Current limit of "ILVLMX_12" Cat. 12 levels)
C          (could be expanded somewhat w/o changing "IDMAX" if need be)

         IDATS_12 = IDATS
         RDATA(IDATS_12+6:IDATS_12+6+((ILVLMX_12-1)*9):9) = 2.0
         RDATA(IDATS_12+7:IDATS_12+7+((ILVLMX_12-1)*9):9) = 2.0
         RDATA(IDATS_12+8:IDATS_12+8+((ILVLMX_12-1)*9):9) = 2.0

C  GOES -- LOAD DEFAULT OF 2.0 INTO FIRST CAT. 08 LEVEL QUALITY MARKER
C          (Current limit of "ILVLMX_08" Cat. 08 levels)
C          (could be expanded somewhat w/o changing "IDMAX" if need be
C           but source in w3unpkb7.f would have to be changed!!)

         IDATS_08 = IDATS_12 + (ILVLMX_12 * 9)
         RDATA(IDATS_08+2:IDATS_08+2+((ILVLMX_08-1)*4):4) = 2.0

C  GOES -- LOAD INTEGER MISSING INTO CAT. 13 LEVEL CHANNEL NUMBER
C       -- LOAD DEFAULT OF 2.0 INTO CAT. 13 LEVEL QUALITY MARKER
C          (Current limit of "ILVLMX_13" Cat. 13 levels)
C          (could be expanded somewhat w/o changing "IDMAX" if need be)

         IDATS_13 = IDATS_08 + (ILVLMX_08 * 4)
         IDATA(IDATS_13+0:IDATS_13+0+((ILVLMX_13-1)*3):3) = IMISS
         RDATA(IDATS_13+2:IDATS_13+2+((ILVLMX_13-1)*3):3) = 2.0

      ELSE  IF(ITP.EQ.5 .OR. ITP.EQ.12 .OR. ITP.EQ.13)  THEN

C  VADWND -- LOAD DEFAULT OF 2.0 INTO HGHT CAT. 04 LEVEL QUALITY MARKER
C         -- LOAD DEFAULT OF 4.0 INTO WIND CAT. 04 LEVEL QUALITY MARKER
C            {Current limit of "ILVLMX_04" Cat. 04 levels, not counting
C             first (surface) level}
C          (could be expanded somewhat w/o changing "IDMAX" if need be)

         IDATS_04 = IDATS
         RDATA(IDATS_04+3:IDMAX:5)   = 2.0
         RDATA(IDATS_04+4:IDMAX:5)   = 4.0

      ELSE  IF(ITP.EQ.6.OR.ITP.EQ.7.OR.ITP.EQ.10.OR.ITP.EQ.11)  THEN

C  ERS, QUIKSCAT, WINDSAT OR ASCAT -- LOAD DEFAULT OF "????????" FOR
C   STN. ID.

         IDATS_10 = IDATS
         STNID    = '????????'

      ELSE  IF(ITP.EQ.8)  THEN

C  GPS-IPW -- 

         IDATS_14 = IDATS

      ELSE IF(ITP.EQ.9)  THEN

C          {Current limit of "ILVLMX_15" Cat. 15 levels, not counting
C           first (surface) level}
C          (could be expanded somewhat w/o changing "IDMAX" if need be)

         IDATS_15 = IDATS
         IDATA(IDATS_15+2:IDMAX:3) = IMISS
      END IF

      RDATA(1:IDMAX) = RDATX(1:IDMAX)

      RETURN
      END

C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    UNPKB703
C   PRGMMR: D. A. KEYSER     ORG: NP22       DATE: 2016-11-30
C
C ABSTRACT: FOR REPORT (SUBSET) READ OUT OF BUFR MESSAGE (PASSED IN
C   INTERNALLY VIA BUFRLIB STORAGE), CALLS BUFRLIB ROUTINE TO DECODE
C   HEADER DATA FOR ALL REPORTS.  THE HEADER IS THEN FILLED INTO THE
C   OUTPUT ARRAY WHICH HOLDS A SINGLE REPORT IN THE QUASI-IW3UNPBF
C   UNPACKED FORMAT.
C
C PROGRAM HISTORY LOG:
C 1996-12-16  D. A. KEYSER NP22 - ORIGINAL AUTHOR (HANDLED PROFILER
C     REPORTS ONLY
C 1997-06-02  D. A. KEYSER NP22 - WROTE SIMILAR SUBROUTINE TO HANDLE
C     VAD WINDS ONLY
C 1997-06-05  D. A. KEYSER NP22 - WROTE SIMILAR SUBROUTINE TO HANDLE
C     GOES SOUNDINGS ONLY
C 1998-06-14  D. A. KEYSER -- MODIFIED VAD WIND HEADER (STATION ID)
C     PROCESSING TO ACCOUNT FOR UPDATES TO BUFRTABLE MNEMONICS IN /dcom
C 1998-06-15  D. A. KEYSER NP22 - CHANGED CHAR. 6 OF GOES STNID TO BE
C     UNIQUE FOR TWO DIFFERENT EVEN OR ODD SATELLITE ID'S (EVERY OTHER
C     EVEN OR ODD SAT. ID NOW GETS SAME CHAR. 6 TAG)
C 1999-02-12  D. A. KEYSER NP22 - WROTE SIMILAR SUBROUTINE TO HANDLE
C     ERS SCATTEROMETER WINDS ONLY
C 2000-09-22  D. A. KEYSER NP22-- ADDED QUIKSCAT SCATTEROMETER WINDS
C     TO ERS SCATTEROMETER SUBROUTINE NOW THAT THEY ARE PACKED IN BUFR
C 2000-12-05  D. A. KEYSER -- MODIFIED GOES, ERS AND QUIKSCAT TO NOT
C     CREATE STN. ID IF IT HAS ALREADY BEEN CREATED BY BUFR_DUPSAT
C     (GOES), WAVE_DATASORT (ERS), OR WAVE_DCODQUIKSCAT (QUIKSCAT)
C     (LOOKS FOR "RPID" IN INPUT FILE) (OTHERWISE, MODIFIED TO CREATE
C     AN 8-CHARACTER STN. ID)
C 2001-04-06  D. A. KEYSER NP22 - HEADER WORD 5 NOW RETURNS COMPLETE
C     DATE (YYYYMMDDHH) AND HEADER WORD 6 IS NOW MISSING EXCEPT FOR
C     GOES, ERS AND QUIKSCAT WHERE WORD 6 NOW RETURNS SATELLITE ID
C 2001-06-19  D. A. KEYSER -- FOR GOES, RECOGNIZES BUFR TYPE/SUBTYPE
C     003/002 AS GOES 1x1 (HI-RES) DATA, PART OF THE "GOESND" DUMP FILE
C     ("SUBSET" ADDED TO INPUT ARGUMENT LIST); GOES HI-RES REPORTS HAVE
C     UNKNOWN PATH AND GET PROPER STNID CHAR. 8 CHARACTER IDENTIFYING
C     THE SAT. NUMBER (IF STNID IS GENERATED HERE)
C 2001-08-20  D. A. KEYSER -- FOR QUIKSCAT, HEADER WORD 10 NOW RETURNS
C     NUMBER OF ORIGINAL REPORTS USED TO GENERATE SUPEROBS SINCE THIS
C     IS NOW AVAILABLE IN INPUT REPROCESSED QKSWND DUMP FILE (FOR
C     NON-SUPEROBS, HARDWIRED TO 1)
C 2002-03-05  D. A. KEYSER -- ACCOUNTS FOR CHANGES IN INPUT PROFLR
C     (WIND PROFILER BUFR DUMP FILE AFTER 5/2002: MNEMONIC "NPSM" IS NO
C     LONGER AVAILABLE; MNEMONIC "TPSE" REPLACES "TPMI" (AVG. TIME IN
C     MINUTES STILL OUTPUT) (WILL STILL WORK PROPERLY FOR INPUT PROFLR
C     DUMP FILES PRIOR TO 5/2002)
C 2002-07-03  D. A. KEYSER -- COMBINED INDIVIDUAL SUBROUTINES FOR
C     PROCESSING HEADER INFORMATION FOR ALL TYPES INTO THIS SINGLE NEW
C     SUBROUTINE SINCE ALL WERE VERY SIMILAR; ADDED PROCESSING OF GPS-
C     IPW REPORTS HERE NOW THAT THEY ARE PACKED IN AN NCEP BUFR FILE
C     (GPSIPW - RETURNED IN NEW CATEGORY 14)
C 2004-02-02  D. A. KEYSER -- ADDED COOPERATIVE AGENCY (002/011) AND
C     JAPANESE (002/013) WIND PROFILERS TO PROCESSING FOR WIND
C     PROFILERS NOT ORIGINATING FROM PILOT (PIBAL) BULLETINS; ADDED
C     PROCESSING OF NPN AND CAP RASS REPORTS HERE (002/012) NOW THAT
C     THEY ARE PACKED IN AN NCEP BUFR FILE (RASSDA - RETURNED IN NEW
C     DATA LEVEL CATEGORY 15)
C 2006-07-14  D. A. KEYSER (THIS FUNCTION IN PROGRAM BUFR_LISTDUMPS):
C 2007-09-14  D. A. KEYSER (THIS FUNCTION IN PROGRAM PREPOBS_PREPDATA):
C     MOVED REPORT-TYPE SPECIFIC VALUES OUT OF RETURNED HEADER IN
C     "RDATA" TO NEW "RDATA2" ARRAY (CLEANS UP HEADER PROCESSING)
C 2007-09-14  D. A. KEYSER (THIS FUNCTION IN PROGRAM BUFR_LISTDUMPS):
C 2007-09-14  D. A. KEYSER (THIS FUNCTION IN PROGRAM PREPOBS_PREPDATA):
C     HANDLES GOES 1x1 F-O-V SNDGS RADIANCES IN SUBSET "NC003003"
C 2008-09-25  D. A. KEYSER -- ADDED ASCAT SCATTEROMETER WINDS HERE NOW
C     THAT THEY ARE PACKED IN A NCEP BUFR FILE (GET DUMP REPORT TYPE
C     584)
C 2014-03-13  D. A. KEYSER -- MODIFIED TO HANDLE VAD WINDS FROM LEVEL
C     2 DECODER (SUBSET "NC002017") {IN ADDITION TO THOSE FROM RADAR
C     CODED MESSAGE (SUBSET "NC002008")}
C 2016-11-30  D. A. KEYSER --
C     Added new output real, double-precision argument array RDATA8_8 of
C     length 2 to return full-precision latitude and longitude for a
C     report.
C     BENEFIT: Although lat and lon are returned in RDATA(1:2) these are
C              at machine precison, which is normally R*4.  Now that
C              many reports in the dumps store lat/lon at 0.001 or even
C              0.00001 degree precision, and now that PREPBUFR encodes
C              YOB (lat) and XOB (lon) at 0.00001 degree precision, this
C              change will ensure that lat/lon is always accurate to
C              0.00001 degrees in all downstream processing.
C 2020-08-20 J. DONG --
C   - Added processing to encode newly available VAD wind (NC002018)
C     and profiler wind (NC002014) tanks into prepbufr files. 
C
C USAGE:    CALL UNPKB703(LUNIT,RDATA,RDATA8_8,STNID,SUBSET,ITP,IRET)
C   INPUT ARGUMENT LIST:
C     LUNIT    - FORTRAN UNIT NUMBER FOR INPUT DATA FILE
C     RDATA    - SINGLE REPORT IN A QUASI-IW3UNPBF UNPACKED FORMAT WITH
C              - ALL DATA INITIALIZED AS MISSING (NOTE: DOES NOT
C              - INCLUDE STATION ID)
C     RDATA8_8 - 2-WORD REAL*8 ARRAY CONTAINING ADDITIONAL REPORT DATA
C                (LATITUDE AND LONGITUDE) (SEE REMARKS 7 FOR CONTENT)
C     STNID    - CHARACTER*8 SINGLE REPORT STATION IDENTIFICATION (UP
C              - TO 8 CHARACTERS, LEFT-JUSTIFIED - HERE INITIALIZED AS
C              - EITHER BLANKS OR "????????")
C     SUBSET   - CHARACTER*8 BUFR MESSAGE TYPE (SAME FOR ALL REPORTS
C              - IN A COMMON BUFR MESSAGE)
C     ITP      - THE TYPE OF REPORT THAT HAS BEEN DECODED {=1 - NPN
C              - WIND PROFILER, =2 - CAP WIND PROFILER, =3 - JMA WIND
C              - PROFILER, =4 - GOES SNDG, =5 - NEXRAD (VAD) WIND FROM
C              - RADAR CODED MESSAGE; =6 - ERS SCATTEROMETER WIND, =7 -
C              - QUIKSCAT SCATTEROMETER WIND, =8 - GPS-IPW, =9 - NPN
C              - or CAP RASS, =10 - WINDSAT SCATTEROMETER WIND (NAVY OR
C              - NESDIS), =11 - ASCAT SCATTEROMETER WIND; =12 - NEXRAD
C              - (VAD) WIND FROM LEVEL 2 DECODER}
C
C   OUTPUT ARGUMENT LIST:
C     RDATA    - SINGLE REPORT IN A QUASI-IW3UNPBF UNPACKED FORMAT WITH
C              - HEADER INFORMATION FILLED IN (ALL OTHER DATA REMAINS
C              - MISSING) (NOTE: DOES NOT INCLUDE - STATION ID)
C     STNID    - CHARACTER*8 SINGLE REPORT STATION IDENTIFICATION (UP
C              - TO 8 CHARACTERS, LEFT-JUSTIFIED - HERE FILLED IN)
C     IRET     - RETURN CODE AS DESCRIBED IN W3UNPKB7 DOCBLOCK
C
C   OUTPUT FILES:
C     UNIT 06  - PRINTOUT
C
C REMARKS: CALLED BY SUBROUTINE W3UNPKB7.
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE:  NCEP WCOSS
C
C$$$
      SUBROUTINE UNPKB703(LUNIT,RDATA,rdata8_8,STNID,SUBSET,ITP,IRET)

C  Include parameters common to more than one subroutine
C  -----------------------------------------------------

      include 'inc_w3unpkb7.inc'

      CHARACTER*1  C8TAG(3,0:3)
      CHARACTER*8  STNID,SID,SUBSET
      character*20 sid_gnss
      CHARACTER*60 HDRSTR, HDRSTR2
      INTEGER  IDATA(IDMAX),KOUNTG(3,0:3),IRPTYP(14)
      LOGICAL  SKIP_CAT12
      REAL(8) HDR_8(12),RPID_8,VAR_8,BMISS,rdata8_8(2)
      REAL  HDR(12),RDATA(*),RDATX(IDMAX)
      COMMON /PKB7AA/BMISS
      COMMON /PKB7BB/KDATE(8),LDATE(8),KTIMCH,IPRINT,SKIP_CAT12
      COMMON /PKB7FF/IFOV(4,2),KNTSAT(250:260)
 
      SAVE
 
      EQUIVALENCE  (RDATX,IDATA),(RPID_8,SID)

      DATA  XMISS/99999./,YMISS/99999.8/,IRPTYP/71,75,76,61,72,581,582,
     $ 74,77,583,584,72,72,76/
      DATA  HDRSTR/
     $ 'CLAT CLON SELV YEAR MNTH DAYS HOUR MINU SECO RCHR RCMI SAID '/
      DATA  HDRSTR2/
     $'CLATH CLONH HSMSL YEAR MNTH DAYS HOUR MINU SECO RCHR RCMI SAID '/
      DATA  ITIMESG/0/,KOUNTG/12*0/,ITIMESS/0/,KOUNTS/0/

C-----------------------------------------------------------------------
C     FOR GOES SOUNDING DATA ONLY:
C     CURRENT LIST OF  SATELLITE IDENTIFIERS (BUFR C.F. 0-01-007)
C     -----------------------------------------------------------
C
C       GOES  6 -- 250     GOES  9 -- 253     GOES 12 -- 256
C       GOES  7 -- 251     GOES 10 -- 254     GOES 13 -- 257
C       GOES  8 -- 252     GOES 11 -- 255     GOES 14 -- 258
C
C  IDSAT =       -- EVEN1 --   --- ODD1 --   -- EVEN2 --   --- ODD2 --
C   Sat. No. -   252,256,...   253,257,...   250,254,...   251,255,...
C  IRTYP =       CLR COR UNKN  CLR COR UNKN  CLR COR UNKN  CLR COR UNKN
C                --- --- ----  --- --- ----  --- --- ----  --- --- ----
C
      DATA C8TAG/'I','J','K',  'L','M','N',  'O','P','S',  'Q','R','T' /
C-----------------------------------------------------------------------

      IF(ITP.EQ.4)  THEN
         IF(ITIMESG.EQ.0)  THEN
            KOUNTG = 0
            ITIMESG = 1
         END IF
      ELSE IF(ITP.EQ.6.OR.ITP.EQ.7.OR.ITP.EQ.10.OR.ITP.EQ.11)  THEN
         IF(ITIMESS.EQ.0)  THEN
            KOUNTS = 0
            ITIMESS = 1
         END IF
      END IF

      RDATX(1:IDMAX) = RDATA(1:IDMAX)
      HDR_8 = BMISS
      IF(ITP.EQ.14.OR.ITP.EQ.13)  THEN
         CALL UFBINT(LUNIT,HDR_8,12,1,NLEV,HDRSTR2);HDR=HDR_8
      ELSE
         CALL UFBINT(LUNIT,HDR_8,12,1,NLEV,HDRSTR);HDR=HDR_8
      END IF
      IF(NLEV.NE.1)  GO TO 9999

C-----------------------------------------
C Output header - Word 1 (Stored as Real)
C-----------------------------------------

C  LATITUDE
 
      M = 1
      N = 1
      if(hdr_8(m).ge.bmiss)  then
         call ufbint(lunit,HDR_8(m),12,1,nlev,'CLATH')
         hdr(m) = hdr_8(m)
      end if
      IF(IPRINT.GT.1)  PRINT 199, hdr_8(M),M
  199 FORMAT(5X,'HDR_8 HERE IS: ',F18.5,'; INDEX IS: ',I3)
      IF(hdr_8(M).LT.bmiss)  THEN
         RDATX(N) = HDR(M)
         IF(IPRINT.GT.1)  PRINT 198, N,RDATX(N)
  198 FORMAT(5X,'RDATA(',I5,') STORED AS: ',F10.2)
         rdata8_8(1) = hdr_8(M)
         if(iprint.gt.1)  print *, 'RDATA8_8(1) STORED AS: ',rdata8_8(1)
      ELSE
         IRET = 3
         PRINT 102
  102    FORMAT(' *** W3UNPKB7 ERROR: LAT MISSING'/)
         RETURN
      END IF

C-----------------------------------------
C Output header - Word 2 (Stored as Real)
C-----------------------------------------

C  LONGITUDE
 
      M = 2
      N = 2
      if(hdr_8(m).ge.bmiss)  then
         call ufbint(lunit,HDR_8(m),12,1,nlev,'CLONH')
         hdr(m) = hdr_8(m)
      end if
      IF(IPRINT.GT.1)  PRINT 199, hdr_8(M),M
      IF(hdr_8(M).LT.bmiss)  THEN

C Important: According to BUFR Manual, CLON (0-06-002) - represented
C  here by "HDR(M)" - should be in units of Degrees West - and East +
C  (-180.0 to +180.0); however some BUFR data sets (e.g., PREPBUFR) are
C  known to encode 0-06-002 in units of Degrees East (0.0 to 359.99) --
C  So we use the following conversion to work in either case ...
         RDATX(N) = 360. - MOD(360.-HDR(M),360.)
         IF(RDATX(N).EQ.360.0)  RDATX(N) = 0.0
         IF(IPRINT.GT.1)  PRINT 198, N,RDATX(N)
         rdata8_8(2) = hdr_8(M)
         if(iprint.gt.1)  print *, 'RDATA8_8(2) STORED AS: ',rdata8_8(2)
      ELSE
         IRET = 3
         PRINT 104
  104    FORMAT(' *** W3UNPKB7 ERROR: LON MISSING'/)
         RETURN
      END IF
 
C-------------------------------------------
C Output header - Word 6 (Stored as Integer)
C-------------------------------------------

C  SATELLITE ID (GOES Soundings/Radiances, ERS Scatterometer,
C                QuikSCAT Scatterometer, WindSat Scatterometer,
C                ASCAT Scatterometer)

      M = 12
      N = 6
      IF(ITP.EQ.4.OR.ITP.EQ.6.OR.ITP.EQ.7.OR.ITP.EQ.10.OR.ITP.EQ.11)THEN
         IF(IPRINT.GT.1)  PRINT 199, HDR(M),M
         IF(ITP.EQ.4)  THEN
            IDSAT = 2
            IF(HDR(M).LT.XMISS)  THEN
cfix?       IF(HDR(M).LT.YMISS)  THEN
               IDATA(N) = NINT(HDR(M))
               IDSAT = MOD(IDATA(N),4)
               IF(IDATA(N).GT.249.AND.IDATA(N).LT.260)  THEN
                  KNTSAT(IDATA(N)) = KNTSAT(IDATA(N)) + 1
               ELSE
                  KNTSAT(260) = KNTSAT(260) + 1
               END IF
            END IF
         ELSE
            IF(HDR(M).LT.XMISS)  IDATA(N) = NINT(HDR(M))
cfix?       IF(HDR(M).LT.YMISS)  IDATA(N) = NINT(HDR(M))
         END IF
         IF(IPRINT.GT.1)  PRINT 197, N,IDATA(N)
  197 FORMAT(5X,'IDATA(',I5,') STORED AS: ',I10)
      END IF

C-----------------------------------------
C Output header - Word 7 (Stored as Real)
C-----------------------------------------

C  STATION ELEVATION

C   GOES Soundings:                 Obtained from height of first 
C                                   (surface) level, stored later in
C                                   subroutine UNPKB707
C   ERS, QuikSCAT, WindSat or ASCAT
C                   Scatterometer:  Hardwired to 10 meters
C   All other types:                Obtained from reported station
C                                   height and stored here

      M = 3
      N = 7
      IF(ITP.EQ.6.OR.ITP.EQ.7.OR.ITP.EQ.10.OR.ITP.EQ.11)  THEN
         RDATX(N)  = 10.
         IF(IPRINT.GT.1)  PRINT 198, N,RDATX(N)
      ELSE IF(ITP.NE.4)  THEN
         IF(HDR(M).LT.XMISS)  RDATX(N) = NINT(HDR(M))
cfix?    IF(HDR(M).LT.YMISS)  RDATX(N) = NINT(HDR(M))
         IF(IPRINT.GT.1)  PRINT 199, HDR(M),M
         IF(IPRINT.GT.1)  PRINT 198, N,RDATX(N)
      END IF

C--------------------------------------------
C Output header - Word 8 (Stored as Integer)
C--------------------------------------------

C  INSTRUMENT TYPE

C  GOES Soundings:         RETRIEVAL TYPE (GEOSTATIONARY SATELLITE
C                          DATA-PROCESSING TECHNIQUE USED)
 
      M = 13
      N = 8
      IF(ITP.EQ.4)  THEN
         CALL UFBINT(LUNIT,VAR_8,1,1,NLEV,'GSDP')
         VAR = VAR_8
         IF(NLEV.GT.1)  GO TO 9999
         IF(VAR.LT.XMISS)  IDATA(N) = NINT(VAR)
cfix?    IF(VAR.LT.YMISS)  IDATA(N) = NINT(VAR)
         IF(IPRINT.GT.1)  PRINT 199, VAR,M
         IF(IPRINT.GT.1)  PRINT 197, N,IDATA(N)
      END IF

C-------------------------------------------
C Output header - Word 9 (Stored as Integer)
C-------------------------------------------

C  REPORT TYPE
 
      N = 9
      IDATA(N)  = IRPTYP(ITP)
      IF(IPRINT.GT.1)  PRINT 197, N,IDATA(N)
 
C-------------------------------------------------
C Output argument - "STNID" (Stored as Character)
C-------------------------------------------------

C  STATION IDENTIFICATION

      M = 14
      if(subset.eq.'NC012004') then
C.......................................................................
C  GPS Integrated Precipitable Water from new "GNSS" BUFR feed:
C.......................................................................
         call readlc(lunit,sid_gnss,'STSN')
         if(sid_gnss.eq.'                    ')  nlev = 0
         if(nlev.eq.0)  go to 9999
         sid = sid_gnss(1:4)//sid_gnss(6:9)
         if(iprint.gt.1)  print 299, sid,m
C    STNID is stored directly from STSN(1:4)//STSN(6:9)
         stnid = sid
      else

      CALL UFBINT(LUNIT,RPID_8,1,1,NLEV,'RPID ')

cpppppppppp
cc    print'(" rpid_8,icbfms(sid,8): ",G0,1X,I0)', rpid_8,icbfms(sid,8)
cpppppppppp
      IF(ICBFMS(SID,8).NE.0) NLEV = 0
C above line not working right - may return 0 when missing, so use next
C  two lines below temporarily until this is fixed (readlc will return
C  all blanks for sid when mnemonic "RPID" not found) - dak 2/19/13
         call readlc(lunit,sid,'RPID')
cpppppppppp
cc    print'(" sid = ",A)', sid
cpppppppppp
         if(sid.eq.'        ')  nlev = 0

      IF(ITP.LE.3.OR.ITP.EQ.14)  THEN

C.......................................................................
C  Wind Profiler:
C.......................................................................

         IF(NLEV.EQ.1)  THEN
C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C            If decoded RPID is not missing set STNID to it
C   (test on "NLEV" for missing "RPID" - valid RPID_8 can be > BMISS!)
C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
            IF(IPRINT.GT.1)  PRINT 299, SID,M
  299 FORMAT(5X,'RPID HERE IS: ',9X,A8,'; INDEX IS: ',I3)
            IF(IPRINT.GT.1)  PRINT 2198
 2198 FORMAT(5X,'STN. ID PRESENT IN INPUT FILE, DO NOT GENERATE HERE')
            STNID = SID
         ELSE
C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C       If decoded RPID is missing then generate STNID from
C                   decoded WMO block/stn numbers
C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
            IF(IPRINT.GT.1)  PRINT 2188
 2188 FORMAT(5X,'STN. ID NOT PRESENT IN INPUT FILE, USE WMO BLOCK/',
     $ 'STATION NUMBER TO GENERATE IT HERE'/)
            CALL UFBINT(LUNIT,VAR_8,1,1,NLEV,'WMOB') ! Block Number
            VAR = VAR_8
            IF(NLEV.GT.1)  GO TO 9999
            IF(IPRINT.GT.1)  PRINT 199, VAR,M
            IF(VAR.LT.XMISS)  WRITE(STNID(1:2),'(I2.2)') NINT(VAR)
cfix?       IF(VAR.LT.YMISS)  WRITE(STNID(1:2),'(I2.2)') NINT(VAR)
            CALL UFBINT(LUNIT,VAR_8,1,1,NLEV,'WMOS') ! Station Number
            VAR = VAR_8
            IF(NLEV.GT.1)  GO TO 9999
            IF(IPRINT.GT.1)  PRINT 199, VAR,M
            IF(VAR.LT.XMISS)  WRITE(STNID(3:5),'(I3.3)') NINT(VAR)
cfix?       IF(VAR.LT.YMISS)  WRITE(STNID(3:5),'(I3.3)') NINT(VAR)
         END IF

      ELSE IF(ITP.EQ.5 .OR. ITP.EQ.12 .OR. ITP.EQ.13)  THEN

C.......................................................................
C  NEXRAD (VAD) Wind:
C.......................................................................

         IF(NLEV.NE.1)  GO TO 9999
         IF(IPRINT.GT.1)  PRINT 299, SID,M
         IF(ITP.EQ.5 .AND. SID(5:7).EQ.'   ')  THEN
C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C   RCM VAD Winds Before 02/18/1999 -->
C    Decoded RPID contains only the 4-character Product Source ID
C    STNID is stored as:
C               '99'//last 3-characters of Product Source ID//'   '
C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
            STNID = '99'//SID(2:4)//'   '
         ELSE
C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C   After  02/18/1999 -->
C    STNID is stored directly from RPID as:
C        RCM VAD: 4-character Product Source ID//3-character RCM ID//' '
C        NEW VAD: 4-character Product Source ID//'    '
C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
            STNID = SID
         END IF
      ELSE IF(ITP.EQ.4)  THEN

C.......................................................................
C  GOES Soundings:
C.......................................................................

         IF(NLEV.NE.1.OR.(SID(8:8).LT.'A'.OR.SID(8:8).GT.'Z'))  THEN
C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C  If decoded RPID is missing or if the eighth character of RPID is not
C             "A"-"Z", then this subr. must generate STNID
C       (indicates an input data dump file prior to Dec. 2000)
C   (test on "NLEV" for missing "RPID" - valid RPID_8 can be > BMISS!)
C
C         STNID Generated as Follows:
C          Characters 1-7 obtained from 7-digit count number (specific
C            to Satellite ID/Retrieval Type)
C            (For SFOV retrievals, character 1 replaced with "H")
C          Character 8 obtained from Satellite ID/Retrieval Type Tag
C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
            IRTYP = 3      ! Unknown retrieval type (default)
            IF(IDATA(8).EQ.21)  THEN
               IRTYP = 1   ! Clear retrieval type
            ELSE  IF(IDATA(8).EQ.23)  THEN
               IRTYP = 2   ! Cloudy retrieval type
            END IF
            IF(IPRINT.GT.1)  PRINT 2197, IDSAT,IRTYP
 2197 FORMAT(5X,'STN. ID NOT PRESENT IN INPUT FILE, MUST GENERATE HERE'/
     $       5X,'IDSAT IS: ',I10,', IRTYP IS: ',I10)
            STNID(8:8) = C8TAG(IRTYP,IDSAT)
            KOUNTG(IRTYP,IDSAT) = MIN(KOUNTG(IRTYP,IDSAT)+1,9999999)
            WRITE(STNID(1:7),'(I7.7)')  KOUNTG(IRTYP,IDSAT)
            IF(SUBSET.EQ.'NC003002' .or. SUBSET.EQ.'NC003003')
     $       STNID(1:1) = 'H'
         ELSE
C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C     If decoded RPID is NOT missing AND if the eighth character of
C    RPID is "A"-"Z", then the dump program BUFR_DUPSAT has already
C   created the proper Station ID in RPID - generate STNID from RPID
C         (indicates an input data dump file after Dec. 2000)
C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
            IF(IPRINT.GT.1)  PRINT 2198
            STNID = SID
         END IF
      ELSE IF(ITP.EQ.6.OR.ITP.EQ.7.OR.ITP.EQ.10.OR.ITP.EQ.11)  THEN

C.......................................................................
C  ERS, QuikSCAT, WindSat or ASCAT Scatterometer:
C.......................................................................

         IF(NLEV.NE.1.OR.(SID(8:8).LT.'A'.OR.SID(8:8).GT.'Z'))  THEN
C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C  If decoded RPID is missing or if the eighth character of RPID is not
C             "A"-"Z", then this subr. must generate STNID
C   (indicates an input reprocessed data dump file prior to Dec. 2000)
C   (test on "NLEV" for missing "RPID" - valid RPID_8 can be > BMISS!)
C
C         STNID Generated as Follows:
C          Characters 1-7 obtained from 7-digit count number
C          Character 8 is "E" for ERS, "Q" for QuikSCAT, "W" for
C           WindSat or "A" for ASCAT
C            (Note: Reprocessed QuikSCAT data dumps never contained
C                   SUPERobs and reports were always from Satellite ID
C                   281 prior to Dec. 2000 - this means 2'nd character
C                   was never "S" and 8'th character was always "Q")
C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
            IF(IPRINT.GT.1)  PRINT 2197
            IF(ITP.EQ.6)  THEN
               STNID(8:8) = 'E'
            ELSE IF(ITP.EQ.7)  THEN
               STNID(8:8) = 'Q'
            ELSE IF(ITP.EQ.10)  THEN
               STNID(8:8) = 'W'
            ELSE IF(ITP.EQ.11)  THEN
               STNID(8:8) = 'A'
            END IF
            KOUNTS = MIN(KOUNTS+1,9999999)
            WRITE(STNID(1:7),'(I7.7)')  KOUNTS
         ELSE
C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C     If decoded RPID is NOT missing AND if the eighth character of
C     RPID is "A"-"Z", then the dump program WAVE_DATASORT (ERS),
C      WAVE_DCODQUIKSCAT (QuikSCAT, ASCAT) or BUFR_DCODWINDSAT
C      (WindSat) has already created the proper Station ID in RPID -
C      generate STNID from RPID (indicates an input reprocessed dump
C      file after Dec. 2000)
C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
            IF(IPRINT.GT.1)  PRINT 2198
            STNID = SID
         END IF
      ELSE IF(ITP.EQ.8.OR.ITP.EQ.9)  THEN

C.......................................................................
C  GPS Integrated Precipitable Water or RASS:
C.......................................................................

         IF(NLEV.NE.1)  GO TO 9999
         IF(IPRINT.GT.1)  PRINT 299, SID,M
C    STNID is stored directly from RPID
         STNID = SID
C.......................................................................
      END IF
      end if
      IF(IPRINT.GT.1)  PRINT 196, STNID
  196 FORMAT(5X,'STNID STORED IN CHARACTER AS: "',A8,'"')
 
C---------------------------------------------
C Output header - Word  4 (Stored as Real)
C  OBSERVATION TIME
C Output header - Word  5 (Stored as Integer)
C  DATE (STORED IN FORM YYYYMMDDHH)
C---------------------------------------------
 
      M = 4
      IF(IPRINT.GT.1)  PRINT 199, HDR(M),M
      M = 5
      IF(IPRINT.GT.1)  PRINT 199, HDR(M),M
      M = 6
      IF(IPRINT.GT.1)  PRINT 199, HDR(M),M
      M = 7
      IF(IPRINT.GT.1)  PRINT 199, HDR(M),M
      M = 8
      IF(IPRINT.GT.1)  PRINT 199, HDR(M),M
      M = 9
      IF(IPRINT.GT.1)  PRINT 199, HDR(M),M
      IF(HDR(9).GE.XMISS)  HDR(9) = 0.
      IF(MIN(HDR(4),HDR(5),HDR(6),HDR(7),HDR(8)).GE.XMISS)  GO TO 30
cfix? IF(HDR(9).GE.YMISS)  HDR(9) = 0.
cfix? IF(MIN(HDR(4),HDR(5),HDR(6),HDR(7),HDR(8)).GE.YMISS)  GO TO 30
      N = 4
      RDATX(N) = (HDR(7) + ((HDR(8) * 60.) + HDR(9))/3600.)
cdak $ + 0.0001 ! don't make this adjustment now that we store obs time
                ! to 10**5 in PREPBUFR
      IF(IPRINT.GT.1)  PRINT 198, N,RDATX(N)
      N = 5
      IDATA(N) = (NINT(HDR(4)) * 1000000) + (NINT(HDR(5)) * 10000) +
     $ (NINT(HDR(6)) * 100) + NINT(HDR(7))
      IF(IPRINT.GT.1)  PRINT 197, N,IDATA(5)

C---------------------------------------------
C Output header - Word  11 (Stored as Real)
C  RECEIPT TIME
C---------------------------------------------

      M = 10
      IF(IPRINT.GT.1)  PRINT 199, HDR(M),M
      M = 11
      IF(IPRINT.GT.1)  PRINT 199, HDR(M),M
      IF(MAX(HDR(10),HDR(11)).LT.XMISS)  THEN
         N = 11
         RDATX(N) = (HDR(10) + ((HDR(11) * 60.))/3600.) + 0.0001
         IF(IPRINT.GT.1)  PRINT 198, N,RDATX(N)
      END IF

      RDATA(1:IDMAX) = RDATX(1:IDMAX)

      RETURN

C-----------------------------------------------------------------------
   30 CONTINUE
C PROBLEM: SOME OR ALL DATE INFORMATION IS MISSING --
C  SET IRET = 4 AND RETURN
      PRINT 317
  317 FORMAT(/'##W3UNPKB7: SOME OR ALL DATE INFORMATION IS MISSING - ',
     $ 'IRET = 4'/)
      IRET = 4
      RETURN
C-----------------------------------------------------------------------
 9999 CONTINUE
C PROBLEM: THE NUMBER OF DECODED "LEVELS" IS NOT WHAT IS EXPECTED --
C  SET IRET = 6 AND RETURN
      PRINT 217, NLEV
  217 FORMAT(/'##W3UNPKB7: THE NUMBER OF DECODED "LEVELS" (=',I5,') ',
     $ 'IS NOT WHAT IS EXPECTED (1) - IRET = 6'/)
      IRET = 6
      RETURN
C-----------------------------------------------------------------------

      END

C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    UNPKB704
C   PRGMMR: D. A. KEYSER     ORG: NP22       DATE: 2008-09-25
C
C ABSTRACT: FOR REPORT (SUBSET) READ OUT OF BUFR MESSAGE (PASSED IN
C   INTERNALLY VIA BUFRLIB STORAGE), CALLS BUFRLIB ROUTINE TO DECODE
C   SURFACE DATA FOR WIND PROFILER REPORTS NOT ORIGINATING FROM PILOT
C   (PIBAL) FORMAT BULLETINS, AND 10 METER DATA FOR ERS SCATTEROMETER,
C   QUIKSCAT SCATTEROMETER, WINDSAT (NAVY OR NESDIS) SCATTEROMETER OR
C   ASCAT SCATTEROMETER WIND REPORTS.  SURFACE DATA ARE THEN FILLED
C   INTO THE OUTPUT ARRAY AS DATA LEVEL CATEGORY 10.  THE OUTPUT ARRAY
C   HOLDS A SINGLE WIND PROFILER, ERS SCATTEROMETER, QUIKSCAT
C   SCATTEROMETER, WINDSAT SCATTEROMETER OR ASCAT SCATTEROMETER REPORT
C   IN THE QUASI-IW3UNPBF UNPACKED FORMAT.
C
C PROGRAM HISTORY LOG:
C 1996-12-16  D. A. KEYSER NP22 - ORIGINAL AUTHOR (WIND PROFILER ONLY)
C 1999-02-12  D. A. KEYSER -- ADDED ERS SCATTEROMETER WINDS HERE NOW
C     THAT THEY ARE PACKED IN A NCEP BUFR FILE
C 2000-09-22  D. A. KEYSER -- CORRECTED VALUE FOR RETURNED RAINFALL;
C     ADDED QUIKSCAT SCATTEROMETER WINDS HERE NOW THAT THEY ARE PACKED
C     IN A NCEP BUFR FILE
C 2002-03-05  D. A. KEYSER -- ACCOUNTS FOR CHANGES IN INPUT PROFLR
C     (WIND PROFILER BUFR DUMP FILE AFTER 5/2002: SURFACE DATA NOW ALL
C     MISSING (MNEMONICS "PMSL","WDIR1","WSPD1", "TMDB", "REHU", "REQV"
C     NO LONGER AVAILABLE) (WILL STILL WORK PROPERLY FOR INPUT PROFLR
C     DUMP FILES PRIOR TO 5/2002)
C 2006-07-14  D. A. KEYSER (THIS FUNCTION IN PROGRAM BUFR_LISTDUMPS):
C 2007-09-14  D. A. KEYSER (THIS FUNCTION IN PROGRAM PREPOBS_PREPDATA):
C     ADDED WINDSAT SCATTEROMETER WINDS HERE NOW THAT THEY ARE PACKED
C     IN A NCEP BUFR FILE; RAINFALL RATE NOW RETURNED IN ORIGINAL BUFR
C     UNITS OF KG/((M**2)*SEC) INSTEAD OF MM/HOUR (WINDSAT IS ONLY TYPE
C     TO RETURN THIS)
C 2008-09-25  D. A. KEYSER -- ADDED ASCAT SCATTEROMETER WINDS HERE NOW
C     THAT THEY ARE PACKED IN A NCEP BUFR FILE
C 2020-08-20  J. DONG -- ADDED TO HANDLE PROFILER WIND FROM HONG KONG
C
C USAGE:    CALL UNPKB704(LUNIT,RDATA,ITP,IRET)
C   INPUT ARGUMENT LIST:
C     LUNIT    - FORTRAN UNIT NUMBER FOR INPUT DATA FILE
C     RDATA    - SINGLE WIND PROFILER, ERS SCATTEROMETER, QUIKSCAT
C              - SCATTEROMETER, WINDSAT SCATTEROMETER OR ASCAT
C              - SCATTEROMETER REPORT IN A QUASI-IW3UNPBF UNPACKED
C              - FORMAT WITH ONLY HEADER INFORMATION FILLED IN (ALL
C              - OTHER DATA REMAINS MISSING)
C     ITP      - THE TYPE OF REPORT THAT HAS BEEN DECODED {=1 - NPN
C              - WIND PROFILER, =2 - CAP WIND PROFILER, =3 - JMA WIND
C              - PROFILER, =6 - ERS SCATTEROMETER WIND, =7 - QUIKSCAT
C              - SCATTEROMETER WIND, =10 - WINDSAT SCATTEROMETER WIND
C              - (NAVY OR NESDIS), =11 - ASCAT SCATTEROMETER WIND}
C              - =14 - HONG KONG WIND PROFILER
C
C   OUTPUT ARGUMENT LIST:
C     RDATA    - SINGLE WIND PROFILER, ERS SCATTEROMETER, QUIKSCAT
C              - SCATTEROMETER, WINDSAT SCATTEROMETER OR ASCAT
C              - SCATTEROMETER REPORT IN A QUASI-IW3UNPBF UNPACKED
C              - FORMAT WITH SURFACE INFORMATION FILLED IN (AS WELL AS
C              - HEADER INFORMATION)
C     IRET     - RETURN CODE AS DESCRIBED IN W3UNPKB7 DOCBLOCK
C
C   OUTPUT FILES:
C     UNIT 06  - PRINTOUT
C
C REMARKS: CALLED BY SUBROUTINE W3UNPKB7.
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE:  NCEP WCOSS
C
C$$$
      SUBROUTINE UNPKB704(LUNIT,RDATA,ITP,IRET)

C  Include parameters common to more than one subroutine
C  -----------------------------------------------------

      include 'inc_w3unpkb7.inc'

      CHARACTER*40  SRFCP,SRFCS
      INTEGER  IDATA(IDMAX)
      REAL(8) SFC_8(8),BMISS
      REAL  SFC(8),RDATA(*),RDATX(IDMAX)
      LOGICAL  SKIP_CAT12
      COMMON /PKB7AA/BMISS
      COMMON /PKB7BB/kdate(8),ldate(8),KTIMCH,IPRINT,SKIP_CAT12
      COMMON /PKB7GG/IDATS_04,IDATS_08,IDATS_10,IDATS_11,IDATS_12,
     $ IDATS_13,IDATS_14,IDATS_15
 
      SAVE
 
      EQUIVALENCE (RDATX,IDATA)
      DATA  XMISS/99999./
      DATA  SRFCP/'PMSL WDIR1 WSPD1 TMDB REHU REQV         '/
      DATA  SRFCS/'PMSL WD10  WS10  TMDB REHU REQV         '/
      RDATX(1:IDMAX) = RDATA(1:IDMAX)
      SFC_8 = BMISS
      IF(ITP.LE.3.OR.ITP.EQ.14)  THEN ! wind profiler
         CALL UFBINT(LUNIT,SFC_8,8,1,NLEV,SRFCP);SFC=SFC_8
         ILVL = 1
      ELSE               ! scatterometer
         CALL UFBINT(LUNIT,SFC_8,8,1,NLEV,SRFCS);SFC=SFC_8
         ILVL = 0
      END IF
      IF(NLEV.NE.1)  THEN
C.......................................................................
C PROBLEM: THE NUMBER OF DECODED "LEVELS" IS NOT WHAT IS EXPECTED --
         IF(ITP.LE.3.OR.ITP.EQ.14)  THEN ! for wind profiler return but don't
                            ! reset iret
            PRINT 217, NLEV
  217 FORMAT(/'##W3UNPKB7: THE NUMBER OF DECODED "LEVELS" (=',I5,') ',
     $ 'IS NOT WHAT IS EXPECTED (1) - NO SFC DATA PROCESSED'/)
            GO TO 99
         ELSE               ! for scatterometer set iret = 7 and return
            PRINT 218, NLEV
  218 FORMAT(/'##W3UNPKB7: THE NUMBER OF DECODED "LEVELS" (=',I5,') ',
     $ 'IS NOT WHAT IS EXPECTED (1) - IRET = 7'/)
            IRET = 7
            RETURN
         END IF
C.......................................................................
      END IF
 

C       MSL PRESSURE (STORED AS REAL)
 
      M = 1
      IF(IPRINT.GT.1)  PRINT 199, SFC(1),M
  199 FORMAT(5X,'SFC HERE IS: ',F17.4,'; INDEX IS: ',I3)
      IF((SFC(1)*0.1).LT.XMISS)  THEN
         ILVL = 1
         RDATX(IDATS_10) = NINT(SFC(1) * 0.1)
      END IF
      NNNNN = IDATS_10
      IF(IPRINT.GT.1)  PRINT 198, NNNNN,RDATX(IDATS_10)
  198 FORMAT(5X,'RDATA(',I5,') STORED AS: ',F10.2)
 
C       SURFACE HORIZONTAL WIND DIRECTION (STORED AS REAL)
 
      M = 2
      IF(IPRINT.GT.1)  PRINT 199, SFC(2),M
      IF(SFC(2).LT.XMISS)  THEN
         ILVL = 1
         RDATX(IDATS_10+2) = NINT(SFC(2))
      END IF
      NNNNN = IDATS_10 + 2
      IF(IPRINT.GT.1)  PRINT 198, NNNNN,RDATX(IDATS_10+2)
 
C       SURFACE HORIZONTAL WIND SPEED (STORED AS REAL)
 
      M = 3
      IF(IPRINT.GT.1)  PRINT 199, SFC(3),M
      IF(SFC(3).LT.XMISS)  THEN
         ILVL = 1
         RDATX(IDATS_10+3) = NINT(SFC(3) * 10.)
      END IF
      NNNNN = IDATS_10 + 3
      IF(IPRINT.GT.1)  PRINT 198, NNNNN,RDATX(IDATS_10+3)
 
C       SURFACE TEMPERATURE (STORED AS REAL)
 
      M = 4
      IF(IPRINT.GT.1)  PRINT 199, SFC(4),M
      IF(SFC(4).LT.XMISS)  THEN
         ILVL = 1
         RDATX(IDATS_10+4) = NINT(SFC(4) * 10.)
      END IF
      NNNNN = IDATS_10 + 4
      IF(IPRINT.GT.1)  PRINT 198, NNNNN,RDATX(IDATS_10+4)
 
C       RELATIVE HUMIDITY (STORED AS REAL)
 
      M = 5
      IF(IPRINT.GT.1)  PRINT 199, SFC(5),M
      IF(SFC(5).LT.XMISS)  THEN
         ILVL = 1
         RDATX(IDATS_10+5) = NINT(SFC(5))
      END IF
      NNNNN = IDATS_10 + 5
      IF(IPRINT.GT.1)  PRINT 198, NNNNN,RDATX(IDATS_10+5)
 
C       RAINFALL RATE (STORED AS REAL)
 
      M = 6
      IF(IPRINT.GT.1)  PRINT 199, SFC(6),M
      IF(SFC(6).LT.XMISS)  THEN
         ILVL = 1
         RDATX(IDATS_10+6) = SFC(6)
      END IF
      NNNNN = IDATS_10 + 6
      IF(IPRINT.GT.1)  PRINT 198, NNNNN,(RDATX(IDATS_10+6)*3600.)
 
C       SET DATA LEVEL CATEGORY COUNTERS FOR SURFACE DATA
 
      IDATA(35) = ILVL
      IF(IPRINT.GT.1)  PRINT'(1X,I0," CAT. 10 LEVELS PROCESSED")',
     $ IDATA(35)
      IF(IDATA(35).GT.0)  IDATA(36) = IDATS_10

      IF(IDATA(35).EQ.0)  IRET = 5 ! Can only happen for scatterometer
                                   ! because for wind profiler
                                   ! IDATA(35)=1 even if all parameters
                                   ! here are missing

   99 CONTINUE
      IF(IPRINT.GT.1)  PRINT'(" IDATA(35)=",I0,"; IDATA(36)=",I0)',
     $ IDATA(35),IDATA(36)
      RDATA(1:IDMAX) = RDATX(1:IDMAX)
      RETURN
      END
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    UNPKB705
C   PRGMMR: D. A. KEYSER     ORG: NP22       DATE: 2014-03-13
C
C ABSTRACT: FOR REPORT (SUBSET) READ OUT OF BUFR MESSAGE (PASSED IN
C   INTERNALLY VIA BUFRLIB STORAGE), CALLS BUFRLIB ROUTINE TO DECODE
C   UPPER-AIR DATA FOR WIND PROFILER REPORT NOT ORIGINATING FROM PILOT
C   (PIBAL) FORMAT BULLETINS.  UPPER-AIR DATA ARE THEN FILLED INTO THE
C   OUTPUT ARRAY AS DATA LEVEL CATEGORY 11.  THE OUTPUT ARRAY HOLDS A
C   SINGLE WIND PROFILER REPORT IN THE QUASI-IW3UNPBF UNPACKED FORMAT.
C
C PROGRAM HISTORY LOG:
C 1996-12-16  D. A. KEYSER NP22 - ORIGINAL AUTHOR
C 1998-06-14  D. A. KEYSER -- MODIFIED WIND PROFILER CAT. 11 (HEIGHT,
C     HORIZ. SIGNIFICANCE, VERT. SIGNIFICANCE) PROCESSING TO ACCOUNT
C     FOR UPDATES TO BUFRTABLE MNEMONICS IN /dcom
C 2002-01-28  D. A. KEYSER -- THE QUALITY CODE FOR WIND PROFILER LEVELS
C     IS NOW SET TO 14 IF THE DECODED QN29 WIND QUALITY MARKER IS 12
C     (REJECT LIST) OR 14 (SDM PURGE), OTHERWISE IT IS SET TO THE
C     DECODED QUALITY CODE VALUE (BEFORE THE ON29 Q.M. WAS IGNORED)
C 2002-03-05  D. A. KEYSER -- ACCOUNTS FOR CHANGES IN INPUT PROFLR
C     (WIND PROFILER BUFR DUMP FILE AFTER 5/2002: MNEMONICS "ACAVH",
C     "ACAVV", "SPP0", AND "NPHL" NO LONGER AVAILABLE (WILL STILL WORK
C     PROPERLY FOR INPUT PROFLR DUMP FILES PRIOR TO 5/2002)
C 2014-03-13  D. A. KEYSER -- MAXIMUM NUMBER OF CAT. 11 WIND PROFILER
C     LEVELS ALLOWED (EXCLUDING FIRST, SURFACE, LEVEL), "ILVLMX_11",
C     INCREASED FROM 102 TO 200 TO ACCOUNT FOR SOME MAP PROFILERS WITH
C     MORE LEVELS THAN BEFORE
C
C USAGE:    CALL UNPKB705(LUNIT,RDATA,ITP)
C   INPUT ARGUMENT LIST:
C     LUNIT    - FORTRAN UNIT NUMBER FOR INPUT DATA FILE
C     RDATA    - SINGLE WIND PROFILER REPORT IN A QUASI-IW3UNPBF
C              - UNPACKED FORMAT WITH ONLY HEADER AND SURFACE
C              - INFORMATION FILLED IN (UPPER-AIR DATA MISSING)
C     ITP      - THE TYPE OF WIND PROFILER REPORT THAT HAS BEEN
C              - DECODED {=1 - NOAA Profiler Network (NPN),
C              - =2 - COOPERATIVE AGENCY PROFILERS (CAP),
C              - =3 - JAPAN AND HONG KONG}
C
C   OUTPUT ARGUMENT LIST:
C     RDATA    - SINGLE WIND PROFILER REPORT IN A QUASI-IW3UNPBF
C              - UNPACKED FORMAT WITH UPPER-AIR INFORMATION FILLED IN
C              - (ALL DATA FOR REPORT NOW FILLED)
C
C   OUTPUT FILES:
C     UNIT 06  - PRINTOUT
C
C REMARKS: CALLED BY SUBROUTINE W3UNPKB7.
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE:  NCEP WCOSS
C
C$$$
      SUBROUTINE UNPKB705(LUNIT,RDATA,ITP)

C  Include parameters common to more than one subroutine
C  -----------------------------------------------------

      include 'inc_w3unpkb7.inc'

      CHARACTER*33  UAIR1,UAIR2,UAIR3
      INTEGER  IDATA(IDMAX)
      LOGICAL  SKIP_CAT12
      REAL(8) UAIR1_8(6,255),UAIR2_8(6,255),UAIR3_8(5,255),BMISS
      REAL  UAIR(17,255),RDATA(*),RDATX(IDMAX)
      COMMON /PKB7AA/BMISS
      COMMON /PKB7BB/kdate(8),ldate(8),KTIMCH,IPRINT,SKIP_CAT12
      COMMON /PKB7GG/IDATS_04,IDATS_08,IDATS_10,IDATS_11,IDATS_12,
     $ IDATS_13,IDATS_14,IDATS_15
 
      SAVE
 
      EQUIVALENCE (RDATX,IDATA)
      DATA  XMISS/99999./
      DATA  UAIR1/'HEIT  WDIR  WSPD  QMWN NPQC WCMP '/
      DATA  UAIR2/'ACAVH ACAVV SPP0  SDHS SDVS NPHL '/
      DATA  UAIR3/'HAST  ACAV1 ACAV2 QMRK STNR      '/
      RDATX(1:IDMAX) = RDATA(1:IDMAX)
      NSFC = 0
      ILVL = 0
      ILC =  0
C FIRST UPPER-AIR LEVEL IS THE SURFACE INFORMATION
      IF(IPRINT.GT.1)  PRINT 1078, ILC,ILVL
 1078 FORMAT(' ATTEMPTING 1ST (SFC) LVL WITH ILC =',I5,'; NO. LEVELS ',
     $ 'PROCESSED TO NOW =',I5)
      RDATX(IDATS_11+ILC) = RDATX(7)
      IF(IPRINT.GT.1)  PRINT 198, IDATS_11+ILC,RDATX(IDATS_11+ILC)
  198 FORMAT(5X,'RDATA(',I5,') STORED AS: ',F10.2)
      IF(RDATX(IDATS_11+ILC).LT.XMISS)  NSFC = 1
      IF(IDATA(35).GE.1)  THEN
         RDATX(IDATS_11+ILC+1) = RDATX(IDATA(36)+2)
         RDATX(IDATS_11+ILC+2) = RDATX(IDATA(36)+3)
      END IF
      IF(IPRINT.GT.1)  PRINT 198, IDATS_11+ILC+1,RDATX(IDATS_11+ILC+1)
      IF(RDATX(IDATS_11+ILC+1).LT.XMISS)  NSFC = 1
      IF(IPRINT.GT.1)  PRINT 198, IDATS_11+ILC+2,RDATX(IDATS_11+ILC+2)
      IF(RDATX(IDATS_11+ILC+2).LT.XMISS)  NSFC = 1
      ILVL = ILVL + 1
      ILC = ILC + 11
      IF(IPRINT.GT.1) PRINT'(" HAVE COMPLETED LEVEL ",I0," WITH NSFC=",
     $ I0,"; GOING INTO NEXT LEVEL WITH ILC=",I0)', ILVL,NSFC,ILC
      UAIR1_8 = BMISS
      UAIR2_8 = BMISS
      UAIR3_8 = BMISS
      CALL UFBINT(LUNIT,UAIR1_8,6,255,NLEV1,UAIR1)
      CALL UFBINT(LUNIT,UAIR2_8,6,255,NLEV2,UAIR2)
      CALL UFBINT(LUNIT,UAIR3_8,5,255,NLEV3,UAIR3)
      NLEV = MAX(NLEV1,NLEV2,NLEV3)
      UAIR( 1: 6,:) = UAIR1_8(:,:)
      UAIR( 7:12,:) = UAIR2_8(:,:)
      UAIR(13:17,:) = UAIR3_8(:,:)
      IF(IPRINT.GT.1)  PRINT 1068, NLEV
 1068 FORMAT(' THIS REPORT CONTAINS ',I3,' LEVELS OF DATA (NOT ',
     $ 'INCLUDING BOTTOM -SURFACE- LEVEL)')
      IF(NLEV.EQ.0)  THEN
C.......................................................................
C PROBLEM: THE NUMBER OF DECODED "LEVELS" IS ZERO --
         IF(NSFC.EQ.0)  THEN
C ... NO UPPER AIR DATA PROCESSED
            PRINT 217
  217       FORMAT(/'##W3UNPKB7: NO UPPER-AIR DATA PROCESSED FOR THIS',
     $       ' REPORT -- NLEV = 0 AND NSFC = 0'/)
            GO TO 99
         ELSE
C ... ONLY FIRST (SURFACE) UPPER AIR LEVEL DATA PROCESSED
            PRINT 218
  218 FORMAT(/'##W3UNPKB7: NO UPPER-AIR DATA ABOVE FIRST (SURFACE) ',
     $ 'LEVEL PROCESSED FOR THIS REPORT -- NLEV = 0 AND NSFC > 0'/)
            GO TO 98
         END IF
C.......................................................................
      ELSE  IF(NLEV.GT.ILVLMX_11)  THEN
C PROBLEM: THE NUMBER OF DECODED "LEVELS" {EXCLUDING BOTTOM (SURFACE)
C  LEVEL} IS .GT. LIMIT OF "ILVLMX_11" --
         PRINT 2186, NLEV,ILVLMX_11,ILVLMX_11
 2186    FORMAT(/'##W3UNPKB7: NUMBER OF UPPER-AIR LEVELS FOR THIS ',
     $    'REPORT (=',I3,') EXCEEDS LIMIT OF ',I0,' CAT. 11 LEVELS ',
     $    '(EXCLUDING BOTTOM, SFC, LVL) -- '/'     ONLY FIRST ',I0,
     $    ' UPPER-AIR LEVELS PLUS THE SURFACE LEVEL WILL BE PROCESSED'/)
         NLEV = ILVLMX_11
C.......................................................................
      END IF
      DO I = 1,NLEV
         IF(IPRINT.GT.1)  PRINT 1079, ILC,ILVL
 1079 FORMAT(' ATTEMPTING NEW LEVEL WITH ILC =',I5,'; NO. LEVELS ',
     $ 'PROCESSED TO NOW =',I5)
 
C       HEIGHT ABOVE SEA-LEVEL (STORED AS REAL)
C        (NOTE: Prior to 2/18/1999, the height above sea level was
C               erroneously stored under mnemonic "HAST" when it should
C               have been stored under mnemonic "HEIT". This was
C               corrected after this date.  ("HAST" is defined as the
C               height above the station.)
C               Will test first for valid data in "HEIT" - if missing,
C               then will use data in "HAST" - this will allow this
C               routine to work properly with historical data.
 
         IF(UAIR(1,I).LT.XMISS)  THEN
            M = 1
            IF(IPRINT.GT.1)  PRINT 199, UAIR(1,I),M
  199 FORMAT(5X,'UAIR HERE IS: ',F17.4,'; INDEX IS: ',I3)
            RDATX(IDATS_11+ILC) = NINT(UAIR(1,I))
         ELSE
            M = 13
            IF(IPRINT.GT.1)  PRINT 199, UAIR(13,I),M
            IF(UAIR(13,I).LT.XMISS) RDATX(IDATS_11+ILC)=NINT(UAIR(13,I))
         END IF
         IF(IPRINT.GT.1)  PRINT 198, IDATS_11+ILC,RDATX(IDATS_11+ILC)
         ILVL = ILVL + 1
 
C       HORIZONTAL WIND DIRECTION (STORED AS REAL)
 
         M = 2
         IF(IPRINT.GT.1)  PRINT 199, UAIR(2,I),M
         IF(UAIR(2,I).LT.XMISS)  RDATX(IDATS_11+ILC+1) = NINT(UAIR(2,I))
         IF(IPRINT.GT.1) PRINT 198, IDATS_11+ILC+1,RDATX(IDATS_11+ILC+1)
 
C       HORIZONTAL WIND SPEED (STORED AS REAL)
 
         M = 3
         IF(IPRINT.GT.1)  PRINT 199, UAIR(3,I),M
         IF(UAIR(3,I).LT.XMISS)RDATX(IDATS_11+ILC+2)=NINT(UAIR(3,I)*10.)
         IF(IPRINT.GT.1) PRINT 198, IDATS_11+ILC+2,RDATX(IDATS_11+ILC+2)
 
C       QUALITY CODE (STORED AS INTEGER)
C          IF SDMEDIT/QUIPS WIND QUALITY MARKER IS 12 (REJECT LIST) OR
C          14 (SDM PURGE) THEN A VALUE OF 14 IS STORED FOR THE QUALITY
C          CODE; OTHERWISE THE DECODED QUALITY CODE IS STORED DIRECTLY
 
         M = 4
         IF(IPRINT.GT.1)  PRINT 199, UAIR(4,I),M
         M = 5
         IF(IPRINT.GT.1)  PRINT 199, UAIR(5,I),M
         M = 16
         IF(IPRINT.GT.1)  PRINT 199, UAIR(16,I),M
         IF(UAIR(4,I).EQ.12.OR.UAIR(4,I).EQ.14)  THEN
            IDATA(IDATS_11+ILC+3) = 14
         ELSE  IF(UAIR(5,I).LT.XMISS) THEN   ! NPN or CAP
            IDATA(IDATS_11+ILC+3) = NINT(UAIR(5,I))
         ELSE  IF(UAIR(16,I).LT.XMISS) THEN  ! Japanese
            IDATA(IDATS_11+ILC+3) = NINT(UAIR(16,I))
         END IF
         IF(IPRINT.GT.1) PRINT 197, IDATS_11+ILC+3,IDATA(IDATS_11+ILC+3)
  197 FORMAT(5X,'IDATA(',I5,') STORED AS: ',I10)
 
C       VERTICAL WIND COMPONENT (W) (STORED AS REAL)
 
         M = 6
         IF(IPRINT.GT.1)  PRINT 199, UAIR(6,I),M
        IF(UAIR(6,I).LT.XMISS)RDATX(IDATS_11+ILC+4)=NINT(UAIR(6,I)*100.)
         IF(IPRINT.GT.1) PRINT 198, IDATS_11+ILC+4,RDATX(IDATS_11+ILC+4)
 
C       HORIZONTAL CONSENSUS NUMBER (STORED AS INTEGER)
C        (NOTE: Prior to 2/18/1999, the horizonal consensus number was
C                stored under mnemonic "ACAV1".
C               From 2/18/1999 through 5/2002, the horizontal consensus
C                number was stored under mnemonic "ACAVH".
C               After 5/2002, the horizontal consensus number is no
C                longer stored.
C               Will test first for valid data in "ACAVH" - if missing,
C                then will test for data in "ACAV1" - this will allow
C                this routine to work properly with historical data.)
 
         IF(IPRINT.GT.1)  PRINT 199, UAIR(7,I),M
         IF(IPRINT.GT.1)  PRINT 199, UAIR(14,I),M
         IF(UAIR(7,I).LT.XMISS)  THEN
            M = 7
            IDATA(IDATS_11+ILC+5) = NINT(UAIR(7,I))
         ELSE
            M = 14
           IF(UAIR(14,I).LT.XMISS)IDATA(IDATS_11+ILC+5)=NINT(UAIR(14,I))
         END IF
         IF(IPRINT.GT.1) PRINT 197, IDATS_11+ILC+5,IDATA(IDATS_11+ILC+5)
 
C       VERTICAL CONSENSUS NUMBER (STORED AS INTEGER)
C        (NOTE: Prior to 2/18/1999, the vertical consensus number was
C                stored under mnemonic "ACAV2".
C               From 2/18/1999 through 5/2002, the vertical consensus
C                number was stored under mnemonic "ACAVV".
C               After 5/2002, the vertical consensus number is no
C                longer stored.
C               Will test first for valid data in "ACAVV" - if missing,
C                then will test for data in "ACAV2" - this will allow
C                this routine to work properly with historical data.)
 
         IF(UAIR(8,I).LT.XMISS)  THEN
            M = 8
            IF(IPRINT.GT.1)  PRINT 199, UAIR(8,I),M
            IDATA(IDATS_11+ILC+6) = NINT(UAIR(8,I))
         ELSE  IF(UAIR(15,I).LT.XMISS)  THEN
            M = 15
            IF(IPRINT.GT.1)  PRINT 199, UAIR(15,I),M
            IDATA(IDATS_11+ILC+6)=NINT(UAIR(15,I))
         END IF
         IF(IPRINT.GT.1) PRINT 197, IDATS_11+ILC+6,IDATA(IDATS_11+ILC+6)
 
         IF(ITP.NE.3)   THEN

C       NPN AND CAP: SPECTRAL PEAK POWER (STORED AS REAL)
C        (NOTE: After 5/2002, the spectral peak power is no longer
C                stored.)
 
            M = 9
         ELSE

C       JAPANESE: SIGNAL-TO-NOISE RATIO (STORED AS REAL)
 
            M = 17
         END IF
         IF(IPRINT.GT.1)  PRINT 199, UAIR(M,I),M
         IF(UAIR(M,I).LT.XMISS)  RDATX(IDATS_11+ILC+7) = NINT(UAIR(M,I))
         IF(IPRINT.GT.1) PRINT 198, IDATS_11+ILC+7,RDATX(IDATS_11+ILC+7)

C       HORIZONTAL WIND SPEED STANDARD DEVIATION (STORED AS REAL)
 
         M = 10
         IF(IPRINT.GT.1)  PRINT 199, UAIR(10,I),M
       IF(UAIR(10,I).LT.XMISS)RDATX(IDATS_11+ILC+8)=NINT(UAIR(10,I)*10.)
         IF(IPRINT.GT.1) PRINT 198, IDATS_11+ILC+8,RDATX(IDATS_11+ILC+8)
 
C       VERTICAL WIND COMPONENT STANDARD DEVIATION (STORED AS REAL)
 
         M = 11
         IF(IPRINT.GT.1)  PRINT 199, UAIR(11,I),M
       IF(UAIR(11,I).LT.XMISS)RDATX(IDATS_11+ILC+9)=NINT(UAIR(11,I)*10.)
         IF(IPRINT.GT.1) PRINT 198, IDATS_11+ILC+9,RDATX(IDATS_11+ILC+9)
 
C       MODE INFORMATION (STORED AS INTEGER)
C        (NOTE: After 5/2002, the mode information is no longer stored.)
 
         M = 12
         IF(IPRINT.GT.1)  PRINT 199, UAIR(12,I),M
         IF(UAIR(12,I).LT.XMISS) IDATA(IDATS_11+ILC+10)=NINT(UAIR(12,I))
         IF(IPRINT.GT.1)PRINT 197,IDATS_11+ILC+10,IDATA(IDATS_11+ILC+10)
C.......................................................................
         ILC = ILC + 11
         IF(IPRINT.GT.1)  PRINT'(" HAVE COMPLETED LEVEL ",I0,"; GOING ",
     $    "INTO NEXT LEVEL WITH ILC=",I0)', ILVL,ILC
      ENDDO    
 
C       SET DATA LEVEL CATEGORY COUNTERS FOR UPPER-AIR DATA
 
   98 CONTINUE
      IDATA(37) = ILVL
      IDATA(38) = IDATS_11
   99 CONTINUE
      IF(IPRINT.GT.1)  PRINT'(" NSFC=",I0,"; IDATA(37)=",I0,
     $ "; IDATA(38)=",I0)', NSFC,IDATA(37),IDATA(38)
      RDATA(1:IDMAX) = RDATX(1:IDMAX)
      RETURN
      END

C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    UNPKB706
C   PRGMMR: D. A. KEYSER     ORG: NP22       DATE: 2014-03-13
C
C ABSTRACT: FOR REPORT (SUBSET) READ OUT OF BUFR MESSAGE (PASSED IN
C   INTERNALLY VIA BUFRLIB STORAGE), CALLS BUFRLIB ROUTINE TO DECODE
C   UPPER-AIR DATA FOR NEXRAD (VAD) WIND REPORT (FROM BOTH RADAR CODED
C   MESSAGE AND FROM LEVEL 2 DECODER).  UPPER-AIR DATA ARE THEN FILLED
C   INTO THE OUTPUT ARRAY AS DATA LEVEL CATEGORY 4.  THE OUTPUT ARRAY
C   HOLDS A SINGLE VAD WIND REPORT IN THE QUASI-IW3UNPBF UNPACKED
C   FORMAT.
C
C PROGRAM HISTORY LOG:
C 1997-06-02  D. A. KEYSER NP22 - ORIGINAL AUTHOR
C 2002-01-28  D. A. KEYSER -- THE WIND Q.M. FOR VAD WINDS LEVELS IS
C     NOW SET TO THE DECODED QN29 WIND QUALITY MARKER IF IT IS 12
C     (REJECT LIST) OR 14 (SDM PURGE), OTHERWISE IT IS SET TO THE
C     NUMERICAL INDICATOR FOR THE DECODED RMS VECTOR WIND ERROR
C     (BEFORE THE ON29 Q.M. WAS IGNORED)
C 2014-03-13  D. A. KEYSER -- MODIFIED TO HANDLE VAD WINDS FROM LEVEL
C     2 DECODER (SUBSET "NC002017") {IN ADDITION TO THOSE FROM RADAR
C     CODED MESSAGE (SUBSET "NC002008")}; MAXIMUM NUMBER OF CAT. 04
C     WINDS-BY-HEIGHT LEVELS ALLOWED (EXCLUDING FIRST, SURFACE, LEVEL),
C     "ILVLMX_04", INCREASED FROM 64 TO 254 TO ACCOUNT FOR MORE LEVELS
C     IN NEW VAD WINDS FROM LEVEL 2 DECODER
C 2020-08-20 J. DONG -- MODIFIED TO HANDLE OTHER VAD WINDS FROM EUROPE
C     AND NEW ZEALAND (NC002018)
C
C USAGE:    CALL UNPKB706(LUNIT,RDATA,ITP,IRET)
C   INPUT ARGUMENT LIST:
C     LUNIT    - FORTRAN UNIT NUMBER FOR INPUT DATA FILE
C     RDATA    - SINGLE NEXRAD (VAD) REPORT IN A QUASI-IW3UNPBF
C              - UNPACKED FORMAT WITH ONLY HEADER INFORMATION FILLED
C              - IN (CATEGORY 4 DATA MISSING)
C     ITP      - THE TYPE OF REPORT THAT HAS BEEN DECODED {=5 -
C              - NEXRAD (VAD) WIND FROM RADAR CODED MESSAGE; =12 -
C              - NEXRAD (VAD) WIND FROM LEVEL 2 DECODER; =13 -
C              - NEXRAD (VAD) WIND FROM EUROPE AND NEW ZEALAND}
C
C   OUTPUT ARGUMENT LIST:
C     RDATA    - SINGLE NEXRAD (VAD) REPORT IN A QUASI-IW3UNPBF
C              - UNPACKED FORMAT WITH CATEGORY 4 INFORMATION FILLED IN
C              - (ALL DATA FOR REPORT NOW FILLED)
C     IRET     - RETURN CODE AS DESCRIBED IN W3UNPKB7 DOCBLOCK
C
C   OUTPUT FILES:
C     UNIT 06  - PRINTOUT
C
C REMARKS: CALLED BY SUBROUTINE W3UNPKB7.
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE:  NCEP WCOSS
C
C$$$
      SUBROUTINE UNPKB706(LUNIT,RDATA,ITP,IRET)

C  Include parameters common to more than one subroutine
C  -----------------------------------------------------

      include 'inc_w3unpkb7.inc'

      CHARACTER*25  UAIR1,UAIR2,UAIR3
      INTEGER  IDATA(IDMAX)
      INTEGER QFV
      LOGICAL  SKIP_CAT12
      REAL(8) UAIR_8(5,255),BMISS,UFBINT2_8(10,255)
      REAL  RMS(0:12),UAIR(5,255),RDATA(*),RDATX(IDMAX)
      COMMON /PKB7AA/BMISS
      COMMON /PKB7BB/kdate(8),ldate(8),KTIMCH,IPRINT,SKIP_CAT12
      COMMON /PKB7GG/IDATS_04,IDATS_08,IDATS_10,IDATS_11,IDATS_12,
     $ IDATS_13,IDATS_14,IDATS_15
 
      SAVE
 
      EQUIVALENCE (RDATX,IDATA)
      DATA  XMISS/99999./
      DATA  UAIR1/'HEIT WDIR WSPD QMWN RMSW '/
      DATA  UAIR2/'HEIT UWND VWND QMWN QFV2 '/
      DATA  UAIR3/'HEIT WDIR WSPD QMWN QMRK '/
      DATA  RMS/1.,1.,2.,2.,3.,3.,4.,4.,5.,5.,6.,6.,7./
      RDATX(1:IDMAX) = RDATA(1:IDMAX)
      NSFC = 0
      ILVL = 0
      ILC =  0
C FIRST CATEGORY 4 DATA LEVEL CONTAINS ONLY HEIGHT (ELEV)
      IF(IPRINT.GT.1)  PRINT 1078, ILC,ILVL
 1078 FORMAT(' ATTEMPTING 1ST (SFC) LVL WITH ILC =',I5,'; NO. LEVELS ',
     $ 'PROCESSED TO NOW =',I5)
      RDATX(IDATS_04+ILC) = RDATX(7)
      IF(IPRINT.GT.1)  PRINT 198, IDATS_04+ILC,RDATX(IDATS_04+ILC)
  198 FORMAT(5X,'RDATA(',I5,') STORED AS: ',F10.2)
      IF(RDATX(IDATS_04+ILC).LT.XMISS)  NSFC = 1
      ILVL = ILVL + 1
      ILC = ILC + 5
      IF(IPRINT.GT.1) PRINT'(" HAVE COMPLETED LEVEL ",I0," WITH NSFC=",
     $ I0,"; GOING INTO NEXT LEVEL WITH ILC=",I0)', ILVL,NSFC,ILC
      UAIR_8 = BMISS
      IF(ITP.EQ.5) THEN
         CALL UFBINT(LUNIT,UAIR_8,5,255,NLEV,UAIR1);UAIR=UAIR_8
      ELSE IF(ITP.EQ.12) THEN
         CALL UFBINT(LUNIT,UAIR_8,5,255,NLEV,UAIR2);UAIR=UAIR_8
      ELSE IF(ITP.EQ.13) THEN
C         CALL UFBINT(LUNIT,UAIR_8,5,255,NLEV,UAIR3);UAIR=UAIR_8
         CALL UFBSEQ(LUNIT,UFBINT2_8(1,1),10,255,NLEV,'WPLVL')
         DO I=1,NLEV
            IF(UFBINT2_8(1,I).LT.BMISS) UAIR(1,I)=UFBINT2_8(1,I)
            IF(UFBINT2_8(4,I).LT.BMISS) UAIR(2,I)=UFBINT2_8(4,I)
            IF(UFBINT2_8(5,I).LT.BMISS) UAIR(3,I)=UFBINT2_8(5,I)
            IF(UFBINT2_8(3,I).LT.BMISS) UAIR(4,I)=UFBINT2_8(3,I)
            IF(UFBINT2_8(6,I).LT.BMISS) UAIR(5,I)=UFBINT2_8(6,I)
         ENDDO
      END IF
      IF(IPRINT.GT.1)  PRINT 1068, NLEV
 1068 FORMAT(' THIS REPORT CONTAINS ',I3,' LEVELS OF DATA (NOT ',
     $ 'INCLUDING BOTTOM -SURFACE- LEVEL)')
      IF(NLEV.EQ.0)  THEN
C.......................................................................
C PROBLEM: THE NUMBER OF DECODED "LEVELS" IS ZERO --
         IF(NSFC.EQ.0)  THEN
C ... NO UPPER AIR DATA PROCESSED
            PRINT 217
  217       FORMAT(/'##W3UNPKB7: NO UPPER-AIR DATA PROCESSED FOR THIS',
     $       ' REPORT -- NLEV = 0 AND NSFC = 0'/)
            GO TO 99
         ELSE
C ... ONLY FIRST (SURFACE) UPPER AIR LEVEL DATA PROCESSED
            PRINT 218
  218 FORMAT(/'##W3UNPKB7: NO UPPER-AIR DATA ABOVE FIRST (SURFACE) ',
     $ 'LEVEL PROCESSED FOR THIS REPORT -- NLEV = 0 AND NSFC > 0'/)
            GO TO 98
         END IF
C.......................................................................
      ELSE  IF(NLEV.GT.ILVLMX_04)  THEN
C PROBLEM: THE NUMBER OF DECODED "LEVELS" {EXCLUDING BOTTOM (SURFACE)
C  LEVEL} IS .GT. LIMIT OF "ILVLMX_04" --
         PRINT 2186, NLEV,ILVLMX_04,ILVLMX_04
 2186    FORMAT(/'##W3UNPKB7: NUMBER OF UPPER-AIR LEVELS FOR THIS ',
     $    'REPORT (=',I3,') EXCEEDS LIMIT OF ',I0,' CAT. 04 LEVELS ',
     $    '(EXCLUDING BOTTOM, SFC, LVL) -- '/'     ONLY FIRST ',I0,
     $    ' UPPER-AIR LEVELS PLUS THE SURFACE LEVEL WILL BE PROCESSED'/)
         NLEV = ILVLMX_04
C.......................................................................
      END IF
      DO I = 1,NLEV
         IF(IPRINT.GT.1)  PRINT 1079, ILC,ILVL
 1079 FORMAT(' ATTEMPTING NEW LEVEL WITH ILC =',I5,'; NO. LEVELS ',
     $ 'PROCESSED TO NOW =',I5)
 
C       HEIGHT ABOVE SEA-LEVEL (STORED AS REAL)
 
         M = 1
         IF(IPRINT.GT.1)  PRINT 199, UAIR(1,I),M
  199 FORMAT(5X,'UAIR HERE IS: ',F17.4,'; INDEX IS: ',I3)
         IF(UAIR(1,I).LT.XMISS)  THEN
            RDATX(IDATS_04+ILC) = NINT(UAIR(1,I))

C       ... WE HAVE A VALID CATEGORY 4 DATA LEVEL -- THERE IS A VALID
C            HEIGHT

            ILVL = ILVL + 1
         ELSE

C       ... WE DO NOT HAVE A VALID CATEGORY 4 DATA LEVEL -- THERE IS NO
C            VALID HEIGHT GO ON TO NEXT INPUT LEVEL

            IF(IPRINT.GT.1)  PRINT'(" HEIGHT MISSING ON INPUT LEVEL ",
     $       I0,", ALL OTHER DATA SET TO MSG ON THIS LEVEL")', I
            CYCLE
         END IF
         IF(IPRINT.GT.1)  PRINT 198, IDATS_04+ILC,RDATX(IDATS_04+ILC)
 
C       HORIZONTAL WIND DIRECTION (STORED AS REAL) (VAD FROM RADAR
C        CODED MESSAGE)
C       HORIZONTAL U-COMP WIND    (STORED AS REAL) (VAD FROM LEVEL 2
C        DECODER)
 
         M = 2
         IF(IPRINT.GT.1)  PRINT 199, UAIR(2,I),M
         IF(UAIR(2,I).LT.XMISS)  RDATX(IDATS_04+ILC+1) = UAIR(2,I)
         IF(IPRINT.GT.1) PRINT 198, IDATS_04+ILC+1,RDATX(IDATS_04+ILC+1)
 
C       HORIZONTAL WIND SPEED     (STORED AS REAL) (VAD FROM RADAR
C        CODED MESSAGE)
C       HORIZONTAL V-COMP WIND    (STORED AS REAL) (VAD FROM LEVEL 2
C        DECODER)
 
         M = 3
         IF(IPRINT.GT.1)  PRINT 199, UAIR(3,I),M
         IF(UAIR(3,I).LT.XMISS) THEN
            IF(ITP.EQ.5 .OR. ITP.EQ.13) THEN
               RDATX(IDATS_04+ILC+2) = NINT(UAIR(3,I)*10.)
            ELSE IF(ITP.EQ.12) THEN
               RDATX(IDATS_04+ILC+2) = UAIR(3,I)
            END IF
         END IF
         IF(IPRINT.GT.1) PRINT 198, IDATS_04+ILC+2,RDATX(IDATS_04+ILC+2)
 
C       WIND QUALITY MARKER -- 
C          IF SDMEDIT/QUIPS WIND QUALITY MARKER IS 12 (REJECT LIST) OR
C          14 (SDM PURGE) THEN THIS VALUE IS STORED; OTHERWISE IT IS
C          BASED ON CONFIDENCE LEVEL (WHICH IS ITSELF BASED ON RMS
C          VECTOR WIND ERROR)
C          (NOTE: THE LATTER IS CONVERTED TO NUMERICAL INDICATOR --
C                 SEE W3UNPKB7 DOCBLOCK REMARKS 5 FOR UNPACKED VAD WIND
C                 REPORT LAYOUT FOR VALUES)
 
         M = 4
         IF(IPRINT.GT.1)  PRINT 199, UAIR(4,I),M
         M = 5
         IF(IPRINT.GT.1)  PRINT 199, UAIR(5,I),M
         IF(UAIR(4,I).EQ.12.OR.UAIR(4,I).EQ.14)  THEN
            RDATX(IDATS_04+ILC+4) = UAIR(4,I)
         ELSE  IF(UAIR(5,I).LT.XMISS)  THEN

C       ... CONVERT FROM METERS/SEC TO KNOTS

            IF (ITP.EQ.5) THEN
CDAKCDAK       KRMS = INT(1.93333 * UAIR(5,I))
               KRMS = INT(1.9425 * UAIR(5,I))
CDONG:DEBUG
               IF(KRMS.GE.0.AND.KRMS.LT.13)  THEN
                  RDATX(IDATS_04+ILC+4) = RMS(KRMS)
               ELSE
                 RDATX(IDATS_04+ILC+4) = 7.0
               END IF
            ELSE IF (ITP.EQ.12) THEN
               QFV = UAIR(5,I)
               IF(QFV .EQ. 0) THEN
                 RDATX(IDATS_04+ILC+4) = 1.0
               ELSE IF(QFV .EQ. 1.0) THEN
                 RDATX(IDATS_04+ILC+4) = 2.0
               ELSE
                 RDATX(IDATS_04+ILC+4) = 7.0
               END IF
            ELSE IF (ITP.EQ.13) THEN
               QFV = UAIR(5,I)
               IF(QFV .EQ. 0) THEN
                 RDATX(IDATS_04+ILC+4) = 1.0
               ELSE IF(QFV .EQ. 1.0) THEN
                 RDATX(IDATS_04+ILC+4) = 2.0
               ELSE
                 RDATX(IDATS_04+ILC+4) = 7.0
               END IF
            END IF
         END IF
         IF(IPRINT.GT.1) PRINT 198, IDATS_04+ILC+4,RDATX(IDATS_04+ILC+4)
C.......................................................................
         ILC = ILC + 5
         IF(IPRINT.GT.1)  PRINT'(" HAVE COMPLETED LEVEL ",I0,"; GOING ",
     $    "INTO NEXT LEVEL WITH ILC=",I0)', ILVL,ILC

      ENDDO    
 
C       SET DATA LEVEL CATEGORY COUNTERS FOR UPPER-AIR DATA
 
   98 CONTINUE
      IDATA(19) = ILVL
   99 CONTINUE
      IF(IDATA(19).EQ.0)  THEN
         IDATA(20) = 0
         IRET = 5
      ELSE
         IDATA(20) = IDATS_04
      END IF
      IF(IPRINT.GT.1)  PRINT'(" NSFC=",I0,"; IDATA(37)=",I0,
     $ "; IDATA(38)=",I0)', NSFC,IDATA(37),IDATA(38)
      RDATA(1:IDMAX) = RDATX(1:IDMAX)
      RETURN
      END

C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    UNPKB707
C   PRGMMR: WHITING          ORG: EMC        DATE: 2015-04-16
C
C ABSTRACT: FOR REPORT (SUBSET) READ OUT OF BUFR MESSAGE (PASSED IN
C   INTERNALLY VIA BUFRLIB STORAGE), CALLS BUFRLIB ROUTINE TO DECODE
C   UPPER-AIR (SOUNDING), ADDITIONAL DATA, AND RADIANCES FOR GOES
C   SOUNDING/RADIANCE REPORT.  UPPER-AIR DATA ARE THEN FILLED INTO THE
C   OUTPUT ARRAY AS DATA LEVEL CATEGORY 12 (SATELLITE SOUNDING),
C   ADDITIONAL DATA ARE FILLED AS DATA LEVEL CATEGORY 8 (ADDITIONAL
C   DATA) AND RADIANCE DATA ARE FILLED AS DATA LEVEL CATEGORY 13
C   (SATELLITE RADIANCE) THE OUTPUT ARRAY HOLDS A SINGLE GOES SOUNDING
C   IN THE QUASI-IW3UNPBF UNPACKED FORMAT.
C
C PROGRAM HISTORY LOG:
C 1997-06-05  D. A. KEYSER NP22 - ORIGINAL AUTHOR
C ????-??-??  D. A. KEYSER NP22 - ADDED CAT. 13 (RADIANCE) PROCESSING
C 2001-04-06  D. A. KEYSER NP22 - CAT. 8 TYPES ARE NO LONGER SCALED,
C     BUT STORED IN THE SAME UNITS/SCALING AS FOUND UPON INPUT; CAT. 13
C     BRIGHTNESS TEMPERATURES ARE NOW STORED AS DEG. K (PRECISE TO
C     10**2) RATHER THAN AS DEG. K X 100; NOW SKIPS CAT. 12 LEVELS
C     WHERE RETRIEVED GEOPOTENTIAL HGHT IS .LE. ELEVATION (LOWEST
C     RETRIEVED HEIGHT); NOW UNPACKS SURFACE PRESSURE INTO CAT. 8 CODE
C     FIGURE 262
C 2001-06-19  D. A. KEYSER -- RECOGNIZES BUFR TYPE/SUBTYPE 003/002 AS
C     GOES 1x1 (HI-RES) DATA, PART OF THE "GOESND" DUMP FILE ("SUBSET"
C     ADDED TO INPUT ARGUMENT LIST); STORES CLOUD COVER RATHER THAN
C     CLOUD AMOUNT IN OUTPUT CAT. 8, C.F. 258 FOR GOES HI-RES REPORTS
C 2001-07-10  D. A. KEYSER -- NOW KEEPS SEPARATE COUNT OF REPORTS WITH
C     MISSING # FOV (E.G., CLOUD-TOP REPORTS), BEFORE THESE WERE
C     GROUPED WITH # FOV 10-25
C 2004-09-09  D. A. KEYSER -- ADDED LOGIC TO HANDLE GOES 1x1 (SFOV)
C     SOUNDING (RADIANCE/RETRIEVAL) DATA: DOES NOT Q.C. ANY 1x1 DATA
C     (CLOUD AS BEFORE, BUT NOW ALSO SNDGS) BY NUMBER OF FOV's (STILL
C     DOES SO FOR NON-RADIANCE 5x5 DATA); FOR GOES PW RETRIEVALS, IF
C     TPW IS NOT FOUND UNDER LOCAL MNEMONIC "PH2O", NOW LOOKS FOR IT IN
C     WMO MNEMONIC "TPWT", THIS ALLOWS FOR TRANSITION FROM "PH2O" TO
C     "TPWT" IN REPORTS IN DUMP FILES (~ MID-2004) AND ALSO ALLOWS
C     HISTORICAL RERUNS TO READ OLD DUMP FILES
C 2006-07-14  D. A. KEYSER (THIS FUNCTION IN PROGRAM BUFR_LISTDUMPS):
C 2007-09-14  D. A. KEYSER (THIS FUNCTION IN PROGRAM PREPOBS_PREPDATA):
C     NUMBER OF FIELDS-OF-VIEW (USED IN Q.C. PROCESSING) IS NOW
C     OBTAINED FROM WORD 2 OF NEW "RDATA2" ARRAY (HOLDS VALUES DECODED
C     DIRECTLY FROM BUFR) RATHER FROM WORD 3 OF HEADER IN "RDATA" ARRAY
C 2007-09-14  D. A. KEYSER (THIS FUNCTION IN PROGRAM BUFR_LISTDUMPS):
C 2007-09-14  D. A. KEYSER (THIS FUNCTION IN PROGRAM PREPOBS_PREPDATA):
C     HANDLES GOES 1x1 F-O-V SNDGS/RADIANCES IN SUBSET "NC003003"; CODE
C     FIGURE 258 REFERS ONLY TO CLOUD AMOUNT (HAD ALSO PREVIOUSLY
C     REFERRED TO CLOUD COVER FOR GOES 1x1 SNDGS - GOES 1x1 AND 5x5
C     SNDGS NOW BOTH PROCESS CLOUD AMOUNT)
C 2013-02-14  D. A. KEYSER -- FOR ANY "GOESND" OR "GOESFV" DUMP FILES
C     WITH CENTER TIME 2013022512 OR LATER, NO ATTEMPT IS MADE TO
C     DECODE GOES SOUNDINGS (PROFILES) AS THESE WERE REMOVED AT THIS
C     TIME FROM THE 1X1 GOES RADIANCE FILES PROVIDED BY NESDIS
C     (INGESTED INTO FROM TANK b003/xx003)
C 2015-04-16 JWhiting --  RDATA2(25) stores total cloud cover (TOCC)
C     (present in dumps of GOES cloud reports).
C
C USAGE:    CALL UNPKB707(LUNIT,RDATA,RDATA2,subset,IRET)
C   INPUT ARGUMENT LIST:
C     LUNIT    - FORTRAN UNIT NUMBER FOR INPUT DATA FILE
C     RDATA    - SINGLE GOES SNDG REPORT IN A QUASI-IW3UNPBF
C              - UNPACKED FORMAT WITH ONLY HEADER INFORMATION FILLED
C              - IN (CATEGORY 12, 8 AND 13 8 DATA MISSING)
C     RDATA2   - 25-WORD ARRAY CONTAINING ADDITIONAL REPORT DATA NOT
C              - PRESENT IN RDATA ARRAY (DECODED DIRECTLY FROM BUFR)
C              - (ONLY WORDS 2 AND 7 FILLED IN - SEE W3UNPKB7 DOCBLOCK
C              - REMARKS 6 FOR CONTENT)
C     SUBSET   - CHARACTER*8 BUFR MESSAGE TYPE (SAME FOR ALL REPORTS
C              - IN A COMMON BUFR MESSAGE)
C
C   OUTPUT ARGUMENT LIST:
C     RDATA    - SINGLE GOES SNDG REPORT IN A QUASI-IW3UNPBF
C              - UNPACKED FORMAT WITH CATEGORY 12, 8 AND 13
C              - INFORMATION FILLED IN (ALL DATA FOR REPORT NOW
C              - FILLED)
C     IRET     - RETURN CODE AS DESCRIBED IN W3UNPKB7 DOCBLOCK
C
C   OUTPUT FILES:
C     UNIT 06  - PRINTOUT
C
C REMARKS: CALLED BY SUBROUTINE W3UNPKB7.
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE:  NCEP WCOSS
C
C$$$
      SUBROUTINE UNPKB707(LUNIT,RDATA,RDATA2,subset,IRET)

C  Include parameters common to more than one subroutine
C  -----------------------------------------------------

      include 'inc_w3unpkb7.inc'

      character*8   subset
      CHARACTER*37  CAT8A,CAT8B
      CHARACTER*48  UAIR1,RAD1
      INTEGER  IDATA(IDMAX),ICDFG(ILVLMX_08)
      LOGICAL  SKIP_CAT12
      REAL(8) UAIR_8(4,255),CAT8_8(12),RTCSF_8,RAD_8(2,255),BMISS
      REAL(8) TOCC_8
      REAL UAIR(4,255),CAT8(ILVLMX_08),SCALE(ILVLMX_08),RDATA(*),
     $ RDATX(IDMAX),RAD(2,255),ZMISS(ILVLMX_08),RDATA2(25)
      COMMON /PKB7AA/BMISS
      COMMON /PKB7BB/KDATE(8),LDATE(8),KTIMCH,IPRINT,SKIP_CAT12
      COMMON /PKB7FF/IFOV(4,2),KNTSAT(250:260)
      COMMON /PKB7GG/IDATS_04,IDATS_08,IDATS_10,IDATS_11,IDATS_12,
     $ IDATS_13,IDATS_14,IDATS_15
 
      SAVE
 
      EQUIVALENCE (RDATX,IDATA)
      DATA  XMISS/99999./,YMISS/99999.8/
      DATA  UAIR1/'PRLC HGHT TMDB TMDP                             '/
      DATA  RAD1 /'CHNM TMBR                                       '/
      DATA  CAT8A/'GLFTI PH2O PH2O19 PH2O97 PH2O73 TMSK '/
      DATA  CAT8B/'GCDTT CDTP CLAM   SIDU   SOEL   ELEV '/
      DATA  ZMISS/ 99999.,  99999.,  99999.,  99999.,  99999.,
     $             99999.,  99999., 999999.,  99999.,  99999.,
     $             99999.,  99999.,  99999./
      DATA ICDFG/   50,   51,  52,    53,    54,    55,
     $              56,   57,  58,    59,    60,    61,    62/
      DATA SCALE/  1.0,  1.0, 1.0,   1.0,   1.0,   1.0,
     $             1.0,  .01, 1.0,   1.0,   1.0,   1.0,   1.0/
      RDATX(1:IDMAX) = RDATA(1:IDMAX)

      QMFLG = 2.0

      IF(SUBSET(8:8).EQ.'1') THEN

C ALL NON-RADIANCE 5x5 FOV DATA WILL BE Q.C.'D ACCORDING TO NUMBER OF
C  FIELDS-OF-VIEW FOR RETRIEVAL:  0-2 --> BAD, 3-9 --> SUSPECT, 10-25
C  OR MISSING --> NEUTRAL

         IF(NINT(RDATA2(2)).LT.3)  THEN
            QMFLG = 13.0
            IFOV(1,1) = IFOV(1,1) + 1
         ELSE  IF(NINT(RDATA2(2)).LT.10.OR.NINT(RDATA2(7)).EQ.1)  THEN
            QMFLG = 3.0
            IF(NINT(RDATA2(2)).LT.10)  IFOV(2,1) = IFOV(2,1) + 1
         END IF
         IF(NINT(RDATA2(2)).GT.25)  THEN
            IFOV(4,1) = IFOV(4,1) + 1
         ELSE  IF(NINT(RDATA2(2)).GT.9)  THEN
            IFOV(3,1) = IFOV(3,1) + 1
         END IF

      ELSE

C ALL NON-RADIANCE 1x1 FOV DATA GET NEUTRAL Q. MARK REGARDLESS OF
C  FIELD-OF-VIEW NUMBER (BUT STILL KEEP TRACK OF COUNTS BY FOV)

         IF(NINT(RDATA2(2)).GT.0.AND.NINT(RDATA2(2)).LT.4)  THEN
            IFOV(NINT(RDATA2(2)),2) = IFOV(NINT(RDATA2(2)),2) + 1
         ELSE 
            IFOV(4,2) = IFOV(4,2) + 1
         END IF

      END IF

      PSFC   = XMISS

      IF(SKIP_CAT12) GO TO 98 ! skip attempt to process soundings if
                              ! center dump date is 2013022512 or later

C***********************************************************************
C              FILL DATA LEVEL CATEGORY 12 PART OF OUTPUT
C***********************************************************************

      ILVL = 0
      ILC  = 0
      UAIR_8 = BMISS
      ELEV   = -99999.
      CALL UFBINT(LUNIT,UAIR_8,4,255,NLEV,UAIR1);UAIR=UAIR_8
      IF(IPRINT.GT.1)  PRINT 1068, NLEV
 1068 FORMAT(' THIS REPORT CONTAINS',I4,' INPUT LEVELS OF SOUNDING ',
     $ 'DATA')
      IF(NLEV.EQ.0)  THEN
C.......................................................................
C PROBLEM: THE NUMBER OF DECODED "LEVELS" IS ZERO --
         if (subset.eq.'NC003002')  go to 98  ! Currently all of the
                                              ! cloud 1x1 reports
                                              ! have none (remove this
                                              ! if NESDIS ever combines
                                              ! cloud and PW/rad. 1x1's)
         PRINT 217
  217    FORMAT(/'##W3UNPKB7: NO UPPER-AIR (SOUNDING) DATA PROCESSED ',
     $   'FOR THIS  REPORT -- NLEV = 0'/)
         GO TO 98
C.......................................................................
      ELSE  IF(NLEV.GT.ILVLMX_12)  THEN
C PROBLEM: THE NO. OF DECODED "LEVELS" IS .GT. LIMIT OF "ILVLMX_12" --
         PRINT 2186, NLEV,ILVLMX_12,ILVLMX_12
 2186    FORMAT(/'##W3UNPKB7: NUMBER OF UPPER-AIR LEVELS FOR THIS ',
     $    'REPORT (=',I3,') EXCEEDS LIMIT OF ',I0,' CAT. 12 LEVELS -- ',
     $    'ONLY FIRST ',I0,' LEVELS WILL BE PROCESSED'/)
         NLEV = ILVLMX_12
C.......................................................................
      END IF
      DO I = 1,NLEV
         IF(IPRINT.GT.1)  PRINT 1079, I,ILC,ILVL
 1079 FORMAT(' ATTEMPTING NEW CAT. 12 INPUT LEVEL NUMBER',I4,' WITH ',
     $ 'ILC =',I5,'; NO. LEVELS PROCESSED TO NOW =',I5)
 
C       LEVEL PRESSURE, ELEVATION (STORED AS REAL)
 
         M = 1
         IF(IPRINT.GT.1)  PRINT 199, UAIR(1,I),M
  199 FORMAT(5X,'UAIR HERE IS: ',F17.4,'; INDEX IS: ',I3)
         IF(I.EQ.1)  THEN
            IF(UAIR(1,I).LT.999999.) PSFC = UAIR(1,I) * 0.01
            IF(UAIR(2,1).LT.XMISS)  THEN
               ELEV = UAIR(2,1)
            ELSE
C.......................................................................
C PROBLEM: THE ELEVATION IS MISSING --
               PRINT 6217
 6217          FORMAT(/'##W3UNPKB7: NO UPPER-AIR (SOUNDING) DATA ',
     $          'PROCESSED FOR THIS  REPORT -- ELEV IS MISSING'/)
               GO TO 98
C.......................................................................
            END IF
         ELSE  IF(UAIR(1,I)*0.1.GE.YMISS)  THEN
C WE DO NOT HAVE A VALID CATEGORY 12 LEVEL -- THERE IS NO VALID PRESSURE
C  -- GO ON TO NEXT INPUT LEVEL (IF SFC LEVEL MSG, CONTINUE PROCESSING)
            IF(IPRINT.GT.1)  PRINT'(" PRESSURE MISSING ON INPUT LEVEL ",
     $       I0,", SKIP THE PROCESSING OF THIS LEVEL")', I
            CYCLE
         ELSE  IF(UAIR(1,I)*0.01.GE.PSFC)  THEN
C WE DO NOT HAVE A VALID CATEGORY 12 LEVEL -- THE INPUT LEVEL PRESSURE
C  IS BELOW THE SURFACE PRESSURE -- GO ON TO THE NEXT INPUT LEVEL
            IF(IPRINT.GT.1)  PRINT'(" PRESSURE ON INPUT LEVEL ",I0,
     $       " IS BELOW GROUND, SKIP THE PROCESSING OF THIS LEVEL")', I
            CYCLE
         ELSE  IF(UAIR(2,I).LE.ELEV)  THEN
C WE DO NOT HAVE A VALID CATEGORY 12 LEVEL -- THE INPUT LEVEL 
C  GEOPOTENTIAL HEIGHT IS NOT GREATER THAN THE ELEVATION -- GO ON TO THE
C  NEXT INPUT LEVEL
            IF(IPRINT.GT.1)  PRINT'(" GEOPOTENTIAL HEIGHT ON INPUT ",
     $       "LEVEL ",I0," IS .LE. ELEVATION, SKIP THE PROCESSING OF ",
     $       "THIS LEVEL")', I
            CYCLE
         END IF

C WE HAVE A VALID CATEGORY 12 LEVEL -- THERE IS A VALID PRESSURE AND
C  THE GEOPOTENTIAL HEIGHT IS GREATER THAN THE ELEVATION

       IF(UAIR(1,I)*0.1.LT.XMISS)RDATX(IDATS_12+ILC)=NINT(UAIR(1,I)*0.1)
         ILVL = ILVL + 1
         IF(IPRINT.GT.1)  PRINT 198, IDATS_12+ILC,RDATX(IDATS_12+ILC)
  198 FORMAT(5X,'RDATA(',I5,') STORED AS: ',F10.2)
 
C       GEOPOTENTIAL HEIGHT (STORED AS REAL)
 
         M = 2
         IF(IPRINT.GT.1)  PRINT 199, UAIR(2,I),M
         IF(UAIR(2,I).LT.XMISS)  RDATX(IDATS_12+ILC+1) = NINT(UAIR(2,I))
         IF(IPRINT.GT.1) PRINT 198, IDATS_12+ILC+1,RDATX(IDATS_12+ILC+1)
         IF(I.EQ.1)  THEN
            IF(IPRINT.GT.1)  PRINT'(" THIS IS SURFACE LEVEL, SO STORE ",
     $       "HEIGHT ALSO AS ELEVATION IN HEADER")'
            IF(UAIR(2,1).LT.XMISS)  RDATX(7) = NINT(UAIR(2,1))
            NNNNN = 7
            IF(IPRINT.GT.1)  PRINT 198, NNNNN,RDATX(NNNNN)
         END IF
 
C       TEMPERATURE (STORED AS REAL)
 
         M = 3
         IF(IPRINT.GT.1)  PRINT 199, UAIR(3,I),M
         ITMP = NINT(UAIR(3,I)*100.)
         IF(UAIR(3,I).LT.XMISS)
     $    RDATX(IDATS_12+ILC+2) = NINT((ITMP - 27315) * 0.1)
         IF(IPRINT.GT.1) PRINT 198, IDATS_12+ILC+2,RDATX(IDATS_12+ILC+2)
 
C       DEWPOINT TEMPERATURE (STORED AS REAL)
 
         M = 4
         IF(IPRINT.GT.1)  PRINT 199, UAIR(4,I),M
         ITMP = NINT(UAIR(4,I)*100.)
         IF(UAIR(4,I).LT.XMISS)
     $    RDATX(IDATS_12+ILC+3) = NINT((ITMP - 27315) * 0.1)
         IF(IPRINT.GT.1) PRINT 198, IDATS_12+ILC+3,RDATX(IDATS_12+ILC+3)
 
C       GEOPOTENTIAL QUALITY MARKER (STORED AS REAL)
 
         RDATX(IDATS_12+ILC+6) = QMFLG
         IF(IPRINT.GT.1) PRINT 198, IDATS_12+ILC+6,RDATX(IDATS_12+ILC+6)
 
C       TEMPERATURE QUALITY MARKER (STORED AS REAL)
 
         RDATX(IDATS_12+ILC+7) = QMFLG
         IF(IPRINT.GT.1) PRINT 198, IDATS_12+ILC+7,RDATX(IDATS_12+ILC+7)
 
C       DEWPOINT TEMPERATURE QUALITY MARKER (STORED AS REAL)
 
         RDATX(IDATS_12+ILC+8) = QMFLG
         IF(IPRINT.GT.1) PRINT 198, IDATS_12+ILC+8,RDATX(IDATS_12+ILC+8)
C.......................................................................
         ILC = ILC + 9
         IF(I+1.LE.NLEV.AND.IPRINT.GT.1)  PRINT'(" HAVE COMPLETED ",
     $    "LEVEL ",I0,"; GOING INTO NEXT LEVEL WITH ILC=",I0)', ILVL,ILC

      ENDDO    
 
C       SET DATA LEVEL CATEGORY COUNTERS FOR CATEGORY 12 (SNDG) DATA
 
      IDATA(39) = ILVL
   98 CONTINUE
      IF(IPRINT.GT.1)  PRINT'(1X,I0," CAT. 12 LEVELS PROCESSED")',
     $ IDATA(39)
      IF(IDATA(39).GT.0)  IDATA(40) = IDATS_12
 
C***********************************************************************
C              FILL DATA LEVEL CATEGORY 8 PART OF OUTPUT
C        WILL ATTEMPT TO FILL "ILVLMX_08" (CURRENTLY 13) "LEVELS"
C
C LVL  1: LIFTED INDEX (DEG. K TO 10**2 PREC. - RELATIVE) -CODE FIG. 250
C LVL  2: TOTAL COLUMN PRECIP. WATER (MM TO 10**1 PREC.) - CODE FIG. 251
C LVL  3: 1. TO .9 SIGMA LYR P.WATER (MM TO 10**1 PREC.) - CODE FIG. 252
C LVL  4: .9 TO .7 SIGMA LYR P.WATER (MM TO 10**1 PREC.) - CODE FIG. 253
C LVL  5: .7 TO .3 SIGMA LYR P.WATER (MM TO 10**1 PREC.) - CODE FIG. 254
C LVL  6: SKIN TEMPERATURE (DEG. K TO 10**2 PREC.) ------- CODE FIG. 255
C LVL  7: CLOUD TOP TEMPERATURE (DEG. K TO 10**2 PREC.) -- CODE FIG. 256
C LVL  8: CLOUD TOP PRESSURE (MB TO 10**1 PREC.) --------- CODE FIG. 257
C LVL  9: CLOUD AMOUNT (C. FIG. BUFR TABLE 0-20-011) ----- CODE FIG. 258
C LVL 10: INSTR. DATA USED IN PROC.
C                      (C. FIG. BUFR TABLE 0-02-021) ----- CODE FIG. 259
C LVL 11: SOLAR ZENITH ANGLE (SOLAR ELEV) (DEG. TO 10**2 PREC.)
C                                                       -- CODE FIG. 260
C LVL 12: SATELLITE ZENITH ANGLE (ELEV) (DEG. TO 10**2 PREC.)
C                                                       -- CODE FIG. 261
C LVL 13: SURFACE PRESSURE (MB TO 10**1 PREC.) ----------- CODE FIG. 262
C
C     IF DATA ONE ANY LEVEL ARE MISSING, THAT LEVEL IS NOT PROCESSED
C***********************************************************************
 
      ILVL = 0
      ILC = 0
      CAT8_8 = BMISS
      nlev8 = 0
      CALL UFBINT(LUNIT,CAT8_8,12,1,NLEV8,CAT8A//CAT8B)

C  Get total cloud cover for GOES cloud reports (in msg type NC003002)
C  -------------------------------------------------------------------

      CALL UFBINT(LUNIT,TOCC_8,1,1,NRET,'TOCC')
      RDATA2(25)=TOCC_8

C  Sometime in mid-2004, "TPWT" will replace "PH2O" for tpw - if one
C   is missing, look for the other (for historical reruns)
C  -----------------------------------------------------------------

      IF(IBFMS(CAT8_8(2)).NE.0)
     $ CALL UFBINT(LUNIT,CAT8_8(2),1,1,LLEV8,'TPWT')
      CAT8(1:12)=CAT8_8
      CAT8(13) = PSFC
      IF(NLEV8.NE.1)  THEN
         IF(NLEV8.EQ.0)  THEN
C.......................................................................
C PROBLEM: THE NUMBER OF DECODED "LEVELS" IS ZERO --
            PRINT 318
  318 FORMAT(/'##W3UNPKB7: NO ADDITIONAL (CAT. 8) DATA PROCESSED FOR ',
     $ 'THIS  REPORT -- NLEV8 = 0'/)
            GO TO 99
C.......................................................................
         ELSE
C.......................................................................
C PROBLEM: THE NUMBER OF DECODED "LEVELS" IS NOT WHAT IS EXPECTED --
C  SET IRET = 7 AND RETURN
            PRINT 219, NLEV8
  219 FORMAT(/'##W3UNPKB7: THE NUMBER OF DECODED "LEVELS" (=',I5,') ',
     $ 'IS NOT WHAT IS EXPECTED (1) - IRET = 7'/)
            IRET = 7
            RETURN
C.......................................................................
         END IF
      END IF

C THE TEMPERATURE CHANNEL SELECTION FLAG WILL BE USED LATER TO
C  DETERMINE Q. MARK FOR SKIN TEMPERATURE (IF 0 - OK, OTHERWISE - BAD)

      RTCSF_8 = BMISS
      CALL UFBINT(LUNIT,RTCSF_8,1,1,NLEV0,'TCSF');RTCSF=RTCSF_8
      ITCSF = 1
      M = 1
      IF(IPRINT.GT.1)  PRINT 299, RTCSF,M
  299 FORMAT(5X,'RTCSF HERE IS: ',F17.4,'; INDEX IS: ',I3)
      IF(RTCSF.LT.XMISS)  ITCSF = NINT(RTCSF)
      IF(IPRINT.GT.1)  PRINT 1798, ITCSF
 1798 FORMAT(5X,'ITCSF IS: ',I10)

C LOOP THROUGH THE "ILVLMX_08" POSSIBLE ADDITIONAL DATA "LEVELS"

      DO M = 1,ILVLMX_08
         IF(IPRINT.GT.1)  PRINT 6079, M,ILC,ILVL
 6079 FORMAT(' ATTEMPTING MISCEL. INPUT',I5,' WITH ILC =',I5,'; NO. ',
     $ 'OUTPUT CAT.  8 LVLS PROCESSED TO NOW =',I5)
         IF(IPRINT.GT.1)  PRINT 399, CAT8(M),M
  399 FORMAT(5X,'CAT8 HERE IS: ',F17.4,'; INDEX IS: ',I3)
         IF(CAT8(M).LT.ZMISS(M))  THEN

C WE HAVE A VALID CATEGORY 8 DATA "LEVEL"

            ILVL = ILVL + 1

C STORE THE DATUM IN WORD 1 OF THE CAT. 8 DATA LEVEL

            RDATX(IDATS_08+ILC) = CAT8(M)*SCALE(M)
            IF(IPRINT.GT.1)  PRINT 198, IDATS_08+ILC,RDATX(IDATS_08+ILC)

C STORE THE CAT. 8 CODE FIGURE IN WORD 2 OF THE CAT. 8 DATA LEVEL

            RDATX(IDATS_08+ILC+1) = REAL(200+ICDFG(M))
           IF(IPRINT.GT.1)PRINT 198,IDATS_08+ILC+1,RDATX(IDATS_08+ILC+1)

C STORE THE DATUM QUALITY MARKER IN WORD 3 OF THE CAT. 8 DATA LEVEL

            RDATX(IDATS_08+ILC+2) = QMFLG

C IF THIS DATUM IS SKIN TEMPERATURE AND THE TEMPERATURE CHANNEL
C  SELECTION FLAG IS BAD (.NE. 0), SET QUALITY MARKER TO 13.0 (BAD)

            IF(M.EQ.6.AND.ITCSF.NE.0)  RDATX(IDATS_08+ILC+2) = 13.0
           IF(IPRINT.GT.1)PRINT 198,IDATS_08+ILC+2,RDATX(IDATS_08+ILC+2)

C.......................................................................

            ILC = ILC + 4
            IF(M.LT.ILVLMX_08.AND.IPRINT.GT.1) PRINT'(" HAVE COMPLETED",
     $       " OUTPUT LVL",I0,"; GOING INTO NEXT INPUT DATUM WITH ILC=",
     $       I0)', ILVL,ILC
         ELSE
            IF(IPRINT.GT.1)  PRINT'(" DATUM MISSING ON INPUT ",I0,
     $       ", GO ON TO NEXT INPUT DATUM (NO. LVLS PROCESSED SO FAR=",
     $       I0,"; ILC=",I0,")")', M,ILVL,ILC
         END IF
      ENDDO
 
C       SET DATA LEVEL CATEGORY COUNTERS FOR CATEGORY 8 (ADD'L) DATA
 
      IDATA(27) = ILVL
   99 CONTINUE
      IF(IPRINT.GT.1)  PRINT'(1X,I0," CAT. 08 LEVELS PROCESSED")',
     $ IDATA(27)
      IF(IDATA(27).GT.0)  IDATA(28) = IDATS_08

C***********************************************************************
C          FILL DATA LEVEL CATEGORY 13 PART OF OUTPUT (RADIANCES)
C***********************************************************************

      ILVL = 0
      ILC =  0
      RAD_8 = BMISS
      CALL UFBINT(LUNIT,RAD_8,2,255,NLEV13,RAD1);RAD=RAD_8
      IF(IPRINT.GT.1)  PRINT 2068, NLEV13
 2068 FORMAT(' THIS REPORT CONTAINS',I4,' INPUT LEVELS (CHANNELS) OF ',
     $ 'RADIANCE DATA')
      IF(NLEV13.EQ.0)  THEN
C.......................................................................
C PROBLEM: THE NUMBER OF DECODED "LEVELS" IS ZERO --
         if (subset.eq.'NC003002')  go to 100 ! Currently all of the
                                              ! cloud 1x1 reports
                                              ! have none (remove this
                                              ! if NESDIS ever combines
                                              ! cloud and PW/rad. 1x1's)
         PRINT 417
  417    FORMAT(/'##W3UNPKB7: NO RADIANCE DATA PROCESSED FOR THIS ',
     $    'REPORT -- NLEV13 = 0'/)
         GO TO 100
C.......................................................................
      ELSE  IF(NLEV13.GT.ILVLMX_13)  THEN
C PROBLEM: THE NO. OF DECODED "LEVELS" IS .GT. LIMIT OF "ILVLMX_13" --
         PRINT 2187, NLEV13,ILVLMX_13,ILVLMX_13
 2187    FORMAT(/'##W3UNPKB7: NUMBER OF RADIANCE CHANNELS FOR THIS ',
     $    'REPORT (=',I3,') EXCEEDS LIMIT OF ',I0,' CAT. 13 CHANNELS ',
     $    '-- ONLY FIRST ',I0,' CHANNELS WILL BE PROCESSED'/)
         NLEV13 = ILVLMX_13
C.......................................................................
      END IF
      DO I = 1,NLEV13
         IF(IPRINT.GT.1)  PRINT 2079, I,ILC,ILVL
 2079 FORMAT(' ATTEMPTING NEW CAT. 13 INPUT "LEVEL" NUMBER',I4,' WITH ',
     $ 'ILC =',I5,'; NO. LEVELS (CHANNELS) PROCESSED TO NOW =',I5)
 
C       CHANNEL NUMBER (STORED AS INTEGER)
 
         M = 1
         IF(IPRINT.GT.1)  PRINT 499, RAD(1,I),M
  499 FORMAT(5X,'RAD  HERE IS: ',F17.4,'; INDEX IS: ',I3)
         IF(RAD(1,I).GE.YMISS)  THEN
C WE DO NOT HAVE A VALID CATEGORY 13 DATA LEVEL -- THERE IS NO VALID
C  CHANNEL NUMBER -- GO ON TO NEXT INPUT LEVEL
            IF(IPRINT.GT.1)  PRINT'(" CHANNEL NUMBER MISSING ON INPUT",
     $       " LEVEL ",I0,", SKIP THE PROCESSING OF THIS LEVEL")', I
            CYCLE
         END IF

C WE HAVE A VALID CATEGORY 13 DATA LEVEL -- THERE IS A VALID CHANNEL
C  NUMBER

         IDATA(IDATS_13+ILC) = NINT(RAD(1,I))
         ILVL = ILVL + 1
         IF(IPRINT.GT.1)  PRINT 197, IDATS_13+ILC,IDATA(IDATS_13+ILC)
  197 FORMAT(5X,'IDATA(',I5,') STORED AS: ',I10)
 
C       BRIGHTNESS TEMPERATURE (STORED AS REAL)
 
         M = 2
         IF(IPRINT.GT.1)  PRINT 499, RAD(2,I),M
         IF(RAD(2,I).LT.XMISS)  RDATX(IDATS_13+ILC+1) = RAD(2,I)
         IF(IPRINT.GT.1) PRINT 198, IDATS_13+ILC+1,RDATX(IDATS_13+ILC+1)
 
C       QUALITY MARKERS (STORED AS REAL) -- CURRENTLY HARDWIRED TO 2.0
C         (NEUTRAL - DEFAULT)
 
         RDATX(IDATS_13+ILC+2) = 2.0
         IF(IPRINT.GT.1) PRINT 198, IDATS_13+ILC+2,RDATX(IDATS_13+ILC+2)

C.......................................................................

         ILC = ILC + 3
         IF(I+1.LE.NLEV13.AND.IPRINT.GT.1)  PRINT'(" HAVE COMPLETED ",
     $    "LEVEL ",I0,"; GOING INTO NEXT LEVEL WITH ILC=",I0)', ILVL,ILC

  210    CONTINUE
      ENDDO    
 
C       SET CATEGORY COUNTERS FOR DATA LVL CATEGORY 13 (RADIANCE) DATA
 
      IDATA(41) = ILVL
  100 CONTINUE
      IF(IPRINT.GT.1)  PRINT'(1X,I0," CAT. 13 LEVELS PROCESSED")',
     $ IDATA(41)
      IF(IDATA(41).GT.0)  IDATA(42) = IDATS_13

      IF(IDATA(27)+IDATA(39)+IDATA(41).EQ.0)  IRET = 5

      IF(IPRINT.GT.1)  PRINT'(" IDATA(39)=",I0,"; IDATA(40)=",I0,
     $ "; IDATA(27)=",I0,"; IDATA(28)=",I0,"; IDATA(41)=",I0,
     $ "; IDATA(42)=",I0)', IDATA(39),IDATA(40),IDATA(27),IDATA(28),
     $ IDATA(41),IDATA(42)

      RDATA(1:IDMAX) = RDATX(1:IDMAX)
      RETURN
      END

C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    UNPKB709
C   PRGMMR: JWhiting         ORG: EMC        DATE: 2016-08-15
C
C ABSTRACT: FOR REPORT (SUBSET) READ OUT OF BUFR MESSAGE (PASSED IN
C   INTERNALLY VIA BUFRLIB STORAGE), CALLS BUFRLIB ROUTINE TO DECODE
C   GPS-IPW (INTEGRATED PRECIPITABLE WATER) DATA.  GPS-IPW DATA ARE
C   THEN FILLED INTO THE OUTPUT ARRAY AS DATA LEVEL CATEGORY 14.  THE
C   OUTPUT ARRAY HOLDS A SINGLE GPS-IPW REPORT IN THE QUASI-IW3UNPBF
C   UNPACKED FORMAT.
C
C PROGRAM HISTORY LOG:
C 2002-07-03  D. A. KEYSER NP22 - ORIGINAL AUTHOR
C 2016-08-15  JWhiting - Added variable 'subset' to arg list; tested 
C     on 'subset' to determine if new GNSS/GPS-Met zenith total delay 
C     data fields need to be read (this replaces potentially ambiguous
C     test on missing TDEL data from previous GPS-IPW data streams).
C
C USAGE:    CALL UNPKB709(LUNIT,RDATA,SUBSET)
C   INPUT ARGUMENT LIST:
C     LUNIT    - FORTRAN UNIT NUMBER FOR INPUT DATA FILE
C     RDATA    - SINGLE GPS-IPW REPORT IN A QUASI-IW3UNPBF UNPACKED
C              - FORMAT WITH ONLY HEADER INFORMATION FILLED IN (ALL
C              - OTHER DATA REMAINS MISSING)
C     SUBSET   - CHARACTER*8 BUFR MESSAGE TYPE (SAME FOR ALL REPORTS
C              - IN A COMMON BUFR MESSAGE)
C
C   OUTPUT ARGUMENT LIST:
C     RDATA    - SINGLE GPS-IPW REPORT IN A QUASI-IW3UNPBF UNPACKED
C              - FORMAT WITH GPS-IPW INFORMATION FILLED IN (ALL DATA
C              - FOR REPORT NOW FILLED)
C
C   OUTPUT FILES:
C     UNIT 06  - PRINTOUT
C
C REMARKS: CALLED BY SUBROUTINE W3UNPKB7.
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE:  NCEP WCOSS
C
C$$$
      SUBROUTINE UNPKB709(LUNIT,RDATA,subset)

C  Include parameters common to more than one subroutine
C  -----------------------------------------------------

      include 'inc_w3unpkb7.inc'

      CHARACTER*50  CAT14S
      character*8   subset
      INTEGER  IDATA(IDMAX)
      LOGICAL  SKIP_CAT12
      REAL(8) CAT14_8(10),BMISS,gnssrpsq_8(6,255)
      REAL  CAT14(10),RDATA(*),RDATX(IDMAX)
      COMMON /PKB7AA/BMISS
      COMMON /PKB7BB/kdate(8),ldate(8),KTIMCH,IPRINT,SKIP_CAT12
      COMMON /PKB7GG/IDATS_04,IDATS_08,IDATS_10,IDATS_11,IDATS_12,
     $ IDATS_13,IDATS_14,IDATS_15
 
      SAVE
 
      EQUIVALENCE (RDATX,IDATA)
      DATA  XMISS/99999./
      DATA  CAT14S/'PRES TMDB REHU TPWT TDEL ETDL HSDL EHSD WMTM WDMF '/
      RDATX(1:IDMAX) = RDATA(1:IDMAX)
      CAT14_8 = BMISS
      CALL UFBINT(LUNIT,CAT14_8,10,1,NLEV,CAT14S);CAT14=CAT14_8
      IF(NLEV.NE.1)  THEN
C.......................................................................
C PROBLEM: THE NUMBER OF DECODED "LEVELS" IS NOT WHAT IS EXPECTED --
         PRINT 217, NLEV
  217 FORMAT(/'##W3UNPKB7: THE NUMBER OF DECODED "LEVELS" (=',I5,') ',
     $ 'IS NOT WHAT IS EXPECTED (1) - NO GPS-IPW DATA PROCESSED'/)
         GO TO 99
C.......................................................................
      END IF
 
C       STATION PRESSURE (STORED AS REAL - MB TO 10**1 PRECISION)
 
      M = 1
      IF(IPRINT.GT.1)  PRINT 199, CAT14(M),M
  199 FORMAT(5X,'CAT14 HERE IS: ',F17.4,'; INDEX IS: ',I3)
      IF((CAT14(M)*0.01).LT.XMISS) RDATX(IDATS_14) = CAT14(M) * 0.01
      NNNNN = IDATS_14
      IF(IPRINT.GT.1)  PRINT 198, NNNNN,RDATX(IDATS_14)
  198 FORMAT(5X,'RDATA(',I5,') STORED AS: ',F10.2)
 
C       AIR TEMPERATURE (STORED AS REAL - KELVIN TO 10**2 PRECISION)
 
      M = 2
      if(cat14(m).ge.xmiss)  then
         call ufbint(lunit,cat14_8(m),10,1,nlev,'TMDBST')
         cat14(m) = cat14_8(m)
      endif
      IF(IPRINT.GT.1)  PRINT 199, CAT14(M),M
      IF(CAT14(M).LT.XMISS)  RDATX(IDATS_14+1) = CAT14(M)
      NNNNN = IDATS_14 + 1
      IF(IPRINT.GT.1)  PRINT 198, NNNNN,RDATX(IDATS_14+1)
 
C       RELATIVE HUMIDITY (STORED AS REAL - PERCENT TO 10**0 PRECISION)
 
      M = 3
      IF(IPRINT.GT.1)  PRINT 199, CAT14(M),M
      IF(CAT14(M).LT.XMISS)  RDATX(IDATS_14+2) = CAT14(M)
      NNNNN = IDATS_14 + 2
      IF(IPRINT.GT.1)  PRINT 198, NNNNN,RDATX(IDATS_14+2)
 
C       TOTAL PRECIPITABLE WATER (STORED AS REAL - MM TO 10**3 PREC.)
 
      M = 4
      IF(IPRINT.GT.1)  PRINT 199, CAT14(M),M
      IF(CAT14(M).LT.XMISS)  RDATX(IDATS_14+3) = CAT14(M)
      NNNNN = IDATS_14 + 3
      IF(IPRINT.GT.1)  PRINT 198, NNNNN,RDATX(IDATS_14+3)
 
C       ZENITH TOTAL DELAY (STORED AS REAL - M TO 10**4 PRECISION)
 
      M = 5
      if (subset.eq.'NC012004') then ! new GPS-Met feed
         call ufbrep(lunit,gnssrpsq_8,6,255,irep,
     $   'SCLF PTID BEARAZ ELEV APDS APDE')

C        ZTD is obtained from "atmospheric path delay in satellite
C         signal" (m) from replication where azimuth angle is zero deg.
C         and elevation angle is 90 deg.)
C        Likewise, the Error in ZTD (used below) is obtained from
C         "error in atmospheric path delay in satellite signal" (m) from
C         this same replication.
C         (slant angles are discarded for now)

         do jrep = 1,irep
            if(gnssrpsq_8(3,jrep).eq.0..and.gnssrpsq_8(4,jrep).eq.90.)
     $       then
               cat14_8(m:m+1) = gnssrpsq_8(5:6,jrep)
               cat14(m:m+1) = cat14_8(m:m+1)
               exit
            end if
         enddo
      end if
      IF(IPRINT.GT.1)  PRINT 199, CAT14(M),M
      IF(CAT14(M).LT.XMISS)  RDATX(IDATS_14+4) = CAT14(M)
      NNNNN = IDATS_14 + 4
      IF(IPRINT.GT.1)  PRINT 198, NNNNN,RDATX(IDATS_14+4)
 
C       ERROR IN ZENITH TOTAL DELAY (STORED AS REAL - M TO 10**4 PREC.)
 
      M = 6
      IF(IPRINT.GT.1)  PRINT 199, CAT14(M),M
      IF(CAT14(M).LT.XMISS)  RDATX(IDATS_14+5) = CAT14(M)
      NNNNN = IDATS_14 + 5
      IF(IPRINT.GT.1)  PRINT 198, NNNNN,RDATX(IDATS_14+5)
 
C       HYDROSTATIC DELAY (STORED AS REAL - M TO 10**4 PRECISION)
 
      M = 7
      IF(IPRINT.GT.1)  PRINT 199, CAT14(M),M
      IF(CAT14(M).LT.XMISS)  RDATX(IDATS_14+6) = CAT14(M)
      NNNNN = IDATS_14 + 6
      IF(IPRINT.GT.1)  PRINT 198, NNNNN,RDATX(IDATS_14+6)
 
C       ERROR IN HYDROSTATIC DELAY (STORED AS REAL - M TO 10**4 PREC.)
 
      M = 8
      IF(IPRINT.GT.1)  PRINT 199, CAT14(M),M
      IF(CAT14(M).LT.XMISS)  RDATX(IDATS_14+7) = CAT14(M)
      NNNNN = IDATS_14 + 7
      IF(IPRINT.GT.1)  PRINT 198, NNNNN,RDATX(IDATS_14+7)
 
C       WEIGHTED MEAN TEMPERATURE (STORED AS REAL - K TO 10**2 PREC.)
 
      M = 9
      IF(IPRINT.GT.1)  PRINT 199, CAT14(M),M
      IF(CAT14(M).LT.XMISS)  RDATX(IDATS_14+8) = CAT14(M)
      NNNNN = IDATS_14 + 8
      IF(IPRINT.GT.1)  PRINT 198, NNNNN,RDATX(IDATS_14+8)
 
C       WET DELAY MAPPING FUNCTION (STORED AS REAL -
C        NUMERIC TO 10**3 PRECISION)
 
      M = 10
      IF(IPRINT.GT.1)  PRINT 199, CAT14(M),M
      IF(CAT14(M).LT.XMISS)  RDATX(IDATS_14+9) = CAT14(M)
      NNNNN = IDATS_14 + 9
      IF(IPRINT.GT.1)  PRINT 198, NNNNN,RDATX(IDATS_14+9)
 
C       SET DATA LEVEL CATEGORY COUNTERS FOR GPS-IPW DATA
 
      IDATA(43) = 1
      IDATA(44) = IDATS_14
   99 CONTINUE
      IF(IPRINT.GT.1)  PRINT'("IDATA(43)=",I0)', IDATA(43)
      RDATA(1:IDMAX) = RDATX(1:IDMAX)
      RETURN
      END

C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    UNPKB710
C   PRGMMR: D. A. KEYSER     ORG: NP22       DATE: 2004-02-02
C
C ABSTRACT: FOR REPORT (SUBSET) READ OUT OF BUFR MESSAGE (PASSED IN
C   INTERNALLY VIA BUFRLIB STORAGE), CALLS BUFRLIB ROUTINE TO DECODE
C   UPPER-AIR DATA FOR NPN OR CAP RASS REPORT.  UPPER-AIR DATA ARE THEN
C   FILLED INTO THE OUTPUT ARRAY AS DATA LEVEL CATEGORY 15.  THE OUTPUT
C   ARRAY HOLDS A SINGLE RASS REPORT IN THE QUASI-IW3UNPBF UNPACKED
C   FORMAT.
C
C PROGRAM HISTORY LOG:
C 2004-02-02  D. A. KEYSER NP22 - ORIGINAL AUTHOR
C
C USAGE:    CALL UNPKB710(LUNIT,RDATA)
C   INPUT ARGUMENT LIST:
C     LUNIT    - FORTRAN UNIT NUMBER FOR INPUT DATA FILE
C     RDATA    - SINGLE RASS REPORT IN A QUASI-IW3UNPBF UNPACKED
C              - FORMAT WITH ONLY HEADER INFORMATION FILLED IN
C              - (CATEGORY 15 DATA MISSING)
C
C   OUTPUT ARGUMENT LIST:
C     RDATA    - SINGLE RASS REPORT IN A QUASI-IW3UNPBF UNPACKED
C              - FORMAT WITH CATEGORY 15 INFORMATION FILLED IN (ALL
C              - DATA FOR REPORT NOW FILLED)
C
C   OUTPUT FILES:
C     UNIT 06  - PRINTOUT
C
C REMARKS: CALLED BY SUBROUTINE W3UNPKB7.
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE:  NCEP WCOSS
C
C$$$
      SUBROUTINE UNPKB710(LUNIT,RDATA)

C  Include parameters common to more than one subroutine
C  -----------------------------------------------------

      include 'inc_w3unpkb7.inc'

      CHARACTER*20  CAT15S
      INTEGER  IDATA(IDMAX)
      LOGICAL  SKIP_CAT12
      REAL(8) CAT15_8(4,255),BMISS
      REAL  CAT15(4,255),RDATA(*),RDATX(IDMAX)
      COMMON /PKB7AA/BMISS
      COMMON /PKB7BB/kdate(8),ldate(8),KTIMCH,IPRINT,SKIP_CAT12
      COMMON /PKB7GG/IDATS_04,IDATS_08,IDATS_10,IDATS_11,IDATS_12,
     $ IDATS_13,IDATS_14,IDATS_15
 
      SAVE
 
      EQUIVALENCE (RDATX,IDATA)
      DATA  XMISS/99999./
      DATA  CAT15S/'HEIT TMVR QMAT NPQC '/
      RDATX(1:IDMAX) = RDATA(1:IDMAX)
      NSFC = 0
      ILVL = 0
      ILC =  0
C FIRST CATEGORY 15 DATA LEVEL CONTAINS ONLY HEIGHT (ELEV)
      IF(IPRINT.GT.1)  PRINT 1078, ILC,ILVL
 1078 FORMAT(' ATTEMPTING 1ST (SFC) LVL WITH ILC =',I5,'; NO. LEVELS ',
     $ 'PROCESSED TO NOW =',I5)
      RDATX(IDATS_15+ILC) = RDATX(7)
      IF(IPRINT.GT.1)  PRINT 198, IDATS_15+ILC,RDATX(IDATS_15+ILC)
  198 FORMAT(5X,'RDATA(',I5,') STORED AS: ',F10.2)
      IF(RDATX(IDATS_15+ILC).LT.XMISS)  NSFC = 1
      ILVL = ILVL + 1
      ILC = ILC + 3
      IF(IPRINT.GT.1) PRINT'(" HAVE COMPLETED LEVEL ",I0," WITH NSFC=",
     $ I0,"; GOING INTO NEXT LEVEL WITH ILC=",I0)', ILVL,NSFC,ILC
      CAT15_8 = BMISS
      CALL UFBINT(LUNIT,CAT15_8,4,255,NLEV,CAT15S);CAT15=CAT15_8
      IF(IPRINT.GT.1)  PRINT 1068, NLEV
 1068 FORMAT(' THIS REPORT CONTAINS ',I3,' LEVELS OF DATA (NOT ',
     $ 'INCLUDING BOTTOM -SURFACE- LEVEL)')
      IF(NLEV.EQ.0)  THEN
C.......................................................................
C PROBLEM: THE NUMBER OF DECODED "LEVELS" IS ZERO --
         IF(NSFC.EQ.0)  THEN
C ... NO UPPER AIR DATA PROCESSED
            PRINT 217
  217       FORMAT(/'##W3UNPKB7: NO UPPER-AIR DATA PROCESSED FOR THIS',
     $       ' REPORT -- NLEV = 0 AND NSFC = 0'/)
            GO TO 99
         ELSE
C ... ONLY FIRST (SURFACE) UPPER AIR LEVEL DATA PROCESSED
            PRINT 218
  218 FORMAT(/'##W3UNPKB7: NO UPPER-AIR DATA ABOVE FIRST (SURFACE) ',
     $ 'LEVEL PROCESSED FOR THIS REPORT -- NLEV = 0 AND NSFC > 0'/)
            GO TO 98
         END IF
C.......................................................................
      ELSE  IF(NLEV.GT.ILVLMX_15)  THEN
C PROBLEM: THE NUMBER OF DECODED "LEVELS" {EXCLUDING BOTTOM (SURFACE)
C  LEVEL} IS .GT. LIMIT OF "ILVLMX_15" --
         PRINT 2186, NLEV,ILVLMX_15,ILVLMX_15
 2186    FORMAT(/'##W3UNPKB7: NUMBER OF UPPER-AIR LEVELS FOR THIS ',
     $    'REPORT (=',I3,') EXCEEDS LIMIT OF ',I0,' CAT. 15 LEVELS ',
     $    '(EXCLUDING BOTTOM, SFC, LVL) -- '/'     ONLY FIRST ',I0,
     $    ' UPPER-AIR LEVELS PLUS THE SURFACE LEVEL WILL BE PROCESSED'/)
         NLEV = ILVLMX_15
C.......................................................................
      END IF
      DO I = 1,NLEV
         IF(IPRINT.GT.1)  PRINT 1079, ILC,ILVL
 1079 FORMAT(' ATTEMPTING NEW LEVEL WITH ILC =',I5,'; NO. LEVELS ',
     $ 'PROCESSED TO NOW =',I5)
 
C       HEIGHT ABOVE SEA-LEVEL (STORED AS REAL - METERS TO 10**0 PREC.)
 
         M = 1
         IF(IPRINT.GT.1)  PRINT 199, CAT15(1,I),M
  199 FORMAT(5X,'CAT15 HERE IS: ',F17.4,'; INDEX IS: ',I3)
         IF(CAT15(1,I).LT.XMISS)  THEN
            RDATX(IDATS_15+ILC) = NINT(CAT15(1,I))

C       ... WE HAVE A VALID CATEGORY 15 DATA LEVEL -- THERE IS A VALID
C            HEIGHT

            ILVL = ILVL + 1
         ELSE

C       ... WE DO NOT HAVE A VALID CATEGORY 15 DATA LEVEL -- THERE IS
C            NO VALID HEIGHT GO ON TO NEXT INPUT LEVEL

            IF(IPRINT.GT.1)  PRINT'(" HEIGHT MISSING ON INPUT LEVEL ",
     $       I0,", ALL OTHER DATA SET TO MSG ON THIS LEVEL")', I
            CYCLE
         END IF
         IF(IPRINT.GT.1)  PRINT 198, IDATS_15+ILC,RDATX(IDATS_15+ILC)
 
C       VIRTUAL TEMPERATURE (STORED AS REAL - KELVIN TO 10**2 PRECISION)
 
         M = 2
         IF(IPRINT.GT.1)  PRINT 199, CAT15(2,I),M
         IF(CAT15(2,I).LT.XMISS)  RDATX(IDATS_15+ILC+1) = CAT15(2,I)
         IF(IPRINT.GT.1) PRINT 198, IDATS_15+ILC+1,RDATX(IDATS_15+ILC+1)
 
C       QUALITY CODE (STORED AS INTEGER - NUMERIC)
C          IF SDMEDIT/QUIPS TEMPERATURE QUALITY MARKER IS 12 (REJECT
C          LIST) OR 14 (SDM PURGE) THEN A VALUE OF 14 IS STORED FOR THE
C          QUALITY CODE; OTHERWISE THE DECODED QUALITY CODE IS STORED
C          DIRECTLY
 
         M = 3
         IF(IPRINT.GT.1)  PRINT 199, CAT15(3,I),M
         M = 4
         IF(IPRINT.GT.1)  PRINT 199, CAT15(4,I),M
         IF(CAT15(3,I).EQ.12.OR.CAT15(3,I).EQ.14)  THEN
            IDATA(IDATS_15+ILC+2) = 14
         ELSE  IF(CAT15(4,I).LT.XMISS) THEN
            IDATA(IDATS_15+ILC+2) = NINT(CAT15(4,I))
         END IF
         IF(IPRINT.GT.1) PRINT 197, IDATS_15+ILC+2,IDATA(IDATS_15+ILC+2)
  197 FORMAT(5X,'IDATA(',I5,') STORED AS: ',I10)
C.......................................................................
         ILC = ILC + 3
         IF(IPRINT.GT.1)  PRINT'(" HAVE COMPLETED LEVEL ",I0,"; GOING ",
     $    "INTO NEXT LEVEL WITH ILC=",I0)', ILVL,ILC
      ENDDO    
 
C       SET DATA LEVEL CATEGORY COUNTERS FOR UPPER-AIR DATA
 
   98 CONTINUE
      IDATA(45) = ILVL
      IDATA(46) = IDATS_15
   99 CONTINUE
      IF(IPRINT.GT.1)  PRINT'(" NSFC=",I0,"; IDATA(45)=",I0,
     $ "; IDATA(46)=",I0)', NSFC,IDATA(45),IDATA(46)
      RDATA(1:IDMAX) = RDATX(1:IDMAX)
      RETURN
      END

