C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    IW3UNPBF
C   PRGMMR: DONG/WHITING     ORG: NP22       DATE: 2020-08-20
C
C ABSTRACT: READS AND UNPACKS ONE REPORT FROM INPUT NCEP BUFR DUMP
C   FILE INTO SPECIFIED FORMAT.  FUNCTION RETURNS THE UNPACKED REPORT
C   TO THE CALLING PROGRAM IN THE ARRAY 'OBS' AS WELL AS IN VARIABLES
C   'STNID', 'CRES1', 'CRES2', 'OBS2', 'OBS3' AND 'OBS8_8'.  IT ALSO
C   RETURNS INFORMATION ABOUT THE INPUT DATA SET ITSELF (NAME, CENTER
C   DATE, DUMP TIME) AND THE BUFR MESSAGE TYPE.  VARIOUS CONTINGENCIES
C   ARE COVERED BY RETURN VALUE OF THE FUNCTION AND PARAMETER 'IER' -
C   FUNCTION AND IER HAVE SAME VALUE.  REPEATED CALLS OF FUNCTION WILL
C   RETURN A SEQUENCE OF UNPACKED REPORTS.  THE CALLING PROGRAM MAY
C   SWITCH TO A NEW 'NUNIT' AT ANY TIME, THAT DATASET WILL THEN BE READ
C   IN SEQUENCE.  IF USER SWITCHES BACK TO A PREVIOUS 'NUNIT', THAT
C   DATA SET WILL BE READ FROM THE BEGINNING, NOT FROM WHERE THE USER
C   LEFT OFF (THIS IS A 'SOFTWARE TOOL', NOT AN ENTIRE I/O SYSTEM).
C   ARGUMENT 'IER' IS ALSO CHECKED UPON INPUT THE FIRST TIME A NEW
C   'NUNIT' IS PASSED IN. C   IF 'IER' IS -1 IN THIS CASE, THIS
C   INDICATES THAT THE FILE ASSOCIATED WITH "NUNIT" HAS ALREADY BEEN
C   OPENED BY THE CORRESPONDING INTERFACE SUBROUTINE W3UNPKB7 AND SOME
C   REPORTS HAVE BEEN PROCESSED.  IN THIS CASE, THIS ROUTINE WILL
C   CONTINUE READING AND PROCESSING REPORTS FROM 'NUNIT' (OTHERWISE IER
C   SHOULD BE INPUT AS ZERO THE FIRST TIME A NEW 'NUNIT' IS PASSED IN).
C
C PROGRAM HISTORY LOG:
C 1998-02-17  D. A. KEYSER -- ORIGINAL AUTHOR (ADAPTED FROM W3LIB
C     ROUTINE IW3GAD)
C 1998-03-16  D. A. KEYSER -- BUMPED UP ARRAY SIZE FOR UNPACKED
C     REPORT IN "OBS" FROM 1608 TO 2500; SUBROUTINE NO LONGER RETURNS
C     WITH IER=999 IF UNPACKED ARRAY SIZE IS EXCEEDED - RATHER IT SKIPS
C     PROCESSING OF OFFENDING REPORT AND PRINTS A DIAGNOSTIC; BUMP UP
C     MAXIMUM NUMBER OF LEVELS THAT CAN BE PROCESSED FOR A CATEGORY
C     FROM 150 TO 160
C 1998-06-15  D. A. KEYSER -- STREAMLINED THE PROCESSING OF FLIGHT-
C     LEVEL RECONNAISSANCE REPORTS; REDEFINED UNITS FOR UNPACKED WORDS
C     1 (LATITUDE), 2 (LONGITUDE), 4 (OBS. TIME) AND 11 (RECEIPT TIME)
C     - ALL TO STREAMLINE PROCESSING IN PREPDATA PROGRAM; IN ADPUPA
C     PROCESSING, REMOVED WRITING OF CAT. 8 C.F. 106, ADDED WRITING OF
C     NEW CAT. 8 C.F. 353 (SOLAR AND INFRARED RADIATION CORRECTION
C     INDICATOR) AND 354 (TRACKING TECHNIQUE/STATUS OF SYSTEM USED
C     INDICATOR)
C 1998-09-21  D. A. KEYSER -- SUBROUTINE NOW Y2K AND FORTRAN 90
C     COMPLIANT
C 1999-01-20 D. A. KEYSER -- INCORPORATED BOB KISTLER'S CHANGES NEEDED
C     TO PORT THE CODE TO THE IBM SP; ADDED REPORT SUBTYPE 1 FOR RECCOS
C     UNDER REPORT TYPE 31 AND SUBTYPE 2 FOR DROPS UNDER REPORT TYPE 31
C 1999-02-25  D. A. KEYSER -- ADDED ABILITY TO READ REPROCESSED SSM/I
C     NCEP BUFR DUMP FILE (SPSSMI); ADDED ABILITY TO READ MEAN SEA-
C     LEVEL PRESSURE BOGUS (PAOBS) DATA SET (SFCBOG); ADDED PROCESSING
C     OF MDCRS ACARS MOISTURE DATA (READ IN AS MIXING RATIO AND
C     CONVERTED TO DEWPOINT DEPRESSION); MAND. LVLS WITH ONLY WIND NOW
C     STORED AS CAT. 1 (USED TO STORE AS CAT. 3 LIKE OLD ON29); TROP.
C     LVLS NOW STORED AS ONLY CAT. 5 (USED TO STORE AS BOTH CAT. 3 AND
C     5); U.S. RAOBS NO LONGER TRUNCATE WIND-BY-HGT HGTS ABOVE 100 MB
C     DOWN TO NEXT 10 METER LVL (THIS WAS AN OLD ON29 CONVENTION)
C 1999-05-14  D. A. KEYSER -- MADE FURTHER CHANGES NECESSARY TO PORT
C     THIS ROUTINE TO THE IBM SP
C 1999-06-18  D. A. KEYSER -- CAN NOW PROCESS WATER VAPOR SATWNDS FROM
C     FOREIGN PRODUCERS; STN. ID FOR FOREIGN SATWNDS NOW REPROCESSED IN
C     SAME WAY AS FOR NESDIS/GOES SATWNDS, CHARACTER 1 OF STN. ID NOW
C     DEFINES EVEN VS. ODD SATELLITE WHILE CHARACTER 6 OF STN. ID NOW
C     DEFINES IR CLOUD-DRFT VS. VISIBLE CLOUD DRFT VS. WATER VAPOR
C 1999-08-04  D. A. KEYSER -- UPDATED CALL TO ORDERS TO CORRECT ERROR
C     SINCE ORDERS WAS RECENTLY UPDATED IN W3LIB (4-BYTE REAL MACHINE
C     VERSION WAS PASSING 8-BYTE SORT KEYS WHICH CAUSED CAT. 2,3,4
C     PRESSURE SORT AND CAT. 8 CODE FIG. SORT TO NO LONGER WORK
C     PROPERLY); ADDED CALL TO SUBR. WORDLENGTH TO DETERMINE REAL AND
C     INTEGER MACHINE WORDLENGTH SO PROPER SORT KEY WORD LENGTH IS
C     ALWAYS PASSED INTO ORDERS; NOW FLAGS ALL VARIABLES (Q.M.=14) ON
C     DUPLICATE PRESSURE LEVELS WHERE OTHER DATA DISAGREE
C 1999-11-02  D. A. KEYSER -- CHANGES TO MAKE CODE MORE PORTABLE
C 1999-11-04 D. A. KEYSER -- ADDED NEW INPUT ARGUMENT "SUBSKP" - SEE
C     DESCRIPTION BELOW
C 2000-01-24  D. A. KEYSER -- ADDED WRITING OF NEW CAT. 8 C.F. 355
C     (NESDIS RECURSIVE FILTER FUNCTION) IN SATWND PROCESSING; MOVED
C     GOES SATWND Q.M. ASSIGNMENT BASED ON RFFL FROM SATWND PROCESSING
C     IN THIS SUBROUTINE TO SUBROUTINE GETC06 INLINE IN PREPDATA; THIS
C     SUBROUTINE NOW ASSIGNS CHAR. 1 AND CHAR. 6 OF NESDIS SATWND
C     REPORTS IN SATWND PROCESSING (HAD USED VALUES ASSIGNED BY INGEST
C     PROGRAM); SATWND PROCESSING MODIFIED TO HANDLE FUTURE EXPANDED
C     NESDIS SATWND FORMAT READ IN FROM NESDIS BUFR FILE
C 2000-06-07  D. A. KEYSER -- SATWND PROCESSING FURTHER MODIFIED TO
C     HANDLE NEW EXPANDED NESDIS SATWND FORMAT READ IN FROM NESDIS BUFR
C     FILES
C 2000-09-22  D. A. KEYSER -- ADDED NEW REPORT TYPE (RTP) OF 533 FOR
C     SURFACE MARINE AUTOMATED TIDE GAUGE REPORTS; FURTHER
C     MODIFICATIONS TO SATWND PROCESSING TO HANDLE NEW EXPANDED NESDIS
C     SATWND FORMAT, IN PARTICULAR NESDIS WINDS GENERATED FROM THE GMS
C     SATELLITE
C 2000-12-05  D. A. KEYSER -- CHANGED REPORT TYPE (RTP) FOR SURFACE
C     MARINE AUTOMATED TIDE GAUGE REPORTS FROM 533 TO 532 SO THEY AGREE
C     WITH REPORT TYPE IN QUIPS PROCESSING; SATWND PROCESSING MODIFIED
C     TO HANDLE OLD LO-DENSITY NESDIS FORMAT IN NC005001-NC005004 (FOR
C     HISTORICAL RERUNS); SATWND PROCESSING MODIFIED TO NOT CREATE STN.
C     ID IF IT HAS ALREADY BEEN CREATED BY BUFR_DUPSAT (OTHERWISE,
C     MODIFIED TO CREATE AN 8-CHARACTER STN. ID); ALL CAT. 6 TYPES NOW
C     STORE SPEC. HUMIDITY AS MOISTURE VARIABLE RATHER THAN DEWPOINT
C     DEPR.; MDCRS ACARS AIRCRAFT NOW PROCESSES MOISTURE ONLY IF
C     MOISTURE QUALITY IS "GOOD", IN THIS CASE IF MIXING RATIO IS FOUND
C     IT IS USED OTHERWISE LOOKS FOR RELATIVE HUM. (BEFORE, MOISTURE
C     QUALITY IND. WAS NOT EXAMINED AND ONLY MIXING RATIO WAS DECODED)
C 2001-04-06  D. A. KEYSER -- MODIFIED TO HANDLE NEW BUFR EUMETSAT
C     WINDS IN SUBSETS "NC005064", "NC005065" AND "NC005066"; NOW
C     STORES SSM/I RAINFALL RATE (CAT. 8, C.F. 198) IN UNITS OF MM/SEC
C     (STORED TO 10**6 PRECISION) (RATHER THAN WHOLE MM/HR), SSM/I
C     SURFACE TEMP (CAT. 8, C.F. 199) IN UNITS OF K (STORED TO 10**2
C     PRECISION) (RATHER THAN WHOLE K), SSM/I TPW (CAT. 8, C.F. 197) IN
C     UNITS OF MM (STORED TO 10**1 PRECISION) (RATHER THAN MM*100), AND
C     SSM/I WSPD (CAT. 8, C.F. 196) IN UNITS OF M/SEC (STORED TO 10**1
C     PRECISION) (RATHER THAN M/SEC*10); NOW LOOKS FOR SSM/I RAINFALL
C     RATE IN MNEMONIC "REQ6" FIRST, IF NOT FOUND LOOKS IN "REQV"
C     (LATTER FOR HISTORICAL RERUNS); CAN NOW UNPACK SSM/I SEA-SURFACE
C     TEMPERATURE PRODUCT (RTYP=577), STORES AS CAT. 8, C.F. 203; NOW
C     READS INPUT VALUE FOR IER ON FIRST CALL FOR A "NUNIT", IF IER=-1
C     ASSUMES THAT THE FILE ASSOCIATED WITH "NUNIT" HAS ALREADY BEEN
C     OPENED BY SUBR. "W3UNPKB7" AND REPORTS HAVE BEEN PROCESSED, IN
C     THIS CASE THIS ROUTINE WILL CONTINUE READING AND PROCESSING
C     REPORTS FROM "NUNIT" (THE OUTPUT ARGUMENTS DSNAME, IDSDAT AND
C     IDSDMP_8 ALSO BECOME INPUT ARGUMENTS IN THIS CASE) (CALLING
C     PROGRAM SHOULD OTHERWISE SET IER=0 ON FIRST CALL FOR A NEW
C     "NUNIT"); CAN NOW PROCESS WIND PROFILERS THAT ORIGINATE FROM
C     PILOT (PIBAL) FORMAT BULLETINS, GET R. TYPE 073; CORRECTED A BUG
C     WHICH MIGHT HAVE PREVENTED A DIAGNOSTIC PRINT FOR CASES WHEN
C     'SUBSKP' IS PASSED IN AS TRUE FOR SOME BUFR TYPE/SUBTYPE; ADDED
C     "SUBSET_r" (BUFR MESSAGE TYPE) AS AN INPUT/OUTPUT ARGUMENT (INPUT
C     ONLY WHEN IER IS PASSED IN AS -1;  HEADER WORD 6 (WAS MISSING)
C     NOW RETURNS SATELLITE ID FOR SATWIND AND SSM/I NON-SUPEROB
C     REPORTS (FOR OTHERS IT'S STILL MISSING); NOW STORES SSM/I
C     BRIGHTNESS TEMPS (CAT. 8, C.F. 189-195) IN UNITS OF K (STORED TO
C     10**2 PRECISION) (RATHER THAN K*100); CAN NOW UNPACK 4 MDCRS
C     ACARS TURBULENCE INDECES AND STORE AS CAT. 8, C.F. 926-929
C 2001-06-03  D. A. KEYSER -- MODIFIED TO HANDLE EXPANDED Q.C. INFO
C     FOR BUFR EUMETSAT WINDS IN SUBSETS "NC005064", "NC005065" AND
C     "NC005066" IMPLEMENTED ON 6-4-2001 (NOW HAS Q.C. NOT BASED ON
C     FIRST GUESS, ALONG WITH Q.C. BASED ON FIRST GUESS AS BEFORE, WE
C     ONLY WANT THE LATTER FOR NOW)
C 2001-06-19  D. A. KEYSER -- REMOVED A TEMPORARY FIX TO FORCE A
C     "VSIG" OF 2 OR 64 FOR WIND PROFILERS THAT ORIGNATE FROM PILOT
C     (PIBAL) FORMAT BULLETINS IN 002/009 - THIS HAS BEEN FIXED IN THE
C     DECODER
C 2002-01-28  D. A. KEYSER -- PRECISION OF TEMPERATURE OBS (AMDAR
C     FORMAT AND MDCRS ACARS) NOW STORED AS DEG. K * 100 IN CAT. 8 C.F.
C     915 SINCE IT IS STORED WITH 10**2 PRECISION IN DUMPS (WAS STORED
C     AS DEG. K * 1 WITH INCORRECT COMMENTS THAT IT WAS A BUFR CODE
C     TABLE 0-08-005, ACTUAL DESC. IS 0-02-005)
C 2002-03-05  D. A. KEYSER -- ACCOUNTS FOR CHANGES IN INPUT ADPUPA,
C     ADPSFC, AIRCFT AND AIRCAR BUFR DUMP FILES AFTER 5/2002: CAT. 7
C     AND CAT. 51 USE MNEMONIC "HBLCS" TO GET HEIGHT OF CLOUD BASE IF
C     MNEMONIC "HOCB" NOT AVAILABLE (AND IT WILL NOT BE FOR ALL CAT. 7
C     AND SOME CAT. 51 REPORTS); MNEMONIC "TIWM" REPLACES "SUWS" IN
C     HEADER FOR SURFACE DATA; MNEMONIC "BORG" REPLACES "ICLI" IN CAT.
C     8 FOR AIRCRAFT DATA (WILL STILL WORK PROPERLY FOR INPUT ADPUPA,
C     ADPSFC, AIRCFT AND AIRCAR DUMP FILES PRIOR TO 5/2002)
C 2002-07-03  D. A. KEYSER -- ADDED ABILITY TO READ MESONET NCEP BUFR
C     DUMP FILE (MSONET)
C 2003-05-23  D. A. KEYSER -- GOES-9 (SAT. ID 253) WINDS WITH BUFR
C     MESSAGE SUBTYPE 41-43 ALWAYS GET "P" IN 1ST CHAR. OF STN. ID AND
C     "D" (PROCUCER = JMA) IN 2ND CHAR. OF STN. ID. (JMA BEGAN
C     PRODUCING WINDS FROM GOES-9 IN PLACE OF FAILING GMS-5 ON 23 MAY
C     2003), WHEN NESDIS PRODUCES WINDS FROM GOES-9 THE FIRST CHAR. IN
C     THE STN. ID IS "C" (AS BEFORE)
C 2003-07-10  D. A. KEYSER -- ADDED NEW ARRAY OBS2 WHICH RETURNS
C     SINGLE-LEVEL REPORT DATA DIRECTLY FROM BUFR DUMP, INITALLY ONLY
C     2-WORDS, FIRST WORD RETURNS BUFR FLAG TABLE FOR "RESTRICTIONS ON
C     REDISTRIBUTION" (0-35-200) AND SECOND WORD RETURNS "EXPIRATION OF
C     RESTRICTIONS ON REDISTRIBUTION" (HOURS)
C 2004-01-09  D. A. KEYSER -- INPUT ARGUMENT SUBSKP SECOND DIMENSION
C     CHANGED FROM 1:200 TO 0:200 TO ACCOUNT FOR REPORTS WITH BUFR
C     SUBTYPE 000 (CURRENTLY ONLY WMO RES. 40 SYNOPS), DONE IN RESPONSE
C     TO CHANGE IN CORRESPONDING CALLING PROGRAM(S)
C 2004-02-02  D. A. KEYSER -- ADDED ABILITY TO PROCESS MOBILE SURFACE
C     LAND SYNOPTIC REPORTS OUT OF ADPSFC DUMP FILE [INCL. STN. ELEV
C     Q.M. WHICH IS STORED IN OUTPUT HEADER WORD 12 (PREV. MISSING AND
C     IS STILL MISSING FOR ALL OTHER DATA TYPES)]; ADDED ABILITY TO
C     PROCESS E-AMDAR AIRCRAFT REPORTS OUT OF THE AIRCFT DUMP FILE;
C     ADDED INFO. NOT PREVIOUSLY DECODED FOR MESONET DATA FROM MSONET
C     DUMP FILE {INCL. ID STRINGS FOR PROVIDER AND SUB-PROVIDER STORED
C     IN RESERVE WORDS 1 AND 2, RESP. (CHARACTER)}; ACCOUNTS FOR
C     TRANSITION OF MESONET REPORTS FROM LOW- TO HIGH-RESOLUTION LAT/
C     LON IN EARLY 2004; ARRAY SUBSKP BUMPED UP FROM (0:12,0:200) TO
C     (0:255,0:200); ACARS FLIGHT NUMBER NOW STORED IN RESERVE WORD 2
C     (CHARACTER); LOGIC ADDED TO SELECT WHICH PRESSURE (HEIGHT
C     ASSIGN.) AND WIND TO USE FOR GOES SATWND REPORTS (STILL HARDWIRED
C     TO "FINAL" VALUE); ADDED LOGIC TO HANDLE FUTURE NASA/MODIS (AQUA/
C     TERRA) POES WINDS
C 2004-09-09  D. A. KEYSER -- CORRECTED THE DEFINITION OF "INSTRUMENT
C     TYPE" (IT IS NOT BUFR CODE TBL 0-02-011 FOR NON-ADPUPA TYPE
C     REPORTS) AND INITIALIZES IT AS MISSING INSTEAD OF "99"; SURFACE
C     TYPES NOW ALWAYS STORE INSTRUMENT TYPE AS MISSING RATHER THAN
C     PACKING IN SYNOPTIC FORMAT FLAG, AUTOMATED STATION TYPE, AND SHIP
C     LOCATION FLAG; EXPANDED OBS2 FROM 2 TO 41-WORDS, ADDING RETURN OF
C     ALTIMETER SETTING, SEA-SURFACE TEMPERATURE AND SINGLE-LEVEL
C     SENSIBLE WEATHER ELEMENTS DIRECTLY FROM BUFR DUMP AND HARDWIRING
C     OBS2(41) (SST Q.M.) TO 2 WHEN SST IS PRESENT (ELSE MISSING) (SEE
C     REMARKS FOR CONTENT OF OBS2); ADDED NEW OUTPUT ARGUMENT OBS3
C     {CURRENTLY 5,255,5)} WHICH RETURNS MULTIPLE-LEVEL SENSIBLE
C     WEATHER ELEMENTS DIRECTLY FROM BUFR DUMP (SEE REMARKS FOR CONTENT
C     OF OBS3); ADDED NEW OUTPUT ARGUMENT NOBS3 {CURRENTLY (5)} WHICH
C     INDICATES THE NUMBER OF LEVELS OF DATA IN THE OBS3(X,Y,1),
C     OBS3(X,Y,2), OBS3(X,Y,3), OBS3(X,Y,4) AND OBS3(X,Y,5) ARRAYS (SEE
C     REMARKS); REMOVED ALL REFERENCES TO CAT. 7, 9 & 52 SINCE NO DATA
C     IN THESE NOW (RETURNED IN OBS2 OR OBS3); REMOVED (SET TO MISSING)
C     SOME INFO. THAT HAD BEEN RETURNED IN CAT. 51 & REDUCED NUMBER OF
C     VALUES IN IT FROM 25 TO 13 (RETURNED IN OBS2 OR OBS3); REMOVED
C     CAT. 8 CODE FIG. 001 (MAX. WIND SPD), 002 (MAX. WIND GUST DIR.),
C     081 (CALENDAR DAY MAX. TEMP.), 082 (CALENDAR DAY MIN. TEMP.), 083
C     (6-HR MAX. TEMP.), 084 (6-HR MIN. TEMP.), 085 (1-HR PRECIP.) AND
C     098 (TOTAL SUNSHINE FOR CALENDAR DAY) (RETURNED IN OBS2 OR OBS3);
C     CHANGED MEANING OF CAT. 8 CODE FIG. 005 FROM 1-HR PRECIP. (W/
C     IND. 2 ITS Q.M.) TO Q.M. FOR 1-HR PRECIP. (IND. 2 NOW MISSING),
C     006 FROM 24-HR PRECIP. (W/ IND. 2 ITS Q.M.) TO Q.M. FOR 24-HR
C     PRECIP. (IND. 2 NOW MISSING) AND 020 FROM ALTIMETER SETTING (W/
C     IND. 2 ITS Q.M.) TO Q.M. FOR ALTIMETER SETTING (IND. 2 NOW
C     MISSING); TYPE OF HOURLY REPORT ("METAR", "SPECI" OR "LWIS"),
C     DETERMINED FROM BUFR MNEMONIC THRPT, STORED IN BYTES 1-5 OF
C     HEADER RESERVE CHARACTER WORD 2 (METAR REPORTS ONLY), CORRECTED
C     REPORT INDICATOR ("CORN") STORED IN BYTE 8 OF HEADER RESERVE
C     CHARACTER WORD 2 (METAR REPORTS ONLY); LOGIC MODIFIED TO
C     TRANSITION FROM LOCAL TO WMO MNEMONICS FOR INPUT SSM/I DATA - NOW
C     LOOKS FOR TOTAL PRECIP. WATER IN MNEMONIC "TPWT" FIRST, IF NOT
C     FOUND LOOKS IN "PH2O", LOOKS FOR TOTAL SNOW DEPTH IN MNEMONIC
C     "TOSD" FIRST, IF NOT FOUND LOOKS IN "SNDP", LOOKS FOR OCEAN
C     SURFACE WIND SPEED IN MNEMONIC "WSPD" (WIND SPEED) FIRST, IF NOT
C     FOUND LOOKS IN "WSOS" (THIS ALSO ALLOWS FOR HISTORICAL RERUNS);
C     NON-MDCRS ACARS AIRFRAFT REPORTS NO LONGER GIVE ALL VARIABLES A
C     KEEP OR PURGE FLAG IF EITHER TEMP OR WIND HAS KEEP OR PURGE FLAG
C     - Q.M. REMAINS AS READ IN EXCEPT IF WIND Q.M. HAS PURGE FLAG,
C     THEN TEMP Q.M. ALSO GETS PURGE FLAG
C 2005-03-14  D. A. KEYSER (THIS FUNCTION IN PROGRAM BUFR_LISTDUMPS):
C 2006-11-29  D. A. KEYSER (THIS FUNCTION IN PROGRAM PREPOBS_PREPDATA):
C     MODIFIED TO HANDLE PREVIOUS CHANGE IN BUFR SUBSET STRUCTURE FOR
C     MODIS WINDS IN NC005070-071 ("SWCM" INSTEAD OF "SWDL" USED TO
C     DETERMINE CLOUD-TOP VS. DEEP-LAYER - BUG HAD LED TO ALL WV WINDS
C     TAGGED AS CLOUD-TOP); MODIFIED TO HANDLE PREVIOUS CHANGE IN BUFR
C     SUBSET STRUCTURE FOR EUMETSAT WINDS IN NC005064-066 (WILL STILL
C     WORK WITH OLD BUFR SUBSET STRUCTURE); MODIFIED TO HANDLE FUTURE
C     GTS GOES WINDS IN NC005015-018 AND FUTURE HI-DENSITY (FROM BUFR)
C     JMA WINDS IN NC005044-046; STORES PERCENT CONFIDENCE BASED ON
C     EUMETSAT QUALITY INDEX WITH FORECAST CONSISTENCY TEST (FOR
C     SATELLITE WINDS) (BUFR CODE TABLE 0-33-197) IN CAT. 8 CODE FIGURE
C     356; STORES PERCENT CONFIDENCE BASED ON EUMETSAT QUALITY INDEX
C     WITHOUT FORECAST CONSISTENCY TEST (FOR SATELLITE WINDS) (BUFR
C     CODE TABLE 0-33-198) IN CAT. 8 CODE FIGURE 357
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     CHANGES IN SATWND PROCESSING IN RESPONSE TO NESDIS' CORRECTION OF
C     AN ERROR (EFF. 3/10/2005) WHICH HAD STORED SIDP (SATELLITE
C     INSTRUMENT USED IN DATA PROCESSING) AS A CODE TABLE VALUE RATHER
C     THAN CORRECTLY AS A FLAG TABLE VALUE (THE CHANGE BY NESDIS
C     RESULTED IN INSTRUMENT TYPE BEING STORED AS MISSING AND THE
C     REPORT ID NOT BEING INDEXED) (WILL STILL WORK OK FOR HISTORICAL
C     RUNS PRIOR TO NESDIS FIX) {NOTE: THE LOGIC CHANGED HERE IS
C     ACTUALLY NEVER USED ANY MORE SINCE THE DUMP PROGRAM BUFR_DUPSAT
C     NOW (SINCE 12/2000) CREATES THE STATION ID PRIOR TO THIS ROUTINE
C     RUNNING AND THE INSTRUMENT TYPE IS NOW OBTAINED FROM THE STATION
C     ID}
C 2006-07-14  D. A. KEYSER -- BUMPED UP ARRAY SIZE FOR UNPACKED REPORT
C     IN "OBS" FROM 2500 TO 3000; BUMPED UP MAXIMUM NUMBER OF LEVELS
C     THAT CAN BE PROCESSED FOR A CATEGORY FROM 160 TO 200
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     CHANGES TO HANDLE JMA'S SWITCH FROM GOES-9 (SAT. ID 253) TO NEW
C     MTSAT-1R (SAT. ID 171, FIRST CHARACTER OF RPID IS "Q") FOR
C     SATWINDS ON 7/15/2005; ADDED NEW CODE FIGURES 930 {TAMDAR
C     TURBULENCE INDEX (BUFR CODE TABLE 0-11-235), INDICATOR 2 CONTAINS
C     TURBULENCE INDEX QUALITY MARKER (0-15)}; AND 931 {TAMDAR ROLL
C     ANGLE FLAG (BUFR CODE TABLE 0-02-199)}; FIXED BUG WHICH PREVENTED
C     "PART" RECEIPT TIMES FROM BEING STORED PROPERLY FOR ADPUPA TYPES;
C     MODIFIED TO PROCESS TAMDAR AND CANADIAN AMDAR AIRCRAFT DATA,
C     LATTER PROCESSES MOISTURE; THE HIGHEST FSL QUALITY FLAGS FOR
C     MESONET AND TAMDAR DATA NOW RESULT IN A PREPBUFR Q.M. OF 2
C     (NEUTRAL) RATHER THAN 1 (GOOD); CHANGES TO HANDLE INDIAN SATWINDS
C     FROM INSAT-3A (SAT. ID 470, FIRST CHARACTER OF RPID IS "V") AND
C     KALPANA-1 (SAT. ID 440, FIRST CHARACTER OF RPID IS "K")
C 2006-11-29  D. A. KEYSER (THIS FUNCTION IN PROGRAM PREPOBS_PREPDATA):
C 2007-09-14  D. A. KEYSER (THIS FUNCTION IN PROGRAM BUFR_LISTDUMPS):
C     FUNCTION R06UBF ACCOUNTS FOR EUMETSAT CLOUD WINDS NOW SENDING A
C     THIRD REPLICATION OF QUALITY INFORMATION (NESDIS RFF, IN
C     METEOSAT-MSG ONLY, BUT TESTED FOR ALL EUMETSAT SATELLITES)
C 2007-09-14  D. A. KEYSER -- BUMPED UP ARRAY SIZE FOR UNPACKED REPORT
C     IN "OBS" FROM 3000 TO 3500; BUMPED UP MAXIMUM NUMBER OF LEVELS
C     THAT CAN BE PROCESSED FOR A CATEGORY FROM 200 TO 300; STORES
C     PERCENT CONFIDENCE BASED ON NESDIS EXPECTED ERROR (FOR SATELLITE
C     WINDS) (BUFR CODE TABLE 0-33-203) IN CAT. 8 CODE FIGURE 358;
C     EXPANDED ARRAYS OBS3 FROM (5,255,5) TO (5,255,7) AND NOBS3 FROM
C     (5) TO (7) TO ACCOUNT FOR PROCESSING OF ADDITIONAL MULTIPLE-LEVEL
C     SENSIBLE WEATHER ELEMENTS CONTAINING AIRFRAME ICING (RECCOS,
C     PIREPS, E-AMDAR, CANADIAN AMDAR, TAMDAR) AND DEGREE OF TURBULENCE
C     (RECCOS AND ALL AIRCRAFT) INFORMATION (SEE REMARKS), THE LATTER
C     REPLACES STORAGE OF SINGLE DEGREE OF TURBULENCE VALUE WHICH HAD
C     BEEN IN CAT. 8, CODE FIGURE 916; ALL CALLS TO UFBINT TO RETURN
C     OBS3 DATA NOW CHECK FOR ALL MISSING VALUES WHEN NUMBER OF
C     "LEVELS" RETURNED IS 1 - IN SUCH CASES, THE NUMBER OF "LEVELS"
C     RETURNED IS CHANGED TO 0 (UFBINT CAN RETURN 1 LEVEL EVEN IF ALL
C     DATA ARE MISSING); ACCOUNTS FOR ARINC SCALING MIXR INCORRECTLY IN
C     MDCRS ACARS REPORTS (10 TIMES TOO LARGE) BETWEEN 11/1/2006 AND
C     10/1/2007 (COMPENSATES BY DIVIDING MIXR BY 10) - ON 10/2/2007
C     ARINC MADE FIX, MIXR SET TO MISSING SINCE UNCERTAIN OF EXACT TIME
C     OF FIX - FROM 10/1/2006 THROUGH 10/31/2006 MIXR ALSO SET TO
C     MISSING SINCE THERE IS UNCERTAINTY AS TO WHEN SCALING ERROR WAS
C     INTRODUCED DURING 10/2006 (NOTE: THIS CHANGE BENEFITS ONLY
C     HISTORICAL RERUNS AND REANALYSIS RUNS SINCE CHANGE WILL NOT BE
C     IMPLEMENTED UNTIL WELL AFTER 10/2/2007)
C 2008-04-10  D. A. KEYSER -- CAN HANDLE RADIOSONDE TYPES > 99 WHICH
C     WILL SOON BE INTRODUCED INTO THE BUFR DATABASE (BASED ON NOVEMBER
C     2007 WMO BUFR UPDATE)
C 2008-09-12  D. A. KEYSER -- MODIFIED TO RECOGNIZE THAT TAMDAR REPORTS
C     CAN NOW APPEAR IN "aircft" DUMP MESSAGE TYPES NC004012 (PENAIR)
C     AND NC004013 (CHAUTAUQUA) IN ADDITION TO MESSAGE TYPE NC004008
C     (MESABA)
C 2008-09-25  D. A. KEYSER -- ADDED FUNCTION TO CORRECTLY CALC.
C     PRESSURE ALTITUDE FROM PRESSURE (VIA U.S. STD. ATMOS) FOR
C     AIRCRAFT ABOVE 226 MB (BEFORE USED FUNCTION TO CALC. PRESSURE
C     ALTITUDE FROM PRSSSURE BELOW 226 MB AT ALL LEVELS), THIS APPLIES
C     ONLY TO MDCRS ACARS AND TAMDAR AIRCRAFT; THE Q.M. FOR MDCRS ACARS
C     WIND IS NO LONGER SET TO 1 (GOOD) IF NOT PREVIOUSLY SET, INSTEAD
C     IT IS SET TO 2 (NEUTRAL) (NEW NRL QC MODULE WILL DECIDE ON FINAL
C     Q.M.); OUTPUT ARRAY OBS2 INCR. FROM 41 TO 42 WORDS, WORD 42
C     CONTAINS MOISTURE QUALITY (CODE TABLE, ACARS REPORTS); EUMETSAT
C     WIND REPORTS ARE NO LONGER FLAGGED WITH QM=13 BASED ON LOW "QI
C     WITH FORECAST" VALUE OR HIGH MANUAL/AUTOMATIC Q.C. INDICATOR
C 2010-06-07 D. A. KEYSER  -- NOW STORES Q.M. FOR ALTIMETER SETTING FOR
C     METARS (JUST AS ALWAYS FOR MESONETS) IN CODE FIG. 20 OF CAT. 8,
C     BUT ONLY IF METAR PRESSURE Q.M. WAS GIVEN A PURGE OR REJECT FLAG
C     IN THE SDMEDIT FILE - IN THIS CASE ALTIMETER Q.M. IS SET TO SAME
C     VALUE AS PRESSURE Q.M. (EITHER 12 OR 14) (THIS WILL ALLOW
C     REJECTED OR PURGED PRESSURE Q.M. TO BE HONORED WHEN PSTN IS
C     CALCULATED FROM ALTIMETER SETTING DOWNSTREAM in PREPDATA); IF
C     PSTN OR PMSL ARE MISSING, WILL STILL STORE Q.M. READ IN FROM
C     SDMEDIT FOR THEM; RECOGNIZES NEW OR SOON-TO-BE NEW UNRESTRICTED
C     SHIP TANK NC001013; RECOGNIZES NEW AVHRR WIND TANK NC005080;
C     CHANGES 1ST CHARACTER OF REPORT ID FROM "?" (IF FOUND) TO "R" FOR
C     MTSAT-2 (SATELLITE ID 172) SAT-WIND REPORTS SO THAT THEY WILL BE
C     PROPERLY RECOGNIZED FOR HISTORICAL RERUNS, ETC. (FROM ~ 11 AUG TO
C     30 SEP 2010, BUFR_DUPSAT INCORRECTLY PLACED "?" IN 1ST CHARACTER
C     OF THESE IDS)
C 2012-11-27 D. A. KEYSER  -- ALLOW REPORT SEQUENCE NUMBER (CAT. 8,
C     CODE FIG. 21) TO NOW BE AS LARGE AS 999990 (ALL OTHER CODE FIGS.
C     UPPER LIMIT REMAINS 99999) (NEEDED BECAUSE THERE CAN NOW BE >
C     99999 MDCRS REPORTS IN A MONOLITHIC "AIRCAR" DUMP FILE)
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)
C 2013-06-30  D. A. KEYSER -- ADDED ABILITY TO READ IN AND PROCESS
C     PERCENT CONFIDENCE BASED ON EUMETSAT QUALITY INDICATOR WITH AND
C     WITHOUT FORECAST FOR NESDIS GOES WINDS PULLED FROM NESDIS SERVER
C     (WHICH ORIGINALLY STORED THEM IN DUMP FILE EXPLICITLY AS "QIFY"
C     AND "QIFN" BUT LATER STORED THEM BOTH AS BEFORE AND AS REPLICATED
C     "PCCF" VALUES AS WITH V10 BUFR, AND EVEN LATER STORED THEM ONLY
C     AS REPLICATED "PCCF" VALUES AS WITH V10 BUFR) IF THEY ARE PRESENT
C     (NOTE: AS NOTED, WILL ALSO WORK IF THESE ARE STORED IN REPLICATED
C     "PCCF" VALUES AS WITH V10 BUFR, E.G., MODIS WINDS, AVHRR WINDS,
C     JMA WINDS, EUMETSAT WINDS); ADDED ABILITY TO READ IN AND PROCESS
C     PERCENT CONFIDENCE BASED ON NESDIS RECURSVE FILTER FUNCTION FOR
C     TYPES WHICH MIGHT STORE IT IN DUMP FILE IN REPLICATED "PCCF"
C     VALUES AS WITH V10 BUFR (IN THIS CASE NESDIS GOES WINDS, MODIS
C     WINDS, AVHRR WINDS, JMA WINDS - ALREADY IN PLACE FOR EUMETSAT
C     WINDS) IF IT IS PRESENT (NOTE: WILL STILL WORK IF THIS IS STORED
C     EXPLICITLY AS "RFFL" AS ORIGINALLY WITH GOES WINDS PULLED FROM
C     NESDIS SERVER); ADDED ABILITY TO READ IN AND PROCESS PERCENT
C     CONFIDENCE BASED ON NESDIS EXPECTED ERROR FOR TYPES WHICH MIGHT
C     STORE IT IN DUMP FILE IN REPLICATED "PCCF" VALUES AS WITH
C     V10 BUFR (IN THIS CASE MODIS OR AVHRR WINDS) IF IT IS PRESENT
C     (NOTE: WILL STILL WORK IF THIS IS STORED EXPLICITLY AS "EEQF" AS
C     ORIGINALLY WITH GOES WINDS PULLED FROM NESDIS SERVER); NOW STORES
C     CLOUD-TOP/DEEP-LAYER INDICATOR IN BYTE 3 OF HEADER RESERVE
C     CHARACTER WORD 1 FOR FOREIGN-PRODUCED SATELLITE WINDS (AS ALREADY
C     DONE FOR NESDIS-PRODUCED SATELLITE WINDS) - JMA AND EUMETSAT
C     IMAGER WATER VAPOR WINDS CAN NOW BE OF BOTH TYPES, BEFORE THEY
C     WERE ONLY CLOUD-TOP; OUTPUT ARRAY OBS2 INCR. FROM 42 TO 43 WORDS,
C     WORD 43 CONTAINS SATELLITE ZENITH ANGLE (DEGREES, SATWND TYPES
C     ONLY)
C 2014-02-01  S. MELCHIOR  -- ADDED NEW REPORT TYPE (RTP) OF 534 FOR
C     SURFACE MARINE COAST GUARD TIDE GAUGE REPORTS
C 2015-01-30  D. A. KEYSER --  Added logic to handle new NASA/VIIRS
C     (NPP) POES winds in tank NC005090 (e.g., recognizes that they now
C     exist, counts of reports with flagged QI values, counts of
C     reports by satellite number).  Added logic to properly handle
C     GOES IR short-wave winds in tank NC005019 (e.g., new instrument
C     type 19, process the quality information correctly). Added some
C     missing logic which summarizes processing of NESDIS/AVHRR POES
C     winds in tank NC005080 (e.g., counts of reports by satellite
C     number).
C 2015-03-09  D. A. KEYSER --  Now stores WMO bulletin header and
C     originator in new output character*11 argument CBULL for aircraft
C     data (only) (all blanks for all other data types for now). (Note:
C     Previously, WMO bulletin originator had been stored in characters
C     1-4 of header reserve character word 1 and bulletin header was
C     not stored.)
C 2016-02-09  S. MELCHIOR -- Adjusted code to accommodate the
C     processing of two new aircraft data types: Korean AMDAR (BUFR)
C     and Catch-All AMDAR (BUFR).  Either pre-version 7 BUFR or new
C     version 7 BUFR for Catch-All AMDAR, MDCRS and E-AMDAR can be
C     handled.  Adjustments are primarily in function R05UBF. Added two
C     functions to estimate pressure using indicated altitude and U.S.
C     Standard Atmosphere.  The pressure is used to estimate dew point
C     temperature to perform a gross check on moisture data.  The
C     estimated pressures are not considered reported pressure and
C     remain missing in the encoded report. Details and clarification
C     were added explaining how height information is obtained for
C     different aircraft data types. Adjusted setting of report subtype
C     (ISTP) to read the last three integers of the subset rather than
C     the last two integers.  This preserves the difference between
C     legacy TAC format AMDAR tank and new BUFR format "Catch-All" tank
C     (e.g. 004003 and 004103). Phase of flight information for version
C     7 BUFR data is stored in a different mnemonic (DPOF) than
C     pre-version 7 BUFR version (POAF).  The values do not exactly
C     correlate.  Logic was added to translate DPOF values into POAF
C     values since downstream codes still expect POAF.  All references
C     to E-ADAS have been changed to E-AMDAR.
C     {Note: Some modifications made to handle new Panasonic (AirDAT)
C            TAMDAR.  This needs further testing.}
C 2016-07-28  C. Hill --
C     Added capability to process BUFR(v4) TAMDAR data, as provided by
C     Panasonic/AirDat since November 2015. HMSL (pressure altitude) is
C     given precedence over FLVLST (GPS altitude) in defining flight
C     level height (ELEV) and in calcuating pressure values, consistent
C     with other aircraft data types and performed without adversely
C     affecting ELEV assignment of the other aircraft data types.
C     Quality marks for temperature and wind are derived from quality
C     information provided by QMRKH fields in the reports. The quality
C     mark for moisture is derived from the "percent confidence" (PCCF)
C     field provided in the reports. {Additional fields of FLVLST and
C     IALR (instantaneous altitude rate) are available and may be
C     considered for future inclusion in PREPBUFR files.}
C 2016-11-25  D. A. KEYSER --
C     Changes in processing of TAMDAR data provided by Panasonic/AirDat
C     (TAMDARB):
C       - Stores instantaneous altitude rate (read from IALR) in cat.8
C         c.f. 932 (.001 x m/sec).
C       - Stores type of commercial aircraft (read from ACTP) in header
C         reserve character (*8) word 2.
C       - Stores observer identification (read from OBSVR) in bytes 1-4
C         of header reserve character (*8) word 1.
C       - Cleaned up logic which reads in BORG and BUHD (sets to all
C         blanks since these are missing for TAMDARB data). Also store
C         all blanks in output character (*11) CBULLX in this case.
C       - Bug fixes, mostly minor.  Most serious one was logic not
C         honoring incoming TQM/WQM/QQM other than 2 in transformation
C         of TAMDAR QMRKH/PCCF into updated TQM/WQM/QQM (from 2016-07-28
C         update).
C       - Treat these like MDCRS in that an SDM purge on wind QM does
C         NOT force a purge also on temperature QM (this is still done
C         for all other aircraft types).
C     Changes in processing of Catch-All AMDAR (BUFR) data:
C       - Stores flight number (read from ACID) in header reserve
C         character (*8) word 2 (if ACID is missing, stores all blanks
C         here).
C 2016-11-30  D. A. KEYSER --
C     Added new output real, double-precision argument array OBS8_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 OBS(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 2017-01-11  C. Hill --
C     For TAMDARB reports, always set moisture quality mark (QQM) to 13
C     if temperature quality mark (TQM) was set to 13 earlier in subr.
C     R05UBF .
C 2017-07-03  D. A. KEYSER -- (changes are in function R04UBF)
C     Mesonet reports now look for SDMEDIT quality marks in dump and
C     store that information.  If missing then, as before, interpret
C     MADIS quality mark and use that.
C     BENFEFIT: Corrects a bug in code. SDMEDIT quality marks on
C               mesonet reports will now be honored (and will not be
C               overwritten by interpreted MADIS quality marks).
C 2018-07-02  S.Melchior-- In function R04UBF, added call to UFBINT
C     routine to pull in HOVI (horizontal visibility) value for mesonet
C     message types (NC255).
C 2018-10-22  D. A. KEYSER -- (changes are in function R06UBF)
C     Changes to handle new GOES-16 & up satellite winds which do not
C     contain a report id (STNID) and have high-res lat/lon (amongst
C     other differences vs. GOES-15 & down).
C 2020-08-20 J. Whiting --
C     - Assigned input report type values of 563-4 to fixed and drifting
C       BUFR-feed buoy data, respectively.
C     - Set SST values for BUFR-feed fixed & drifting buoy data streams
C       to be taken from SST0 field.
C 2020-08-20  J. DONG --
C   - In function I02UBF:
C     - Changed the windowing decade from 20 to 40 for cases when the
C       year is represented by 2 digits instead of 4.
C   - IN FUNCTION R04UBF:
C     - ADDED ABILITY TO ENCODE ELEVATION (HSMSL) IN BUFR FORMAT FROM
C       ADPSFC DUMP FILE IN HEADER.
C     - ADDED ABILITY TO ENCODE THE CLOUD HEIGHT IN BUFR FORMAT FROM
C       THE ADPSFC DUMP FILE AND HANDLED HOCB AND HOCT WITH DIFFERENT
C       ATTRIBUTES.
C     - ADDED ABILITY TO ENCODE PRECIPTATION REPORTS IN BUFR FORMAT
C       FROM THE ADPSFC DUMP FILE. CONVERTED THE PRECIPITATION (TOPC)
C       INTO THE TAC FORMAT INCLUDING TP01, TP03, TP06, TP12, TP24
C       AND DTHTOPC.
C     - ADDED ABILITY TO ENCODE MAX/MIN TEMPERATURE IN BUFR FORMAT
C       REPORTS FROM THE ADPSFC DUMP FILE. CONVERTED THE ATTRIBUTE
C       (TPHR) INTO .DTHMXTM/.DTHMITM IN TAC FORMAT.
C     - ADDED ABILITY TO ENCODE MAXIMUM GUST WIND SPD (MXGS) AND TPMI
C       IN BUFR FORMAT FROM THE ADPSFC DUMP FILE, AND CONVERTED TPMI
C       TO .DTMMXGS IN TAC FORMAT.
C     - ADDED ABILITY TO ENCODE HOVI REPORTS IN BUFR FORMAT FROM THE
C       ADPSFC DUMP FILE. CONVERT THE ATTRIBUTE (AOFV) OF HOVI TO THE
C       RELATIONSHIP (.REHOVI) IN VISBSEQN SEQUENCE.
C     - ADDED ABILITY TO ENCODE PAST WEATHER IN BUFR FORMAT FROM THE
C       ADPSFC DUMP FILE. ADDED TO READ THE TIME PERIOD OR DISPLACEMENT
C       (TPHR) FOR THE PAST WEATHER MEASUREMENTS.
C 2020-09-14  S. Melchior -- In function R06UBF, added code to process
C       new WMO BUFR format Meteosat AMV data from subsets: 005067,
C       005068, 005069. 
c 2020-10-15 JWhiting -- added trap to pull dump mnemonics specific to 
c       BUFR feed buoy data streams so as to properly encode prepbufr 
c       wave height & frequecy mnemonics (HOWV POWV).  
c 2021-03-30 JWhiting - 
C     - Fixed ambiguity in trap for buoy SST values (msg types 102-3)
C     - Assigned input report type values of 524-5 to BUFR-feed ships 
c       data, for named and unnamed obs, respectively (TAC-feeds remain 
c       as 522-3).
C     - Assigned input report type value of 530 to BUFR-feed C-MAN
C       reports.
C 2021-07-14 J. Dong -- In function R04UBF, added code to encode the
C       cloud data for the BUFR-feed ships data.
C
C
C USAGE:    II = IW3UNPBF(NUNIT, OBS, STNID, CRES1, CRES2, CBULL, OBS2,
C                         OBS3, NOBS3, OBS8_8, DSNAME, IDSDAT, IDSDMP_8,
C                         SUBSET_r, SUBSKP, IER)
C   INPUT ARGUMENT LIST:
C     NUNIT    - FORTRAN UNIT NUMBER FOR SEQUENTIAL DATA SET CONTAINING
C                PACKED NCEP BUFR REPORTS (DUMP FILE)
C     DSNAME   - CHARACTER*8 DATA SET NAME (ONLY READ WHEN INPUT ARG.
C                IER = -1, SEE BELOW)
C     IDSDAT   - INTEGER DATA SET CENTER DATE IN FORM YYYYMMDDHH (ONLY
C                READ WHEN INPUT ARG. IER = -1, SEE BELOW)
C     IDSDMP_8 - INTEGER DATA SET DUMP TIME IN FORM YYYYMMDDHHMM (ONLY
C                READ WHEN INPUT ARG. IER = -1, SEE BELOW)
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 FUNCTION 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 FUNCTION 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     SUBSET_r - CHARACTER*8 BUFR MESSAGE TYPE (ONLY READ WHEN INPUT
C                ARG. IER = -1, SEE BELOW)
C     IER      - PRIOR TO INITIAL CALL TO THIS SUBROUTINE WITH A NEW
C                "NUNIT": IF =-1, INDICATES THAT THE FILE ASSOCIATED
C                WITH "NUNIT" HAS ALREADY BEEN OPENED BY THE
C                CORRESPONDING INTERFACE SUBROUTINE W3UNPKB7 AND
C                REPORTS HAVE BEEN PROCESSED, THIS ROUTINE WILL
C                CONTINUE READING AND PROCESSING REPORTS FROM "NUNIT";
C                OTHERWISE IER SHOULD BE INPUT AS ZERO
C
C   OUTPUT ARGUMENT LIST:
C     OBS      - ARRAY CONTAINING ONE REPORT IN SPECIFIED UNPACKED
C                FORMAT.  FORMAT IS MIXED, USER MUST EQUIVALENCE
C                INTEGER ARRAY TO THIS ARRAY (SEE REMARKS FOR UNPACKED
C                FORMAT) THE LENGTH OF THE ARRAY SHOULD BE AT LEAST
C                3500 (NOTE: DOES NOT INCLUDE STATION ID, CHARACTER
C                RESERVE WORD 1, CHARACTER RESERVE WORD 2 AND CBULL)
C     STNID    - CHARACTER*8 SINGLE REPORT STATION IDENTIFICATION (UP
C                TO 8 CHARACTERS, LEFT-JUSTIFIED)
C                (Note: For GOES-16 & up satellite winds, there is no
C                       report id; this is hardwired as 8 dashes:
C                       "--------".
C     CRES1    - CHARACTER*8 SINGLE REPORT CHARACTER RESERVE WORD 1
C                (SEE DOCUMENTATION/COMMENTS IN THIS PROGRAM (VARIES BY
C                TYPE OF DATA)
C     CRES2    - CHARACTER*8 SINGLE REPORT CHARACTER RESERVE WORD 2
C                (SEE DOCUMENTATION/COMMENTS IN THIS PROGRAM (VARIES BY
C                TYPE OF DATA)
C     CBULL    - CHARACTER*11 STRING HOLDING WMO BULLETIN HEADER (CHAR.
C                1-6) AND ORIGINATOR (CHAR. 8-11) (CHAR. 7 IS BLANK)
C                (Note: Currently only applies to aircraft reports,
C                       this string is all blanks for all other types.)
C     OBS2     - 43-WORD ARRAY CONTAINING ADDITIONAL REPORT DATA NOT
C                PRESENT IN OBS ARRAY (DATA RESTRICTION INFO,
C                ALTIMETER SETTING, SST, SINGLE-LEVEL SENSIBLE WEATHER
C                ELEMENTS - STORED DIRECTLY FROM BUFR) (SEE REMARKS FOR
C                CONTENT)
C     OBS3     - (5,255,7)-WORD ARRAY CONTAINING ADDITIONAL REPORT DATA
C                NOT PRESENT IN OBS ARRAY (MULTIPLE-LEVEL SENSIBLE
C                WEATHER ELEMENTS STORED DIRECTLY FROM BUFR) (SEE
C                REMARKS FOR CONTENT)
C     NOBS3    - 7-WORD ARRAY CONTAINING NUMBER OF LEVELS OF DATA
C                IN THE OBS3(X,Y,1), OBS3(X,Y,2), OBS3(X,Y,3),
C                OBS3(X,Y,4), OBS3(X,Y,5), OBS3(X,Y,6) AND OBS3(X,Y,7)
C                ARRAYS (SEE REMARKS)
C     OBS8_8   - 2-WORD REAL*8 ARRAY CONTAINING ADDITIONAL REPORT DATA
C                (LATITUDE AND LONGITUDE) (SEE REMARKS FOR CONTENT)
C     DSNAME   - CHARACTER*8 DATA SET NAME (SAME FOR ALL REPORTS IN
C                A COMMON INPUT DATA SET - SEE REMARKS FOR IER=1)
C     IDSDAT   - INTEGER DATA SET CENTER DATE IN FORM YYYYMMDDHH (SAME
C                FOR ALL REPORTS IN A COMMON INPUT DATA SET - SEE
C                REMARKS FOR IER=1)
C     IDSDMP_8 - INTEGER DATA SET DUMP TIME IN FORM YYYYMMDDHHMM (SAME
C                FOR ALL REPORTS IN A COMMON INPUT DATA SET - SEE
C                REMARKS FOR IER=1)
C     SUBSET_r - CHARACTER*8 BUFR MESSAGE TYPE (SAME FOR ALL REPORTS
C                IN A COMMON BUFR MESSAGE)
C     IER      - RETURN FLAG (EQUAL TO FUNCTION VALUE) - SEE REMARKS
C
C   INPUT FILES:
C     UNIT AA  - SEQUENTIAL NCEP BUFR DUMP FILE ("AA" IS UNIT NUMBER
C                SPECIFIED BY INPUT ARGUMENT "NUNIT")
C
C   OUTPUT FILES:
C     UNIT 06  - PRINTOUT
C
C   SUBPROGRAMS CALLED:
C     UNIQUE:    - R01UBF   R02UBF   R03UBF   R04UBF   R05UBF
C                  R06UBF   R07UBF   I02UBF   I04UBF   I05UBF
C                  L01UBF   L02UBF   L03UBF   S01UBF   S02UBF
C                  S03UBF   S04UBF   S05UBF   SE01UBF  MQMUBF
C                  EQSUBF   EQMUBF   ERTUBF   C01UBF   WORDLENGTH
C     LIBRARY:
C       W3EMC    - ORDERS
C       BUFRLIB  - OPENBF   CLOSBF   DATELEN  STATUS   DUMPBF
C                  READMG   READSB   UFBINT   UFBREP   NMSUB
C                  UFBSEQ   GETBMISS IBFMS    CBFMS    READLC
C
C REMARKS:
C     THE RETURN FLAGS IN IER (AND FUNCTION IW3UNPBF ITSELF) ARE:
C          =   0  OBSERVATION READ AND UNPACKED INTO LOCATIONS 'OBS',
C                   'STNID', 'CRES1', 'CRES2', 'CBULL', 'OBS2', 'OBS3',
C                   'OBS8_8', 'DSNAME', 'IDSDAT', AND 'IDSDMP_8'.  SEE
C                   REMARKS BELOW FOR CONTENTS. NEXT CALL TO IW3UNPBF
C                   WILL RETURN NEXT OBSERVATION 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.  NO REPORT IS UNPACKED AT THIS
C                   POINT, AND ONLY DSNAME, IDSDAT, AND IDSDMP_8
C                   CONTAIN INFORMATION.  ALL SUBSEQUENT CALLS TO
C                   IW3UNPBF SHOULD RETURN THE OBSERVATIONS IN THIS
C                   DATA SET, SEQUENTIALLY, (IER=0) UNTIL THE END OF
C                   FILE IS ENCOUNTERED (IER=2 OR 3).  THE VALUES
C                   STORED IN DSNAME, IDSDAT, AND IDSDMP_8 WILL
C                   CONTINUE TO BE RETURNED ALONG WITH EACH REPORT
C                   WHEN IER = 0.
C          =   2  THE PHYSICAL END OF FILE IS ENCOUNTERED (THIS IS
C                   FOR A VALID NCEP BUFR DUMP FILE CONTAINING
C                   REPORTS).  ALL DONE.
C          =   3  THIS IS AN EMPTY (NULL) FILE.  ALL DONE.
C          = 999  ERROR: EITHER FILE IS NOT NCEP BUFR, ERROR READING
C                        FILE, CENTER DATE DUMMY MESSAGE NOT FOUND AT
C                        TOP OF NCEP BUFR DUMP FILE, OR SOME OTHER
C                        PROBLEM IN DECODING ONE OR MORE REPORTS IN AN
C                        NCEP BUFR DUMP FILE.
C                  NO USEFUL INFORMATION IN 'OBS', 'STNID', 'CRES1',
C                  'CRES2', 'CBULL', 'OBS2', 'OBS3', 'OBS8_8', 'DSNAME',
C                  'IDSDAT', AND 'IDSDMP_8' ARRAYS.  CALLING PROGRAM
C                  CAN CHOOSE TO STOP WITH NON-ZERO CONDITION CODE OR
C                  RESET 'NUNIT' TO POINT TO A NEW DATA SET (IN WHICH
C                  CASE NEXT CALL TO IW3UNPBF SHOULD RETURN WITH
C                  IER=1).
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C           CONTENTS OF AN UNPACKED REPORT IN THE "OBS" ARRAY
C               {MISSING INTEGER DATA ARE SET TO IMISS (99999);
C                MISSING REAL DATA ARE SET TO XMISS (99999.)}
C
C     (NOTE: DOES NOT INCLUDE STATION IDENTIFICATION, CHARACTER RESERVE
C            WORD 1, CHARACTER RESERVE WORD 2, "CBULL", "OBS2" AND
C            "OBS3" ARRAY OUTPUT; LATITUDE AND LONGITUDE IN OBS(1:2) ARE
C            ALSO OUTPUT IN REAL*8 IN "OBS8_8"  - SEE OUTPUT ARGUMENTS
C            "STNID", "CRES1", "CRES2" AND "CBULL" ABOVE AND "OBS2",
C            "OBS3" AND "OBS8_8" CONTENTS 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    NOT USED                  MISSING              REAL
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       (SEE %)              INTEGER
C    11    RECEIPT TIME              HOURS (UTC)          REAL
C    12    STATION ELEVATION (BUFR CODE TABLE 0-33-024)   REAL
C          QUALITY MARK              (SEE #)             
C
C    13    CATEGORY  1, NO. LEVELS   COUNT                INTEGER
C    14    CATEGORY  1, DATA INDEX   COUNT                INTEGER
C    15    CATEGORY  2, NO. LEVELS   COUNT                INTEGER
C    16    CATEGORY  2, DATA INDEX   COUNT                INTEGER
C    17    CATEGORY  3, NO. LEVELS   COUNT                INTEGER
C    18    CATEGORY  3, DATA INDEX   COUNT                INTEGER
C    19    CATEGORY  4, NO. LEVELS   COUNT                INTEGER
C    20    CATEGORY  4, DATA INDEX   COUNT                INTEGER
C    21    CATEGORY  5, NO. LEVELS   COUNT                INTEGER
C    22    CATEGORY  5, DATA INDEX   COUNT                INTEGER
C    23    CATEGORY  6, NO. LEVELS   COUNT                INTEGER
C    24    CATEGORY  6, DATA INDEX   COUNT                INTEGER
C    25    reserved                      0                INTEGER
C    26    reserved                      0                INTEGER
C    27    CATEGORY  8, NO. LEVELS   COUNT                INTEGER
C    28    CATEGORY  8, DATA INDEX   COUNT                INTEGER
C    29    CATEGORY 51, NO. LEVELS   COUNT                INTEGER
C    30    CATEGORY 51, DATA INDEX   COUNT                INTEGER
C 31-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             SATELLITE WIND (DUMP REPORT TYPE 63)
C             SSM/I (NON-SUPEROBED ONLY: ALL TYPES, DUMP REPORT
C                     TYPES 65,66,68,69,571,573-577)
C    $ - WORD  8, INSTRUMENT TYPE, IS CURRENTLY SET TO MISSING FOR
C         ALL TYPES EXCEPT:
C             UPPER-AIR (ADPUPA) (DUMP REPORT TYPES 11-13, 22, 23,
C               31):
C               Radiosonde type - see BUFR CODE TABLE 0-02-011
C             SATELLITE-DERIVED WIND (SATWND) (DUMP REPORT TYPE 63):
C               NESDIS satellite wind type
C                 0       Reserved
C                 1       IR (long-wave) automated winds (low density)
C                 2       IR (long-wave) manual winds
C                 3       Picture triplet (low density)
C                 4       Water vapor automated (low density)
C                 5       Visible manual
C                 6       Visible automated (low density)
C                 7       Gradient winds
C                 8       Picture pair
C                 9       Reserved
C                10       AMSU/SSMI microwave winds
C                11       Scatterometer
C                12       Altimeter
C                13       LAWS
C                14       High-density water vapor sounder, channel 10
C                15       High-density water vapor sounder, channel 11
C                16       High-density IR (long-wave) imager automated winds
C                17       High-density visible imager automated winds
C                18       High-density water vapor imager
C                19       High-density IR (short-wave) imager automated winds
C             20-254      Reserved for future use
C               255       Missing value
C             AIRCRAFT (AIRCFT) (DUMP REPORT TYPE 41):
C               0-96      Reserved
C                97       Inertial navigation system
C                98       OMEGA
C             99-254      Reserved
C               255       Missing value
C    % - WORD 10, REPORT SUBTYPE, IS CURRENTLY SET TO MISSING FOR
C         ALL TYPES EXCEPT:
C             AIRCRAFT (DUMP REPORT TYPE 41), WHERE:
C                 =  1 - AIREP FORMAT AIRCRAFT
C                 =  2 - PIREP FORMAT AIRCRAFT
C                 =  3 - AMDAR FORMAT ASDAR/ACARS AIRCRAFT
C                 =  4 - MDCRS ACARS AIRCRAFT (ARINC -> NCEP)
C                 =  6 - E-AMDAR AIRCRAFT {EUROPEAN AMDAR (ASDAR/ACARS)
C                         DATA ORIGINALLY IN BUFR}
C                 =  7 - MDCRS ACARS AIRCRAFT (ARINC -> AFWA -> NCEP)
C                 =  8 - MADIS/TAMDAR-Mesaba AIRCRAFT
C                 =  9 - CANADIAN AMDAR AIRCRAFT (ASDAR/ACARS DATA
C                         ORIGINALLY IN BUFR)
C                 = 10 - TAMDAR {FROM PANASONIC(AirDAT), DATA ORIGINALLY
C                        IN BUFR}, HEREAFTER REFERRED TO AS TAMDARB
C                 = 11 - KOREAN AMDAR AIRCRAFT (DATA ORIGINALLY IN BUFR)
C                 = 12 - MADIS/TAMDAR-PenAir AIRCRAFT
C                 = 13 - MADIS/TAMDAR-Chautauqua AIRCRAFT
C                 = 103 - CATCH-ALL AMDAR AIRCRAFT (DATA ORIGINALLY IN
C                         BUFR)
C             RECONNAISSANCE/DROPWINSONDE (DUMP REPORT TYPE 31), WHERE:
C                 =  1 - RECONNAISSANCE AIRCRAFT
C                 =  2 - DROPWINSONDE
C    # - WORD 12, STATION ELEVATION QUALITY MARK, IS CURRENTLY SET TO
C         MISSING FOR ALL TYPES EXCEPT MOBILE LAND SURFACE (SYNOPTIC)
C         (DUMP REPORT TYPE 514)
C
C    & - DUMP REPORT TYPES:
C          011 - Fixed land RAOB and PIBAL by block and station
C                 number
C          012 - Fixed land RAOB and PIBAL by call letters
C          013 - Mobile land RAOB, including CLAS soundings
C          022 - Ship RAOB with name
C          023 - Ship RAOB without name (report id set to "SHIP")
C          031 - Reconnaissance aircraft or dropwinsonde
C          041 - Aircraft flight-level (all types)
C          063 - Satellite-derived winds
C          065 - SSM/I total precipitable water (ocean)
C          066 - SSM/I rain rate
C          068 - SSM/I brightness temperatures
C          069 - SSM/I cloud water (ocean)
C          073 - Wind profiler originating from PILOT (PIBAL) format
C                 bulletins (mainly tropical and European)
C          511 - Fixed land surface by block and station number
C                 (synoptic, both unrestricted & restricted WMO Res. 40)
C          512 - Fixed land surface by call letters (METAR)
C          514 - Mobile land surface (synoptic)
C          522 - TAC format Ship with name
C          523 - TAC format Ship w/o name (report id set to "SHIP")
C          524 - FM94/BUFR format Ship with name
C          525 - FM94/BUFR format Ship w/o name (rpt id set to "SHIP")
C          530 - C-MAN platform (BUFR-feed data stream)
C          531 - C-MAN platform (TAC-feed data stream)
C          532 - Tide gauge
C          534 - Coast Guard Tide gauge
C          540 - Mesonet surface
C          551 - Sea-level pressure bogus
C          561 - Buoy data arriving in WMO FM13 format (fixed);
C          562 - Buoy data arriving in WMO FM18 format (fixed or drifting);
C          563 - Buoy data arriving in WMO FM94 format (fixed);
C          564 - Buoy data arriving in WMO FM94 format (fixed? or drifting);
C          571 - SSM/I wind speed (ocean)
C          573 - SSM/I soil moisture
C          574 - SSM/I snow depth
C          575 - SSM/I additional products (surface tag, ice
C                 concentration, ice age, ice edge, calculated
C                 surface type)
C          576 - SSM/I surface (skin) temperature
C          577 - SSM/I sea surface temperature
C
C
C
C
C   ***************************************************************
C
C
C     DATA ARE UNPACKED INTO FIXED LOCATIONS IN WORDS 1-12 AND INTO
C     INDEXED LOCATIONS IN WORD 53 AND FOLLOWING.  THE VERTICAL
C     SIGNIFICANCE DESCRIPTOR FOR EACH LEVEL IN THE BUFR REPORT IS
C     USED TO UNPACK THE LEVEL INTO THE "DATA LEVEL CATEGORIES"
C     DESCRIBED BELOW.  EACH DATA LEVEL CATEGORY HAS A LAYOUT IN
C     LOCATIONS IN ARRAY OBS THAT MAY BE FOUND BY USING THE
C     CORRESPONDING INDEX AMOUNT FROM WORDS 14, 16, ..., 34, IN
C     ARRAY OBS.  FOR INSTANCE, IF A REPORT IS UNPACKED INTO ONE OR
C     MORE CATEGORY 3 DATA LEVEL GROUPS (WIND DATA AT VARIABLE
C     PRESSURE LEVELS) THAT DATA WILL BE SPECIFIED IN THE UNPACKED
C     BINARY FORMAT AS DESCRIBED BELOW UNDER DATA LEVEL CATEGORY 3.
C     THE NUMBER OF LEVELS WILL BE STORED IN WORD 17 OF OBS AND THE
C     INDEX OF THE FIRST LEVEL OF UNPACKED DATA IN THE OUTPUT ARRAY
C     WILL BE STORED IN WORD 18.  THE SECOND LEVEL, IF ANY, WILL BE
C     STORED BEGINNING SIX WORDS FURTHER ON, AND SO FORTH UNTIL THE
C     COUNT IN WORD 17 IS EXHAUSTED.  THE FIELD LAYOUT IN EACH DATA
C     LEVEL CATEGORY IS GIVEN BELOW...
C
C     DATA LEVEL CATEGORY 1 - MANDATORY LEVEL DATA
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 DEPRESSION  0.1 DEGREES C       REAL
C       5    WIND DIRECTION       DEGREES             REAL
C       6    WIND SPEED           0.1 METERS/SEC      REAL
C       7    PRES. QUALITY MARKER (SEE $)             REAL
C       8    GEOP. QUALITY MARKER (SEE $)             REAL
C       9    TEMP. QUALITY MARKER (SEE $)             REAL
C      10    DDPR. QUALITY MARKER (SEE $)             REAL
C      11    WIND  QUALITY MARKER (SEE $)             REAL
C
C     DATA LEVEL CATEGORY 2 - TEMPERATURE AT VARIABLE PRESSURE
C     WORD   PARAMETER            UNITS               FORMAT
C     ----   ---------            -----------------   -------------
C       1    PRESSURE             0.1 MILLIBARS       REAL
C       2    TEMPERATURE          0.1 DEGREES C       REAL
C       3    DEWPOINT DEPRESSION  0.1 DEGREES C       REAL
C       4    PRES. QUALITY MARKER (SEE $)             REAL
C       5    TEMP. QUALITY MARKER (SEE $)             REAL
C       6    DDPR. QUALITY MARKER (SEE $)             REAL
C       7    SPECIAL INDICATOR    (SEE $$)            REAL
C
C     DATA LEVEL CATEGORY 3 - WINDS AT VARIABLE PRESSURE
C     WORD   PARAMETER            UNITS               FORMAT
C     ----   ---------            -----------------   -------------
C       1    PRESSURE             0.1 MILLIBARS       REAL
C       2    WIND DIRECTION       DEGREES             REAL
C       3    WIND SPEED           0.1 METERS/SEC      REAL
C       4    PRES. QUALITY MARKER (SEE $)             REAL
C       5    WIND  QUALITY MARKER (SEE $)             REAL
C       6    SPECIAL INDICATOR    (SEE $$$)           REAL
C
C     DATA LEVEL CATEGORY 4 - WINDS AT VARIABLE HEIGHTS
C     WORD   PARAMETER            UNITS               FORMAT
C     ----   ---------            -----------------   -------------
C       1    GEOPOTENTIAL         METERS              REAL
C       2    WIND DIRECTION       DEGREES             REAL
C       3    WIND SPEED           0.1 METERS/SEC      REAL
C       4    GEOP. QUALITY MARKER (SEE $)             REAL
C       5    WIND  QUALITY MARKER (SEE $)             REAL
C
C     DATA LEVEL CATEGORY 5 - TROPOPAUSE DATA
C     WORD   PARAMETER            UNITS               FORMAT
C     ----   ---------            -----------------   -------------
C       1    PRESSURE             0.1 MILLIBARS       REAL
C       2    TEMPERATURE          0.1 DEGREES C       REAL
C       3    DEWPOINT DEPRESSION  0.1 DEGREES C       REAL
C       4    WIND DIRECTION       DEGREES             REAL
C       5    WIND SPEED           0.1 METERS/SEC      REAL
C       6    PRES. QUALITY MARKER (SEE $)             REAL
C       7    TEMP. QUALITY MARKER (SEE $)             REAL
C       8    DDPR. QUALITY MARKER (SEE $)             REAL
C       9    WIND  QUALITY MARKER (SEE $)             REAL
C
C     DATA LEVEL CATEGORY 6 - CONSTANT-LEVEL DATA (AIRCRAFT,
C                   SATELLITE-DERIVED WIND)
C     WORD   PARAMETER            UNITS               FORMAT
C     ----   ---------            -----------------   -------------
C       1    PRESSURE             0.1 MILLIBARS       REAL
C       2    PRESSURE ALTITUDE    METERS              REAL
C       3    TEMPERATURE          0.1 DEGREES C       REAL
C       4    SPECIFIC HUMIDITY    G/KG                REAL
C       5    WIND DIRECTION       DEGREES             REAL
C       6    WIND SPEED           0.1 METERS/SEC      REAL
C       7    PRES. QUALITY MARKER (SEE $)             REAL
C       8    P-ALT QUALITY MARKER (SEE $)             REAL
C       9    TEMP. QUALITY MARKER (SEE $)             REAL
C      10    S-HUM QUALITY MARKER (SEE $)             REAL
C      11    WIND  QUALITY MARKER (SEE $)             REAL
C
C     DATA LEVEL CATEGORY 8 - ADDITIONAL DATA
C     WORD   PARAMETER            UNITS               FORMAT
C     ----   ---------            -----------------   -------------
C       1    VARIABLE SPEPIFIED   (SEE &)             REAL
C            BY CODE FIGURE
C       2    CODE FIGURE          (SEE &)             REAL
C       3    INDICATOR 1          (SEE &)             REAL    
C       4    INDICATOR 2          (SEE &)             REAL    
C
C     DATA LEVEL CATEGORY 51 - SURFACE DATA
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    WIND DIRECTION       DEGREES             REAL
C       4    WIND SPEED           0.1 METERS/SEC      REAL
C       5    AIR TEMPERATURE      0.1 DEGREES C       REAL
C       6    DEWPOINT DEPRESSION  0.1 DEGREES C       REAL
C       7    reserved             XMISS               REAL
C       8    reserved             XMISS               REAL
C       9    MSL-P QUALITY MARKER (SEE $)             REAL
C      10    STN-P QUALITY MARKER (SEE $)             REAL
C      11    WIND  QUALITY MARKER (SEE $)             REAL
C      12    ATEMP QUALITY MARKER (SEE $)             REAL
C      13    DDPR. QUALITY MARKER (SEE $)             REAL
C
C    $ - QUALITY MARKER CODE TABLE:
C             0. - MONITOR KEEP
C             1. - GOOD
C             2. - NEUTRAL OR NOT CHECKED (DEFAULT)
C             3. - SUSPECT
C             4. - GOOD - CORRECTED BY O.P.C. (SURFACE MARINE ONLY)
C            12. - REJECT LIST, DO NOT USE
C            13. - FAILED AUTOMATIC Q.C. TESTS, DO NOT USE
C            14. - MONITOR PURGE, DO NOT USE
C
C    $$  - DATA LEVEL CATEGORY 2 SPECIAL INDICATOR:
C             0. - NOTHING INDICATED (DEFAULT)
C             4. - LEVEL PRESSURE ESTIMATED
C
C    $$$ - DATA LEVEL CATEGORY 3 SPECIAL INDICATOR:
C             0. - NOTHING INDICATED (DEFAULT)
C             1. - TROPOPAUSE LEVEL
C             2. - MAXIMUM WIND LEVEL
C             3. - MAXIMUM WIND LEVEL AT TERMINATING LEVEL
C             4. - LEVEL PRESSURE ESTIMATED
C
C    & - DATA LEVEL CATEGORY 8 CODE FIGURE:
C           003 - DIFFUSE SOLAR RADIATION IN 100.*JOULE/M**2
C                  INDICATOR 2 CONTAINS TIME PERIOD OVER WHICH
C                   RADIATION WAS INTEGRATED (MINUTES)
C           004 - DIRECT SOLAR RADIATION IN 100.*JOULE/M**2
C                  INDICATOR 2 CONTAINS TIME PERIOD OVER WHICH
C                   RADIATION WAS INTEGRATED (MINUTES)
C           005 - QUALITY MARKER FOR TOTAL PRECIP. OVER  1-HR
C                 (see $ above)
C           006 - QUALITY MARKER FOR TOTAL PRECIP. OVER 24-HR
C                 (see $ above)
C           020 - QUALITY MARKER FOR ALTIMETER SETTING
C                 (see $ above)
C           021 - REPORT SEQUENCE NUMBER
C           104 - RELEASE TIME IN .01*HR
C           105 - RECEIPT TIME IN .01*HR
C                  INDICATOR 1 CONTAINS RECEIPT TIME SIGNIFICANCE
C                  (BUFR CODE TABLE 0-08-202, DEFINED IN THIS CODE)
C           189 - SSM/I 19 GHZ V BRIGHT. TEMP (DEG K TO 10**2 PRECISION)
C                  (FOR SUPEROBS THIS IS MEAN AND INDICATOR 1 IS
C                   STANDARD DEVIATION IN SAME UNITS)
C           190 - SSM/I 19 GHZ H BRIGHT. TEMP (DEG K TO 10**2 PRECISION)
C                  (FOR SUPEROBS THIS IS MEAN AND INDICATOR 1 IS
C                   STANDARD DEVIATION IN SAME UNITS)
C           191 - SSM/I 22 GHZ V BRIGHT. TEMP (DEG K TO 10**2 PRECISION)
C                  (FOR SUPEROBS THIS IS MEAN AND INDICATOR 1 IS
C                   STANDARD DEVIATION IN SAME UNITS)
C           192 - SSM/I 37 GHZ V BRIGHT. TEMP (DEG K TO 10**2 PRECISION)
C                  (FOR SUPEROBS THIS IS MEAN AND INDICATOR 1 IS
C                   STANDARD DEVIATION IN SAME UNITS)
C           193 - SSM/I 37 GHZ H BRIGHT. TEMP (DEG K TO 10**2 PRECISION)
C                  (FOR SUPEROBS THIS IS MEAN AND INDICATOR 1 IS
C                   STANDARD DEVIATION IN SAME UNITS)
C           194 - SSM/I 85 GHZ V BRIGHT. TEMP (DEG K TO 10**2 PRECISION)
C                  (FOR SUPEROBS THIS IS MEAN AND INDICATOR 1 IS
C                   STANDARD DEVIATION IN SAME UNITS)
C           195 - SSM/I 85 GHZ H BRIGHT. TEMP (DEG K TO 10**2 PRECISION)
C                  (FOR SUPEROBS THIS IS MEAN AND INDICATOR 1 IS
C                   STANDARD DEVIATION IN SAME UNITS)
C           196 - SSM/I OCEANIC WIND SPEED (M/SEC TO 10**1 PRECISION)
C                  (FOR SUPEROBS THIS IS MEAN AND INDICATOR 1 IS
C                   STANDARD DEVIATION IN SAME UNITS)
C                  INDICATOR 2 IS RAIN FLAG (BUFR CODE TABLE 0-33-217)
C           197 - SSM/I TOTAL PRECIPITABLE WATER (MM TO 10**1 PRECISION)
C                  (FOR SUPEROBS THIS IS MEAN AND INDICATOR 1 IS
C                   STANDARD DEVIATION IN SAME UNITS)
C                  INDICATOR 2 IS RAIN FLAG (BUFR CODE TABLE 0-33-217)
C           198 - RAINFALL RATE (MM/SEC, TO 10**6 PRECISION FOR SSM/I
C                   AND TO 10**4 PRECISION FOR ALL OTHER DATA TYPES)
C                  (FOR SSM/I SUPEROBS THIS IS MEAN AND INDICATOR 1 IS
C                   STANDARD DEVIATION IN SAME UNITS)
C                  INDICATOR 2 CONTAINS RAINFALL RATE QUALITY MARKER
C           199 - SSM/I SURFACE TEMP. (DEG. KELVIN TO 10**2 PRECISION)
C                  (FOR SUPEROBS THIS IS MEAN AND INDICATOR 1 IS
C                   STANDARD DEVIATION IN SAME UNITS)
C           200 - SSM/I CLOUD WATER (MM * 100)
C                  (FOR SUPEROBS THIS IS MEAN AND INDICATOR 1 IS
C                   STANDARD DEVIATION IN SAME UNITS)
C           201 - SSM/I SOIL MOISTURE (MM)
C                  (FOR SUPEROBS THIS IS MEAN AND INDICATOR 1 IS
C                   STANDARD DEVIATION IN SAME UNITS)
C           202 - SSM/I SNOW DEPTH (MM)
C                  (FOR SUPEROBS THIS IS MEAN AND INDICATOR 1 IS
C                   STANDARD DEVIATION IN SAME UNITS)
C           203 - SSM/I SEA-SURFACE TEMP. (DEG. K TO 10**2 PRECISION)
C                  (FOR SUPEROBS THIS IS MEAN AND INDICATOR 1 IS
C                   STANDARD DEVIATION IN SAME UNITS)
C           210 - SSM/I SURFACE TAG --
C                         0 - land
C                         1 - vegitation covered land
C                         2 - near coast
C                         3 - multiyear ice
C                         4 - possible ice
C                         5 - ocean
C                         6 - coast
C           211 - SSM/I ICE CONCENTRATION (PERCENT)
C           212 - SSM/I ICE AGE --
C                         0 - first year ice
C                         1 - multiyear ice
C           213 - SSM/I ICE EDGE --
C                         0 - no edge present
C                         1 - edge present
C           214 - SSM/I CALCULATED SURFACE TYPE --
C                         1 - vegetation
C                         2 - RESERVED
C                         3 - ice
C                         4 - RESERVED
C                         5 - ocean
C                         6 - coast
C                         7 - flooded condition
C                         8 - dense vegetation
C                         9 - dense agriculture crops
C                        10 - dry arable soil
C                        11 - moist soil
C                        12 - semi-arid surface
C                        13 - desert
C                        14 - precipitation over vegetation
C                        15 - precipitation over soil
C                        16 - composite vegetation-water
C                        17 - compostite soil-water-wet soil
C                        18 - dry snow
C                        19 - wet snow
C                        20 - refrozen snow
C           250-262 - RESERVED FOR W3UNPKB7
C           351 - GEOPOTENTIAL HEIGHT (METERS)
C                  INDICATOR 1 IS PRESSURE LEVEL (MB)
C                  INDICATOR 2 CONTAINS GEOPOTENTIAL QUALITY MARKER
C           352 - MEAN-SEA LEVEL PRESSURE IN 0.1*MB
C           353 - SOLAR AND INFRARED RADIATION CORRECTION INDICATOR
C                   (BUFR CODE TABLE 0-02-013)
C           354 - TRACKING TECHNIQUE/STATUS OF SYSTEM USED INDICATOR
C                   (BUFR CODE TABLE 0-02-014)
C           355 - PERCENT CONFIDENCE BASED ON NESDIS RECURSIVE FILTER
C                 FUNCTION (SATELLITE WINDS) (%)
C                   (BUFR CODE TABLE 0-33-196)
C           356 - PERCENT CONFIDENCE BASED ON EUMETSAT QUALITY INDEX
C                   WITH FORECAST CONSISTENCY TEST (SATELLITE WINDS)
C                   (%) (BUFR CODE TABLE 0-33-197)
C           357 - PERCENT CONFIDENCE BASED ON EUMETSAT QUALITY INDEX
C                   WITHOUT FORECAST CONSISTENCY TEST (SATELLITE WINDS)
C                   (%) (BUFR CODE TABLE 0-33-198)
C           358 - PERCENT CONFIDENCE BASED ON NESDIS EXPECTED ERROR
C                   (SATELLITE WINDS) (%) (BUFR CODE TABLE 0-33-203)
C           914 - AMDAR FORMAT, MDCRS ACARS, E-AMDAR OR CANADIAN AMDAR
C                    AIRCRAFT PHASE OF FLIGHT (BUFR CODE TABLE 0-08-004)
C           915 - AMDAR FORMAT, MDCRS ACARS. E-AMDAR OR CANADIAN AMDAR
C                    AIRCRAFT  PRECISION OF TEMPERATURE OBSERVATION IN
C                    0.01*DEG. K
C           926 - MDCRS ACARS TURBULENCE INDEX FOR PERIOD T-1 MINUTE TO
C                    T-0 MINUTES (BUFR CODE TABLE 0-11-236)
C           927 - MDCRS ACARS TURBULENCE INDEX FOR PERIOD T-2 MINUTE TO
C                    T-1 MINUTES (BUFR CODE TABLE 0-11-237)
C           928 - MDCRS ACARS TURBULENCE INDEX FOR PERIOD T-3 MINUTE TO
C                    T-2 MINUTES (BUFR CODE TABLE 0-11-238)
C           929 - MDCRS ACARS TURBULENCE INDEX FOR PERIOD T-4 MINUTE TO
C                    T-3 MINUTES (BUFR CODE TABLE 0-11-239)
C           930 - TAMDAR TURBULENCE INDEX (BUFR CODE TABLE 0-11-235)
C                  INDICATOR 2 CONTAINS TURBULENCE INDEX QUALITY MARKER
C                  (0-15)
C           931 - TAMDAR ROLL ANGLE FLAG (BUFR CODE TABLE 0-02-199)
C           932 - INSTANTANEOUS ALTITUDE RATE IN .001*METERS/SECOND
C
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C           CONTENTS OF UNPACKED REPORT DATA IN THE "OBS2" ARRAY
C                       (ALL VALUES IN REAL FORMAT)
C                    (MISSING DATA ARE SET TO "BMISS")
C
C   ***************************************************************
C   WORD   CONTENT                            UNIT                 
C   ----   --------------------------------   -------------------
C     1    RESTRICTIONS ON REDISTRIBUTION     BUFR FLAG TBL "0 35 200"
C     2    EXPIRATION OF RESTRICTIONS ON      HOURS
C          REDISTRIBUTION
C     3    ALTIMETER SETTING                  PASCALS
C     4    SEA-SURFACE TEMPERATURE            KELVIN
C     5    DEPTH AT WHICH SEA-SURFACE         METERS
C          TEMPERATURE MEASURED
C     6    METHOD OF SEA SURFACE TEMPERATURE  BUFR CODE TBL "0 02 038"
C          MEASUREMENT 
C     7    RELATIONSHIP TO HORIZONTAL         BUFR CODE TBL "0 08 201"
C          VISIBILITY
C     8    HORIZONTAL VISIBILITY              METERS
C     9    VERTICAL VISIBILITY                METERS
C    10    PAST WEATHER - 1                   BUFR CODE TBL "0 20 004"
C    11    PAST WEATHER - 2                   BUFR CODE TBL "0 20 005"
C    12    PEAK WIND SPEED                    METERS/SEC
C    13    PEAK WIND DIRECTION                DEGREES
C    14    DURATION OF TIME FOR MAXIMUM       MINUTES
C          WIND SPEED (GUST)
C    15    MAXIMUM WIND SPEED (GUST)          METERS/SEC
C    16    MAXIMUM WIND GUST DIRECTION        DEGREES
C    17    TOTAL PRECIPITATION PAST  1-HR     KG/METERS**2
C    18    TOTAL PRECIPITATION PAST  3-HR     KG/METERS**2
C    19    TOTAL PRECIPITATION PAST  6-HR     KG/METERS**2
C    20    TOTAL PRECIPITATION PAST 12-HR     KG/METERS**2
C    21    TOTAL PRECIPITATION PAST 24-HR     KG/METERS**2
C    22    TOTAL SUNSHINE                     MINUTES
C    23    TOTAL CLOUD COVER                  PERCENT
C    24    HEIGHT ABOVE SURFACE OF BASE OF    BUFR CODE TBL "0 20 201"
C          LOWEST CLOUD SEEN
C    25    10 METER EXTRAPOLATED WIND SPEED   METERS/SEC
C    26    20 METER EXTRAPOLATED WIND SPEED   METERS/SEC
C    27    SURFACE WIND DIRECTION             DEGREES
C    28    SURFACE WIND SPEED                 METERS/SEC
C    29    DURATION OF TIME FOR DEPTH OF      HOURS
C          FRESH SNOW  
C    30    DEPTH OF FRESH SNOW                METERS
C    31    TOTAL SNOW DEPTH                   METERS
C    32    HEIGHT OF WAVES                    METERS
C    33    PERIOD OF WAVES                    SECONDS
C    34    HEIGHT OF WIND WAVES               METERS
C    35    PERIOD OF WIND WAVES               SECONDS
C    36    TRUE DIRECTION OF SHIP PAST 3-HRS  BUFR CODE TBL "0 01 193"
C    37    AVERAGE SPEED OF SHIP PAST 3-HRS   BUFR CODE TBL "0 01 200"
C    38    CHARACTERISTIC OF PRESSURE         BUFR CODE TBL "0 10 063"
C          TENDENCY
C    39    03-HOUR PRESSURE CHANGE            PASCALS
C    40    24-HOUR PRESSURE CHANGE            PASCALS
C    41    SEA-SURFACE TEMPERATURE Q. MARK    BUFR CODE TBL "0 22 246"
C                                             (HARDWIRED TO 2 IF SST
C                                             NON-MISSING, ELSE TO
C                                             MISSING IF SST MISSING)
C    42    MOISTURE QUALITY                   BUFR CODE TBL "0 33 026"
C    43    SATELLITE ZENITH ANGLE             DEGREES
C
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C           CONTENTS OF UNPACKED REPORT DATA IN THE "OBS3" ARRAY
C                       (ALL VALUES IN REAL FORMAT)
C            (MISSING DATA OR UNUSED VALUES ARE SET TO "BMISS")
C
C   ***************************************************************
C
C             OBS3(X,Y,1) ON LEVELS ("Y") 1 THROUGH NOBS3(1)
C
C   WORD   CONTENT                            UNIT                 
C    (X)
C   ----   --------------------------------   -------------------
C     1    DURATION OF TIME FOR TOTAL         HOURS
C          PRECIPITATION MEASURMENT  
C     2    TOTAL PRECIPITATION MEASUREMENT    KG/METERS**2
C
C
C             OBS3(X,Y,2) ON LEVELS ("Y") 1 THROUGH NOBS3(2)
C
C   WORD   CONTENT                            UNIT                 
C    (X)
C   ----   --------------------------------   -------------------
C     1    PRESENT WEATHER                    BUFR CODE TBL "0 20 003"
C
C
C             OBS3(X,Y,3) ON LEVELS ("Y") 1 THROUGH NOBS3(3)
C
C   WORD   CONTENT                            UNIT                 
C    (X)
C   ----   --------------------------------   -------------------
C     1    VERTICAL SIGNIFICANCE (SURFACE     BUFR CODE TBL "0 08 002"
C          OBSERVATION)
C     2    CLOUD AMOUNT                       BUFR CODE TBL "0 20 011"
C     3    CLOUD TYPE                         BUFR CODE TBL "0 20 012"
C     4    HEIGHT OF BASE OF CLOUD            METERS
C     5    HEIGHT OF TOP OF CLOUD             METERS
C
C
C             OBS3(X,Y,4) ON LEVELS ("Y") 1 THROUGH NOBS3(4)
C
C   WORD   CONTENT                            UNIT                 
C    (X)
C   ----   --------------------------------   -------------------
C     1    DURATION OF TIME FOR MAXIMUM       HOURS
C          TEMPERATURE
C     2    MAXIMUM TEMPERATURE                KELVIN
C     3    DURATION OF TIME FOR MINIMUM       HOURS
C          TEMPERATURE
C     4    MINIMUM TEMPERATURE                KELVIN
C
C
C             OBS3(X,Y,5) ON LEVELS ("Y") 1 THROUGH NOBS3(5)
C
C   WORD   CONTENT                            UNIT                 
C    (X)
C   ----   --------------------------------   -------------------
C     1    DIRECTION OF SWELL WAVES           DEGREES
C     2    HEIGHT OF SWELL WAVES              METERS
C     3    PERIOD OF SWELL WAVES              SECONDS
C
C
C             OBS3(X,Y,6) ON LEVELS ("Y") 1 THROUGH NOBS3(6)
C
C   WORD   CONTENT                            UNIT                 
C    (X)
C   ----   --------------------------------   -------------------
C     1    AIRFRAME ICING                     BUFR CODE TBL "0 20 041"
C     2    HEIGHT OF BASE OF ICING            METERS
C     3    HEIGHT OF TOP OF ICING             METERS 
C
C
C             OBS3(X,Y,7) ON LEVELS ("Y") 1 THROUGH NOBS3(7)
C
C   WORD   CONTENT                            UNIT                 
C    (X)
C   ----   --------------------------------   -------------------
C     1    DEGREE OF TURBULENCE               BUFR CODE TBL "0 11 031"
C     2    HEIGHT OF BASE OF TURBULENCE       METERS
C     3    HEIGHT OF TOP OF TURBULENCE        METERS
C
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C          CONTENTS OF UNPACKED REPORT DATA IN THE "OBS8_8" ARRAY
C                       (ALL VALUES IN REAL*8 FORMAT)
C                    (MISSING DATA ARE SET TO "BMISS")
C
C   ***************************************************************
C   WORD   CONTENT                            UNIT
C   ----   --------------------------------   -------------------
C     1    LATITUDE                           DEGREES (N+,S-)
C     2    LONGITUDE                          DEGREES (E+,W-)
C
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE:  NCEP WCOSS
C
C$$$
      FUNCTION IW3UNPBF(LUNIT,OBS,STNID,CRES1,CRES2,CBULL,OBS2,OBS3,
     $ NOBS3,obs8_8,DSNAME,IDSDAT,IDSDMP_8,SUBSET_r,SUBSKP,IER)
 
      PARAMETER (NUMCAT=8, LEVLIM=300)

      COMMON/IUBFAA/BMISS
      COMMON/IUBFBB/KNDX,KSKACF(8),KSKUPA,KSKSFC,KSKSAT,KFLSAT(12),
     $ KSKSMI
      COMMON/IUBFCC/SUBSET
      COMMON/IUBFDD/HDR(12),RCATS(50,LEVLIM,NUMCAT),IKAT(NUMCAT),
     $ MCAT(NUMCAT),NCAT(NUMCAT),LVDX(NUMCAT)
      COMMON/IUBFEE/ROBS(255,9)
      COMMON/IUBFFF/QMS(255,5)
      COMMON/IUBFGG/SFO(6)
      COMMON/IUBFHH/SFQ(5)
      COMMON/IUBFII/PWMIN
      COMMON/IUBFJJ/ISET,MANLIN(1001)
      COMMON/IUBFKK/KOUNT(499,18,2),KNTSAT(250:260),KNTMODIS(783:785),
     $ KNTavhrr(3:224),KNTviirs(224:225),IFLSAT,knts16(270:274)
      COMMON/IUBFLL/Q8(255,2)
      COMMON/IUBFMM/XIND(255)
      COMMON/IUBFNN/STNIDX,CRES1X,CRES2X
      COMMON/IUBFOO/DSNAMX,IDSDAX_8,IDSDMX_8
      COMMON/IUBFPP/LWI,LWR
      COMMON/IUBFQQ/NPRINT(0:255,0:200)
      COMMON/IUBFRR/IDATEB
      COMMON/IUBFSS/CBULLX
 
      DIMENSION    OBS(*),OBS2(43),OBS3(5,255,7),NOBS3(7),JWFILE(100)
      dimension    istart(3),iend(3)

      CHARACTER*8  STNID,STNIDX,CRES1,CRES1X,CRES2,CRES2X,DSNAME,DSNAMX,
     $ SUBSET_r,SUBSET
      CHARACTER*11 CBULL,CBULLX

      INTEGER(8) IDSDMP_8,IDSDAX_8,IDSDMX_8

      REAL(8)  BMISS,GETBMISS,obs8_8(2)

      LOGICAL  SUBSKP(0:255,0:200)

      SAVE

      DATA JWFILE/100*0/,LASTF/0/,ITIMES/0/
      data istart/3,200,223/,iend/5,209,223/

      IF(ITIMES.EQ.0)  THEN

        PRINT'(" ===> IW3UNPBF - WCOSS VERSION: 06-24-2021")'

C  THE FIRST TIME IN, INITIALIZE SOME DATA
C  (NOTE: FORTRAN 77/90 STANDARD DOES NOT ALLOW COMMON BLOCK VARIABLES
C         TO BE INITIALIZED VIA DATA STATEMENTS, AND, FOR SOME REASON,
C         THE BLOCK DATA MAY NOT INITIALIZE DATA IN THE W3EMC/W3NCO
C         LIBRARIES
C         A V O I D   B L O C K   D A T A   I N   W 3 L I B )
C  --------------------------------------------------------------------

         ITIMES   =  1
         KNDX     =  0
         KSKACF   =  0
         KSKUPA   =  0
         KSKSFC   =  0
         KSKSAT   =  0
         KFLSAT   =  0
         KSKSMI   =  0
         KOUNT    =  0
         KNTSAT   =  0
         knts16   =  0
         KNTMODIS =  0
         KNTavhrr =  0
         KNTviirs =  0
         IFLSAT   =  0

C  IKAT defines the category number

         IKAT(1)  =  1
         IKAT(2)  =  2
         IKAT(3)  =  3
         IKAT(4)  =  4
         IKAT(5)  =  5
         IKAT(6)  =  6
         IKAT(7)  = 51
         IKAT(8)  =  8

C  MCAT defines the number of parameters in a level for each category
C --> THIS NEEDS TO BE UPDATED WHEN ADDING MORE WORDS PER CAT LEVEL

         MCAT(1)  = 11  ! Cat.  1
         MCAT(2)  =  7  ! Cat.  2
         MCAT(3)  =  6  ! Cat.  3
         MCAT(4)  =  5  ! Cat.  4
         MCAT(5)  =  9  ! Cat.  5
         MCAT(6)  = 11  ! Cat.  6
         MCAT(7)  = 13  ! Cat. 51
         MCAT(8)  =  4  ! Cat.  8

C  LVDX defines location in UNP holding the no. of levels for each cat.

         LVDX(1)  = 13  ! Cat.  1
         LVDX(2)  = 15  ! Cat.  2
         LVDX(3)  = 17  ! Cat.  3
         LVDX(4)  = 19  ! Cat.  4
         LVDX(5)  = 21  ! Cat.  5
         LVDX(6)  = 23  ! Cat.  6
         LVDX(7)  = 29  ! Cat. 51
         LVDX(8)  = 27  ! Cat.  8

         ISET  = 0
      END IF

C  UNIT NUMBER OUT OF RANGE RETURNS A 999
C  --------------------------------------

      IF(LUNIT.LT.1 .OR. LUNIT.GT.100)  THEN
         PRINT'(" ##IW3UNPBF - UNIT NUMBER ",I0," OUT OF RANGE -- ",
     $    "IER = 999")', LUNIT
         GO TO 9999
      END IF
      IF(LASTF.NE.LUNIT .AND. LASTF.GT.0) THEN
         CALL CLOSBF(LASTF)
         JWFILE(LASTF) = 0
      END IF
      LASTF = LUNIT
 
   60 CONTINUE

C  THE JWFILE INDICATOR: =0 IF UNOPENED; =2 IF OPENED AND NCEP BUFR
C  ----------------------------------------------------------------
 
      IF(JWFILE(LUNIT).EQ.0) THEN
         PRINT'(" ===> IW3UNPBF - WCOSS VERSION: 01-06-2020")'

C  DETERMINE MACHINE WORD LENGTH (BYTES) FOR BOTH INTEGERS AND REALS
C  -----------------------------------------------------------------

         CALL WORDLENGTH(LWI,LWR)
         PRINT 2213, LWI,LWR
 2213 FORMAT(/' ---> IW3UNPBF - MACHINE WORD LENGTH (BYTES) FOR ',
     $ 'INTEGER WORDS IS ',I3/' ---> IW3UNPBF - MACHINE WORD LENGTH ',
     $ '(BYTES) FOR   REAL  WORDS IS ',I3/)
         NPRINT = 0

         BMISS = GETBMISS()
         print'(1X)'
         print'(" BUFRLIB value for missing passed into IW3UNPBF is: ",
     $    G0)', bmiss
         print'(1X)'

         IF(IER.EQ.-1)  THEN
            IER = 0  
            PRINT 4567, LUNIT
 4567 FORMAT(/'##IW3UNPBF: UNIT NUMBER',I3,' HAS ALREADY BEEN OPENED ',
     $ 'BY CORRESPONDING INTERFACE SUBROUTINE W3UNPKB7 AND REPORTS ',
     $ 'HAVE BEEN'/12X,'PROCESSED - CONTINUE PROCESSING REPORTS HERE'/)
            JWFILE(LUNIT) = 2
            DSNAMX   = DSNAME
            IDSDAX_8 = IDSDAT
            IDSDMX_8 = IDSDMP_8
            SUBSET   = SUBSET_r

  867       CONTINUE

            ISUB = 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(ISUB.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(/'IW3UNPBF/I02UBF - 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
                  CALL READMG(LUNIT,SUBSET,idateb,IRET)
                  IF(IRET.NE.0)  THEN
                     IER = 2
                     IW3UNPBF = 2
                     RETURN
                  END IF
                  GO TO 867
               END IF
            END IF
            GO TO 60
         END IF
         IERR = I02UBF(LUNIT,OBS,OBS2,OBS3,NOBS3,obs8_8,SUBSKP,IER)
         IF(IERR.EQ.1) THEN
            PRINT'(" IW3UNPBF - OPENED AN NCEP BUFR FILE IN UNIT ",I0)',
     $       LUNIT
            JWFILE(LUNIT) = 2
            KNDX = 0
            KSKACF = 0
            KSKUPA = 0
            KSKSFC = 0
            KSKSAT = 0
            KFLSAT = 0
            KSKSMI = 0
            IFLSAT = 0
            IER = 1
            IW3UNPBF = 1
         ELSE IF(IERR.NE.999) THEN
            IER = 3
            IW3UNPBF = 3                                
         ELSE
            IER = 999
            IW3UNPBF = 999
         END IF
      ELSE IF(JWFILE(LUNIT).EQ.2) THEN
         IF(I02UBF(LUNIT,OBS,OBS2,OBS3,NOBS3,obs8_8,SUBSKP,IER).NE.0)
     $    JWFILE(LUNIT) = 0
         IF(IER.GT.0) CALL CLOSBF(LUNIT)
         IF(IER.EQ.2.OR.IER.EQ.3)  THEN
            PRINT'(1X)'
            IF(KSKACF(1).GT.0)  PRINT'(" IW3UNPBF - NO. OF AIRCFT/",
     $       "AIRCAR REPORTS TOSSED DUE TO ZERO CAT. 6 LVLS = ",I0)',
     $       KSKACF(1)
            IF(KSKACF(8).GT.0)  PRINT'(" IW3UNPBF - NO. OF AIRCFT ",
     $       "REPORTS TOSSED DUE TO BEING ""PHWR"" AIREP FORMAT = ",
     $       I0)', KSKACF(8)
            IF(KSKACF(3).GT.0)  PRINT'(" IW3UNPBF - NO. OF AMDAR ",
     $       "FORMAT ASDAR/ACARS AIRCFT REPORTS TOSSED DUE TO BEING ",
     $       "DISGUISED AS AIREP FORMAT REPORTS BY AFWA = ",I0)',
     $       KSKACF(3)
            IF(KSKACF(4).GT.0)  PRINT'(" IW3UNPBF - NO. OF MDCRS ACARS",
     $       " AIRCFT REPORTS TOSSED DUE TO BEING DISGUISED AS ",
     $       "AIREP FORMAT REPORTS BY AFWA = ",I0)', KSKACF(4)
            IF(KSKACF(5).GT.0)  PRINT'(" IW3UNPBF - NO. OF AIRCFT/",
     $       "AIRCAR REPORTS TOSSED DUE TO HAVING MISSING WIND = ",I0)',
     $       KSKACF(5)
            IF(KSKACF(1)+KSKACF(3)+KSKACF(4)+KSKACF(5)+KSKACF(8).GT.0)
     $       PRINT'(" IW3UNPBF - TOTAL NO. OF AIRCFT/AIRCAR REPORTS ",
     $        "TOSSED = ",I0)',
     $        KSKACF(1)+KSKACF(3)+KSKACF(4)+KSKACF(5)+KSKACF(8)
            IF(KSKUPA.GT.0)  PRINT'(" IW3UNPBF - TOTAL NO. OF ADPUPA ",
     $       "REPORTS TOSSED = ",I0)', KSKUPA
            IF(KSKSFC.GT.0)  PRINT'(" IW3UNPBF - TOTAL NO. OF ADPSFC/",
     $       "SFCSHP/SFCBOG/MSONET REPORTS TOSSED = ",I0)', KSKSFC
            IF(KSKSAT.GT.0)  PRINT'(" IW3UNPBF - TOTAL NO. OF SATWND ",
     $       "REPORTS TOSSED = ",I0)', KSKSAT
            IF(KFLSAT(1).GT.0)  PRINT'(" IW3UNPBF - TOTAL NO. OF ",
     $       "EUMETSAT SATWND REPORTS FLAGGED WITH WQM=13 DUE TO QI ",
     $       "CONFIDENCE FACTOR </= LIMqi % = ",I0)', KFLSAT(1)
            IF(KFLSAT(2).GT.0)  PRINT'(" IW3UNPBF - TOTAL NO. OF ",
     $       "EUMETSAT SATWND REPORTS FLAGGED WITH WQM=13 DUE TO QI ",
     $       "MANUAL/AUTOMATIC Q.C. INDICATOR >/= LIMqc = ",I0)',
     $       KFLSAT(2)
            IF(KFLSAT(3).GT.0)  PRINT'(" IW3UNPBF - TOTAL NO. OF JMA ",
     $       "SATWND REPORTS FLAGGED WITH WQM=13 DUE TO QI CONFIDENCE ",
     $       "FACTOR </= LIMqi % = ",I0)', KFLSAT(3)
            IF(KFLSAT(4).GT.0)  PRINT'(" IW3UNPBF - TOTAL NO. OF JMA ",
     $       "SATWND REPORTS FLAGGED WITH WQM=13 DUE TO QI MANUAL/",
     $       "AUTOMATIC Q.C. INDICATOR >/= LIMqc = ",I0)', KFLSAT(4)
            IF(KFLSAT(5).GT.0)  PRINT'(" IW3UNPBF - TOTAL NO. OF GOES ",
     $       "SATWND REPORTS FLAGGED WITH WQM=13 DUE TO QI CONFIDENCE ",
     $       "FACTOR </= LIMqi % = ",I0)', KFLSAT(5)
            IF(KFLSAT(6).GT.0)  PRINT'(" IW3UNPBF - TOTAL NO. OF GOES ",
     $       "SATWND REPORTS FLAGGED WITH WQM=13 DUE TO QI MANUAL/",
     $       "AUTOMATIC Q.C. INDICATOR >/= LIMqc = ",I0)', KFLSAT(6)
            IF(KFLSAT(7).GT.0)  PRINT'(" IW3UNPBF - TOTAL NO. OF MODIS",
     $       " POES SATWND REPORTS FLAGGED WITH WQM=13 DUE TO QI ",
     $       "CONFIDENCE FACTOR </= LIMqi % = ",I0)', KFLSAT(7)
            IF(KFLSAT(8).GT.0)  PRINT'(" IW3UNPBF - TOTAL NO. OF MODIS",
     $       " POES SATWND REPORTS FLAGGED WITH WQM=13 DUE TO QI ",
     $       "MANUAL/AUTOMATIC Q.C. INDICATOR >/= LIMqc = ",I0)',
     $       KFLSAT(8)
            IF(KFLSAT(9).GT.0)  PRINT *, 'IW3UNPBF - TOTAL NO. OF ',
     $       'AVHRR POES SATWND REPORTS FLAGGED WITH WQM=13 DUE TO QI ',
     $       'CONFIDENCE FACTOR </= LIMqi % = ',KFLSAT(9)
            IF(KFLSAT(10).GT.0)  PRINT *, 'IW3UNPBF - TOTAL NO. OF ',
     $       'AVHRR POES SATWND REPORTS FLAGGED WITH WQM=13 DUE TO QI ',
     $       'MANUAL/AUTOMATIC Q.C. INDICATOR >/= LIMqc = ',KFLSAT(10)
            IF(KFLSAT(11).GT.0)  PRINT *, 'IW3UNPBF - TOTAL NO. OF ',
     $       'VIIRS POES SATWND REPORTS FLAGGED WITH WQM=13 DUE TO QI ',
     $       'CONFIDENCE FACTOR </= LIMqi % = ',KFLSAT(11)
            IF(KFLSAT(12).GT.0)  PRINT *, 'IW3UNPBF - TOTAL NO. OF ',
     $       'VIIRS POES SATWND REPORTS FLAGGED WITH WQM=13 DUE TO QI ',
     $       'MANUAL/AUTOMATIC Q.C. INDICATOR >/= LIMqc = ',KFLSAT(12)
            IF(KSKSMI.GT.0)  PRINT'(" IW3UNPBF - TOTAL NO. OF SPSSMI ",
     $       "REPORTS TOSSED = ",I0)', KSKSMI
            IF(IFLSAT.EQ.1)  THEN
               MFLAG = 0
               PRINT 8102
 8102 FORMAT(/' ---> IW3UNPBF: SUMMARY OF NESDIS GOES REPORT COUNTS ',
     $ 'GROUPED BY SATELLITE ID (PRIOR TO ANY FILTERING BY CALLING ',
     $ 'PROGRAM)'/)
               DO  IDSAT = 250,259
                  IF(KNTSAT(IDSAT).GT.0)  THEN
                     PRINT 8103, IDSAT,KNTSAT(IDSAT)
                     MFLAG = 1
                  ENDIF
               ENDDO
               do  idsat = 270,273
                  if(knts16(idsat).gt.0)  then
                     print 8103, idsat,knts16(idsat)
                     mflag = 1
                  endif
               enddo
 8103 FORMAT(15X,'NUMBER FROM SAT. ID',I4,4X,':',I6)
               IF(KNTSAT(260).GT.0.or.knts16(274).gt.0)  THEN
                  PRINT 8104, KNTSAT(260)+knts16(274)
                  MFLAG = 1
               ENDIF
 8104 FORMAT(15X,'TOTAL NUMBER FROM UNKNOWN SAT. IDs:',I6)
               IF(MFLAG.EQ.0)  PRINT 8110
 8110 FORMAT(15X,'NO REPORTS OF THIS TYPE WERE READ')
               PRINT 8105
 8105          FORMAT(/)
               MFLAG = 0
               PRINT 8202
 8202 FORMAT(/' ---> IW3UNPBF: SUMMARY OF NASA/MODIS POES REPORT ',
     $ 'COUNTS GROUPED BY SATELLITE ID (PRIOR TO ANY FILTERING BY ',
     $ 'CALLING PROGRAM)'/)
               DO  IDSAT = 783,784
                  IF(KNTMODIS(IDSAT).GT.0) THEN
                     PRINT 8103, IDSAT,KNTMODIS(IDSAT)
                     MFLAG = 1
                  ENDIF
               ENDDO
               IF(KNTMODIS(785).GT.0)  THEN
                  PRINT 8104, KNTMODIS(785)
                  MFLAG = 1
               ENDIF
               IF(MFLAG.EQ.0)  PRINT 8110
               PRINT 8105
               MFLAG = 0
               PRINT 8203
 8203 FORMAT(/' ---> IW3UNPBF: SUMMARY OF NESDIS/AVHRR POES REPORT ',
     $ 'COUNTS GROUPED BY SATELLITE ID (PRIOR TO ANY FILTERING BY ',
     $ 'CALLING PROGRAM)'/)
               do ii = 1,3
                  DO  IDSAT = istart(ii),iend(ii)
                     IF(KNTavhrr(IDSAT).GT.0) THEN
                        PRINT 8103, IDSAT,KNTavhrr(IDSAT)
                        MFLAG = 1
                     ENDIF
                  ENDDO
               enddo
               IF(KNTavhrr(224).GT.0)  THEN
                  PRINT 8104, KNTavhrr(224)
                  MFLAG = 1
               ENDIF
               IF(MFLAG.EQ.0)  PRINT 8110
               PRINT 8105
               MFLAG = 0
               PRINT 8204
 8204 FORMAT(/' ---> IW3UNPBF: SUMMARY OF NASA/VIIRS POES REPORT ',
     $ 'COUNTS GROUPED BY SATELLITE ID (PRIOR TO ANY FILTERING BY ',
     $ 'CALLING PROGRAM)'/)
               DO  IDSAT = 224,224
                  IF(KNTviirs(IDSAT).GT.0) THEN
                     PRINT 8103, IDSAT,KNTviirs(IDSAT)
                     MFLAG = 1
                  ENDIF
               ENDDO
               IF(KNTviirs(225).GT.0)  THEN
                  PRINT 8104, KNTviirs(225)
                  MFLAG = 1
               ENDIF
               IF(MFLAG.EQ.0)  PRINT 8110
               PRINT 8105
            END IF
            KNDX = 0
            KSKACF = 0
            KSKUPA = 0
            KSKSFC = 0
            KSKSAT = 0
            KFLSAT = 0
            KSKSMI = 0
            IFLSAT = 0
         END IF
         IW3UNPBF = IER
      END IF
 
      STNID    = STNIDX
      CRES1    = CRES1X
      CRES2    = CRES2X
      CBULL    = CBULLX
      DSNAME   = DSNAMX
      IDSDAT   = IDSDAX_8
      IDSDMP_8 = IDSDMX_8
      SUBSET_r = SUBSET

      RETURN

 9999 CONTINUE
      IER = 999
      IW3UNPBF = 999
      RETURN

      END
C***********************************************************************
C***********************************************************************
C***********************************************************************
      FUNCTION I02UBF(LUNIT,OBS,OBS2,OBS3,NOBS3,obs8_8,SUBSKP,IER)
 
      PARAMETER (MAXOBS=3500)

      COMMON/IUBFCC/SUBSET
      COMMON/IUBFOO/DSNAMX,IDSDAX_8,IDSDMX_8
      COMMON/IUBFQQ/NPRINT(0:255,0:200)
      COMMON/IUBFRR/IDATEB
 
      CHARACTER*8  SUBSET,DSNAMX,CBUFR
      CHARACTER*6  C01UBF
      DIMENSION    OBS(MAXOBS),OBS2(43),OBS3(5,255,7),NOBS3(7),JDATE(5),
     $ JDUMP(5)
      real(8)    obs8_8(2)
      INTEGER(8) IDSDAX_8,IDSDMX_8,JDUMP_8(5)
      LOGICAL  SUBSKP(0:255,0:200)
 
      SAVE

      JDATE = -1
      JDUMP = -1

      CALL STATUS(LUNIT,LUN,IL,IM)

      IF(IL.EQ.0) THEN
 
C  IF FILE IS CLOSED TRY TO OPEN IT AND RETURN INFORMATION ABOUT IT
C  IN DSNAMX, IDSDAX_8 AND IDSDMX_8
C  ----------------------------------------------------------------
 
         IRET = -1
         I02UBF = 2
         REWIND LUNIT
         READ(LUNIT,END=11,ERR=12,FMT='(A8)') CBUFR
         IF(CBUFR(1:4).EQ.'BUFR') THEN
            PRINT'(" IW3UNPBF - INPUT FILE ON UNIT ",I0, " IS",
     $      " UNBLOCKED NCEP BUFR"/)', LUNIT
         ELSE  IF(CBUFR(5:8).EQ.'BUFR') THEN
            PRINT'(" IW3UNPBF - INPUT FILE ON UNIT ",I0, " IS",
     $      " BLOCKED NCEP BUFR"/)', LUNIT
         ELSE
            PRINT'(" ##IW3UNPBF/I02UBF - INPUT FILE ON UNIT ",I0, " IS",
     $      " NOT NCEP BUFR -- IER = 999")', LUNIT
            I02UBF = 999
            GOTO 10
         END IF
         CALL DATELEN(10)
         CALL DUMPBF(LUNIT,JDATE,JDUMP)
         print'(" CENTER DATE (JDATE) = ",5(I0,1X))', jdate
         print'(" DUMP DATE   (JDUMP) = ",5(I0,1X))', jdump
         IF(JDATE(1).LE.0)  then
            PRINT'(" ##IW3UNPBF/I02UBF - CENTER DATE COULD NOT BE ",
     $       "OBTAINED FROM INPUT FILE ON UNIT ",I0," -- IER = 999")',
     $       LUNIT
            I02UBF = 999
            GO TO 10
         END IF
         IF(JDATE(1).LT.100)  THEN

C IF 2-DIGIT YEAR RETURNED IN JDATE(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'(" ##IW3UNPBF/I02UBF - THE FOLLOWING SHOULD NEVER ",
     $       "HAPPEN!!!!!")'
            PRINT'(" ##IW3UNPBF/I02UBF - 2-DIGIT YEAR IN JDATE(1) ",
     $       "RETURNED FROM DUMPBF (JDATE IS: ",I0,") - USE WINDOWING ",
     $       "TECHNIQUE TO OBTAIN 4-DIGIT YEAR")', JDATE
C IF JDATE=41~99 THEN JDATE=1941~1999
C IF JDATE=00~40 THEN JDATE=2000~2040
            IF(JDATE(1).GT.40)  THEN
               JDATE(1) = 1900 + JDATE(1)
            ELSE
               JDATE(1) = 2000 + JDATE(1)
            ENDIF
            PRINT'(" ##IW3UNPBF/I02UBF - CORRECTED JDATE(1) WITH 4-",
     $       "DIGIT YEAR, JDATE NOW IS: ",I0)', JDATE
         ENDIF
         IDSDAX_8 =JDATE(1)*1000000+JDATE(2)*10000+JDATE(3)*100+JDATE(4)

         IF(JDUMP(1).LE.0)  THEN
            IDSDMX_8 = 999999999999_8
         ELSE
            IF(JDUMP(1).LT.100)  THEN

C IF 2-DIGIT YEAR RETURNED IN JDUMP(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'(" ##IW3UNPBF/I02UBF - THE FOLLOWING SHOULD NEVER",
     $          " HAPPEN!!!!!")'
               PRINT'(" ##IW3UNPBF/I02UBF - 2-DIGIT YEAR IN JDUMP(1) ",
     $          "RETURNED FROM DUMPBF (JDUMP IS: ",I0,") - USE ",
     $          "WINDOWING TECHNIQUE TO OBTAIN 4-DIGIT YEAR")', JDUMP
C IF JDUMP=41~99 THEN JDUMP=1941~1999
C IF JDUMP=00~40 THEN JDUMP=2000~2040
               IF(JDUMP(1).GT.40)  THEN
                  JDUMP(1) = 1900 + JDUMP(1)
               ELSE
                  JDUMP(1) = 2000 + JDUMP(1)
               ENDIF
               PRINT'(" ##IW3UNPBF/I02UBF - CORRECTED JDUMP(1) WITH 4-",
     $          "DIGIT YEAR, JDUMP NOW IS: ",I0)', JDUMP
            END IF
            JDUMP_8 = JDUMP
            IDSDMX_8 = JDUMP_8(1)*100000000+JDUMP_8(2)*1000000+
     $       JDUMP_8(3)*10000+JDUMP_8(4)*100+JDUMP_8(5)
         ENDIF

         CALL OPENBF(LUNIT,'IN',LUNIT)
ccccccc  CALL OPENBF(0,'QUIET',1) ! will generate diagnostic print if
ccccccc                           ! an embedded BUFR table is read

C This next call, I believe, is needed only because SUBSET is not
C  returned in DUMPBF ...
         call readmg(lunit,subset,idateb,iret)

         DSNAMX = C01UBF(SUBSET)//'  '

         I02UBF = 1
         GO TO 10
   11    CONTINUE
         PRINT'(" ##IW3UNPBF/I02UBF - INPUT FILE ON UNIT ",I0," IS ",
     $    "EMPTY (NULL) -- ALL DONE WITH THIS FILE (IER = 3)")', LUNIT
         GO TO 10
   12    CONTINUE
         PRINT'(" ##IW3UNPBF/I02UBF - ERROR READING INPUT FILE ON UNIT",
     $    1X,I0," -- IER = 999")', LUNIT
         I02UBF = 999
   10    CONTINUE
         IER = I02UBF
         RETURN

      ELSE IF(IL.LT.0) THEN
 
C  IF THE FILE IS ALREADY OPENED FOR INPUT TRY TO READ THE NEXT SUBSET
C  -------------------------------------------------------------------
 
 7822    CONTINUE

C  READ THE NEXT SUBSET IN THE BUFR FILE
C  -------------------------------------

    1    CONTINUE
         CALL READSB(LUNIT,IRET)
         IF(IRET.NE.0)  THEN
   30       CONTINUE
            CALL READMG(LUNIT,SUBSET,idateb,IRET)
            IF(IRET.NE.0)  GO TO 20
            ISUB = 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(ISUB.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(/'IW3UNPBF/I02UBF - 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
                  GO TO 30
               END IF
            END IF
            GO TO 1
         END IF
   20    CONTINUE
         IF(IRET.EQ.0) I02UBF = R01UBF(SUBSET,LUNIT,OBS,OBS2,OBS3,NOBS3,
     $    obs8_8)
         IF(IRET.NE.0) I02UBF = 2
         IF(I02UBF.EQ.-9999)  GO TO 7822
         IER = I02UBF
         RETURN
      END IF
 
C  FILE MUST BE OPEN FOR INPUT!
C  ----------------------------
 
      PRINT'(" ##IW3UNPBF/I02UBF - FILE ON UNIT ",I0," IS OPENED FOR ",
     4 "OUTPUT -- IER = 999")', LUNIT
      I02UBF = 999
      IER = 999
      RETURN
 
      END
C***********************************************************************
C***********************************************************************
C***********************************************************************
      FUNCTION C01UBF(SUBSET)
 
      CHARACTER*(*) SUBSET
      CHARACTER*6   C01UBF
 
      SAVE
 
      C01UBF = 'NONE'
 
      IF(SUBSET(1:5).EQ.'NC000')  THEN
         C01UBF = 'ADPSFC'
      ELSE  IF(SUBSET(1:5).EQ.'NC001')  THEN
         IF(SUBSET(6:8).NE.'006')  THEN
            C01UBF = 'SFCSHP'
         ELSE
            C01UBF = 'SFCBOG'
         END IF
      ELSE  IF(SUBSET(1:5).EQ.'NC002')  THEN
         C01UBF = 'ADPUPA'
      ELSE  IF(SUBSET(1:5).EQ.'NC004')  THEN
         IF(SUBSET(6:8).EQ.'004' .OR. SUBSET(6:8).EQ.'007')  THEN
            C01UBF = 'AIRCAR'
         ELSE  IF(SUBSET(6:8).EQ.'005')  THEN
            C01UBF = 'ADPUPA'
         ELSE
            C01UBF = 'AIRCFT'
         END IF
      ELSE  IF(SUBSET(1:5).EQ.'NC005')  THEN
         C01UBF = 'SATWND'
      ELSE  IF(SUBSET(1:5).EQ.'NC012')  THEN
         C01UBF = 'SPSSMI'
      ELSE IF(SUBSET(1:5).EQ.'NC255')  THEN
         C01UBF = 'MSONET'
      END IF
 
      IF(C01UBF.EQ.'NONE') PRINT'(" ##IW3UNPBF/C01UBF - UNKNOWN SUBSET",
     $ "(=",A,") -- CONTINUE~~")', SUBSET
 
      RETURN
      END
C***********************************************************************
C***********************************************************************
C***********************************************************************
      FUNCTION R01UBF(SUBSET,LUNIT,OBS,OBS2,OBS3,NOBS3,obs8_8)
 
      CHARACTER*(*) SUBSET
      CHARACTER*6   C01UBF,ADPSUB
      DIMENSION     OBS(*),OBS2(43),OBS3(5,255,7),NOBS3(7)
      real*8        obs8_8(2)

      SAVE
 
C  FIND SPECIFIED UNPACKED DATA TYPE AND CALL A TRANSLATOR
C  -------------------------------------------------------
 
      R01UBF = 4
      ADPSUB = C01UBF(SUBSET)
      IF(ADPSUB .EQ. 'ADPUPA')  THEN
         R01UBF = R03UBF(LUNIT,OBS,OBS2,OBS3,NOBS3,obs8_8)
      ELSE  IF(ADPSUB(1:3).EQ.'AIR')  THEN
         R01UBF = R05UBF(LUNIT,OBS,OBS2,OBS3,NOBS3,obs8_8)
      ELSE  IF(ADPSUB .EQ. 'SATWND')  THEN
         R01UBF = R06UBF(LUNIT,OBS,OBS2,OBS3,NOBS3,obs8_8)
      ELSE  IF(ADPSUB .EQ. 'SPSSMI')  THEN
         R01UBF = R07UBF(LUNIT,OBS,OBS2,OBS3,NOBS3,obs8_8)
      ELSE
         R01UBF = R04UBF(LUNIT,OBS,OBS2,OBS3,NOBS3,obs8_8)
      END IF

      RETURN
      END
C***********************************************************************
C***********************************************************************
C***********************************************************************
      SUBROUTINE S01UBF(SID,XOB,YOB,RHR,RCTIM,RSV1,RSV2,ELV,QMELV,ITP,
     $ RTP,RSTP,IDS)
C     ---> PROCESSES HEADER
 
      PARAMETER (NUMCAT=8, LEVLIM=300)

      COMMON/IUBFAA/BMISS
      COMMON/IUBFDD/HDR(12),RCATS(50,LEVLIM,NUMCAT),IKAT(NUMCAT),
     $ MCAT(NUMCAT),NCAT(NUMCAT),LVDX(NUMCAT)
      COMMON/IUBFNN/STNIDX,CRES1X,CRES2X
 
      CHARACTER*(*) RSV1,RSV2
      CHARACTER*8   SID,STNIDX,CRES1X,CRES2X
      REAL(8)       BMISS
      DIMENSION     IHDR(12),RHDR(12)
      EQUIVALENCE   (IHDR(1),RHDR(1))

      SAVE
 
      DATA XMISS/99999./,IMISS/99999/
 
C  INITIALIZE THE UNPACK ARRAY TO MISSINGS
C  ---------------------------------------
 
C  NCAT will hold the number of unpacked levels in each category
      NCAT = 0
      RCATS = IMISS
 
C  STORE THE UNPACKED HEADER INFORMATION INTO UNP FORMAT
C  -----------------------------------------------------
 
      RHDR( 1) = MIN(YOB,XMISS)
      IF(YOB.GE.BMISS)  print'(" ~~IW3UNPBF/S01UBF: ID ",A," has a ",
     $ "missing LATITUDE - unpked hdr, word 1 is set to ",G0)',
     $ sid,RHDR(1)

C Important: According to BUFR Manual, CLON (0-06-002) - represented
C  here by "XOB" - 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 CLON in units of Degree East (0.0 to 359.99) -- So
C  we use the following conversion to work in either case ...
      RHDR( 2) = XMISS
      IF(XOB.LT.BMISS)  RHDR( 2) = 360. - MOD(720.-XOB,360.)
      IF(RHDR(2).EQ.360.0)  RHDR(2) = 0.0
      IF(XOB.GE.BMISS)  print'(" ~~IW3UNPBF/S01UBF: ID ",A," has a ",
     $ "missing LONGITUDE - unpked hdr, word 2 is set to ",G0)',
     $ sid,RHDR(2)
      RHDR( 3) = XMISS
      RHDR( 4) = MIN(RHR,XMISS)
      IF(RHR.GE.BMISS)  print'(" ~~IW3UNPBF/S01UBF: ID ",A," has a ",
     $ "missing OB TIME - unpked hdr, word 4 is set to ",G0)',
     $ sid,RHDR(4)
      RHDR( 5) = XMISS
      IHDR( 6) = IDS
cdak  RHDR( 7) = NINT(ELV)
      RHDR( 7) = MIN(NINT(ELV),IMISS)
      IHDR( 8) = ITP
      IHDR( 9) = RTP
      IHDR(10) = RSTP
      RHDR(11) = XMISS
      IF(RCTIM.LT.24.01.AND.RCTIM.GT.-.01)  RHDR(11) = RCTIM
      RHDR(12) = QMELV
      STNIDX = SID
      CRES1X = RSV1
      CRES2X = RSV2
 
C  STORE THE HEADER INTO A HOLDING ARRAY
C  -------------------------------------
 
      HDR = RHDR
 
      RETURN
      END
C***********************************************************************
C***********************************************************************
C***********************************************************************
      SUBROUTINE S02UBF(ICAT,N,*)
C     ---> PROCESSES DATA LEVEL CATEGORIES

      PARAMETER (NUMCAT=8, LEVLIM=300)

C      Input argument ICAT - the category number (1,2,3,4,5,6,8,51)
C      Input argument N - level indicator (unless = 0, then signals
C                         subr. to write an empty cat. 2,3, or 4 level
 
      COMMON/IUBFDD/HDR(12),RCATS(50,LEVLIM,NUMCAT),IKAT(NUMCAT),
     $ MCAT(NUMCAT),NCAT(NUMCAT),LVDX(NUMCAT)
      COMMON/IUBFEE/POB(255),QOB(255),TOB(255),ZOB(255),DOB(255),
     $              SOB(255),VSG(255),OB8(255),CF8(255)
      COMMON/IUBFFF/PQM(255),QQM(255),TQM(255),ZQM(255),WQM(255)
      COMMON/IUBFGG/PSL,STP,SDR,SSP,STM,DPD
      COMMON/IUBFHH/PSQ,SPQ,SWQ,STQ,DDQ
      COMMON/IUBFII/PWMIN
      COMMON/IUBFLL/Q81(255),Q82(255)
      COMMON/IUBFMM/XIND(255)
      COMMON/IUBFNN/STNIDX,CRES1X,CRES2X

      CHARACTER*8 STNIDX,CRES1X,CRES2X
      DIMENSION   RCAT(50),JCAT(50)
      EQUIVALENCE (RCAT(1),JCAT(1))
      LOGICAL     SURF

      SAVE
 
      DATA XMISS/99999./,IMISS/99999/
 
cppppp-ID
      iprint = 0
cc         iprint = 1

c     if(stnidx.eq.'89571   ')  iprint = 1
c     if(stnidx.eq.'68906   ')  iprint = 1
c     if(stnidx.eq.'68842   ')  iprint = 1
c     if(stnidx.eq.'74794   ')  iprint = 1
c     if(stnidx.eq.'74389   ')  iprint = 1
c     if(stnidx.eq.'96801A  ')  iprint = 1
cppppp-ID

      SURF = .FALSE.
      GOTO 1

C  ENTRY POINT SE01UBF FORCES DATA INTO THE SURFACE (FIRST) LEVEL
C  --------------------------------------------------------------

      ENTRY SE01UBF(ICAT,N)
C     ---> PROCESSES DATA INTO SURFACE LEVEL
      SURF = .TRUE.
 
C  CHECK THE PARAMETERS COMING IN (KCAT IS INDEX IN IKAT, MCAT, NCAT
C   FOR A PARTICULAR CATEGORY)
C  -----------------------------------------------------------------
 
1     KCAT = 0
      DO I = 1,NUMCAT
         IF(ICAT.EQ.IKAT(I))  THEN
            KCAT = I
            EXIT
         END IF
      ENDDO

C  PARAMETER ICAT (UNPACKED DATA LEVEL CATEGORY) OUT OF BOUNDS
C   RETURNS A 999
C  --------------------------------------------------------------

      IF(KCAT.EQ.0)  THEN
         PRINT'(" ##IW3UNPBF/S02UBF - UNPACKED CATEGORY ",I0," OUT OF ",
     $    "BOUNDS -- IER = 999")', ICAT
         RETURN 1
      END IF

C  PARAMETER N (LEVEL INDEX) OUT OF BOUNDS RETURNS A 999
C  -----------------------------------------------------

      IF(N.GT.255)  THEN
         PRINT'(" ##IW3UNPBF/S02UBF - LEVEL INDEX ",I0," EXCEEDS 255 ",
     $    "-- IER = 999")', N
         RETURN 1
      END IF
 
C  MAKE A MISSING LEVEL AND RETURN WHEN N=0 (NOT ALLOWED FOR CAT 01)
C   (NOTE: QUALITY MARKERS ARE SET TO 2 AND SPECIAL LEVEL INDICATORS
C          ARE SET TO 0)
C  -----------------------------------------------------------------
 
      IF(N.EQ.0) THEN
         IF(ICAT.EQ.1) RETURN
         NCAT(KCAT) = MIN(LEVLIM-1,NCAT(KCAT)+1)
         if(iprint.eq.1)  then
            print'(" To prepare for sfc. data, write all missings on ",
     $       "lvl ",I0," for cat ",i0)', ncat(kcat),icat
            print'("   also write default =2 for all q. markers")'
            print'("   also write default =0 for special lvl ",
     $       "indicators")'
         end if
         IF(ICAT.EQ.2)  THEN
            RCATS(4:6,NCAT(KCAT),KCAT) = 2.
            RCATS(7,NCAT(KCAT),KCAT)   = 0
         ELSE  IF(ICAT.EQ.3)  THEN
            RCATS(4:5,NCAT(KCAT),KCAT) = 2.
            RCATS(6,NCAT(KCAT),KCAT)   = 0
         ELSE  IF(ICAT.EQ.4)  THEN
            RCATS(4:5,NCAT(KCAT),KCAT) = 2.
         END IF
         RETURN
      END IF
 
C  FIGURE OUT WHICH LEVEL TO UPDATE AND RESET THE LEVEL COUNTER
C  ------------------------------------------------------------
 
      IF(ICAT.EQ.1) THEN
         L = I04UBF(POB(N)*.1)

C  MANDATORY LEVEL WITH NON-MANDATORY PRESSURE RETURNS A 999
C  ---------------------------------------------------------

         IF(L.LE.0)  THEN
            PRINT'(" ##IW3UNPBF/S02UBF - MANDATORY LEVEL WITH NON-",
     $       "MANDATORY PRESSURE (P = ",G0,"mb) -- IER = 999")',
     $       POB(N)*.1
            RETURN 1
         END IF
         NCAT(KCAT) = MAX(NCAT(KCAT),L)
         if(iprint.eq.1)
     $    print'(" Will write cat. 1 data on lvl ",I0," for cat ",I0,
     $    ", - total no. cat. 1 lvls processed so far = ",I0)',
     $    L,icat,ncat(kcat)
      ELSEIF(SURF) THEN
         L = 1
         NCAT(KCAT) = MAX(NCAT(KCAT),1)
         if(iprint.eq.1)
     $    print'(" Will write cat. ",I0," SURFACE data on lvl ",I0,
     $    ", - total no. cat. ",I0," lvls processed so far = ",I0)',
     $    icat,L,icat,ncat(kcat)
      ELSE
         L = MIN(LEVLIM-1,NCAT(KCAT)+1)
         IF(L.EQ.LEVLIM-1) THEN
            print'(" ~~IW3UNPBF/S02UBF: ID ",A," - This cat. ",I0,
     $       ", level cannot be processed because the limit of ",I0,
     $       " has already been reached")', stnidx,icat,LEVLIM
            RETURN
         END IF
         NCAT(KCAT) = L
         if(iprint.eq.1)
     $    print'(" Will write cat. ",I0," NON-SFC data on lvl ",I0,
     $    ", - total no. cat. ",I0," lvls processed so far = ",I0)',
     $    icat,L,icat,ncat(kcat)
      END IF
 
C  EACH DATA LEVEL CATEGORY NEEDS A SPECIFIC DATA ARRANGEMENT
C  ----------------------------------------------------------
 
      IF(ICAT.EQ.1) THEN
         RCAT(1)  = MIN(NINT(POB(N)),NINT(RCATS( 1,L,KCAT)))
         RCAT(2)  = MIN(NINT(ZOB(N)),NINT(RCATS( 2,L,KCAT)))
         RCAT(3)  = MIN(NINT(TOB(N)),NINT(RCATS( 3,L,KCAT)))
         RCAT(4)  = MIN(NINT(QOB(N)),NINT(RCATS( 4,L,KCAT)))
         RCAT(5)  = MIN(NINT(DOB(N)),NINT(RCATS( 5,L,KCAT)))
         RCAT(6)  = MIN(NINT(SOB(N)),NINT(RCATS( 6,L,KCAT)))
         IF(RCATS(7,L,KCAT).LT.IMISS)  THEN
            RCAT(7)  = MAX(NINT(PQM(N)),NINT(RCATS( 7,L,KCAT)))
         ELSE
            RCAT(7)  = NINT(PQM(N))
         END IF
         IF(RCATS(8,L,KCAT).LT.IMISS)  THEN
            RCAT(8)  = MAX(NINT(ZQM(N)),NINT(RCATS( 8,L,KCAT)))
         ELSE
            RCAT(8)  = NINT(ZQM(N))
         END IF
         IF(RCATS(9,L,KCAT).LT.IMISS)  THEN
            RCAT(9)  = MAX(NINT(TQM(N)),NINT(RCATS( 9,L,KCAT)))
         ELSE
            RCAT(9)  = NINT(TQM(N))
         END IF
         IF(RCATS(10,L,KCAT).LT.IMISS)  THEN
            RCAT(10) = MAX(NINT(QQM(N)),NINT(RCATS(10,L,KCAT)))
         ELSE
            RCAT(10) = NINT(QQM(N))
         END IF
         IF(RCATS(11,L,KCAT).LT.IMISS)  THEN
            RCAT(11) = MAX(NINT(WQM(N)),NINT(RCATS(11,L,KCAT)))
         ELSE
            RCAT(11) = NINT(WQM(N))
         END IF
      ELSEIF(ICAT.EQ.2) THEN
         RCAT(1) = MIN(NINT(POB(N)),IMISS)
         RCAT(2) = MIN(NINT(TOB(N)),IMISS)
         RCAT(3) = MIN(NINT(QOB(N)),IMISS)
         RCAT(4) = NINT(PQM(N))
         RCAT(5) = NINT(TQM(N))
         RCAT(6) = NINT(QQM(N))
         RCAT(7) = NINT(XIND(N))
      ELSEIF(ICAT.EQ.3) THEN
         RCAT(1) = MIN(NINT(POB(N)),IMISS)
         RCAT(2) = MIN(NINT(DOB(N)),IMISS)
         RCAT(3) = MIN(NINT(SOB(N)),IMISS)
         RCAT(4) = NINT(PQM(N))
         RCAT(5) = NINT(WQM(N))
         IF(NINT(VSG(N)).EQ. 8)  THEN

C  MARK THE MAXIMUM WIND LEVEL IN DATA LEVEL CATEGORY 3

            XIND(N) = 2
            IF(NINT(POB(N)).EQ.NINT(PWMIN))  XIND(N) = 3
         END IF
         RCAT(6) = NINT(XIND(N))
      ELSEIF(ICAT.EQ.4) THEN
         RCAT(1) = MIN(NINT(ZOB(N)),IMISS)
         RCAT(2) = MIN(NINT(DOB(N)),IMISS)
         RCAT(3) = MIN(NINT(SOB(N)),IMISS)
         RCAT(4) = NINT(ZQM(N))
         RCAT(5) = NINT(WQM(N))
      ELSEIF(ICAT.EQ.5) THEN
         RCAT(1) = MIN(NINT(POB(N)),IMISS)
         RCAT(2) = MIN(NINT(TOB(N)),IMISS)
         RCAT(3) = MIN(NINT(QOB(N)),IMISS)
         RCAT(4) = MIN(NINT(DOB(N)),IMISS)
         RCAT(5) = MIN(NINT(SOB(N)),IMISS)
         RCAT(6) = NINT(PQM(N))
         RCAT(7) = NINT(TQM(N))
         RCAT(8) = NINT(QQM(N))
         RCAT(9) = NINT(WQM(N))
      ELSEIF(ICAT.EQ.6) THEN
         RCAT(1)  = MIN(NINT(POB(N)),IMISS)
         RCAT(2)  = MIN(NINT(ZOB(N)),IMISS)
         RCAT(3)  = MIN(NINT(TOB(N)),IMISS)
         RCAT(4)  = MIN(QOB(N),XMISS)
         RCAT(5)  = MIN(NINT(DOB(N)),IMISS)
         RCAT(6)  = MIN(NINT(SOB(N)),IMISS)
         RCAT(7)  = NINT(PQM(N))
         RCAT(8)  = NINT(ZQM(N))
         RCAT(9)  = NINT(TQM(N))
         RCAT(10) = NINT(QQM(N))
         RCAT(11) = NINT(WQM(N))
      ELSEIF(ICAT.EQ.8) THEN
         RCAT(1) = MIN(OB8(N),XMISS)
C  Allow report sequence number (code fig. 21) to be as large as 999990
         IF(NINT(CF8(N)).EQ.21) RCAT(1) = MIN(OB8(N),XMISS*10.)
         RCAT(2) = MIN(NINT(CF8(N)),IMISS)
         RCAT(3) = MIN(Q81(N),XMISS)
         RCAT(4) = NINT(Q82(N))
      ELSEIF(ICAT.EQ.51) THEN
         RCAT( 1) = MIN(NINT(PSL),IMISS)
         RCAT( 2) = MIN(NINT(STP),IMISS)
         RCAT( 3) = MIN(NINT(SDR),IMISS)
         RCAT( 4) = MIN(NINT(SSP),IMISS)
         RCAT( 5) = MIN(NINT(STM),IMISS)
         RCAT( 6) = MIN(NINT(DPD),IMISS)
         RCAT( 7) = IMISS ! Reserved
         RCAT( 8) = IMISS ! Reserved
         RCAT( 9) = NINT(PSQ)
         RCAT(10) = NINT(SPQ)
         RCAT(11) = NINT(SWQ)
         RCAT(12) = NINT(STQ)
         RCAT(13) = NINT(DDQ)
      ELSE

C  UNSUPPORTED DATA LEVEL CATEGORY RETURNS A 999
C  ---------------------------------------------

         PRINT'(" ##IW3UNPBF/S02UBF - CATEGORY ",I0," NOT SUPPORTED ",
     $    "-- IER = 999")', ICAT
         RETURN 1
      END IF
 
C  TRANSFER THE LEVEL DATA INTO THE HOLDING ARRAY AND EXIT
C  -------------------------------------------------------
 
      RCATS(1:MCAT(KCAT),L,KCAT) = RCAT(1:MCAT(KCAT))
 
      RETURN
      END
C***********************************************************************
C***********************************************************************
C***********************************************************************
      SUBROUTINE S03UBF(UNP,SUBSET,*,*,*)
C     ---> PACKS DATA INTO UNP ARRAY
 
      PARAMETER (NUMCAT=8, LEVLIM=300, MAXOBS=3500)

      COMMON/IUBFDD/HDR(12),RCATS(50,LEVLIM,NUMCAT),IKAT(NUMCAT),
     $ MCAT(NUMCAT),NCAT(NUMCAT),LVDX(NUMCAT)
      COMMON/IUBFNN/STNIDX,CRES1X,CRES2X
 
      CHARACTER*8 STNIDX,CRES1X,CRES2X,SUBSET
      DIMENSION   RCAT(60),JCAT(60),UNP(*)
      EQUIVALENCE (RCAT(1),JCAT(1))

      SAVE

C  CALL TO SORT DATA LEVEL CATEGORIES 02, 03, 04, AND 08 LEVELS
C  ------------------------------------------------------------
 
      CALL S04UBF
 
C  TRANSFER DATA FROM ALL DATA LEVEL CATEGORIES INTO UNP ARRAY
C   AND SET POINTERS
C  -----------------------------------------------------------
 
      INDX = 53
      JCAT = 0
      NLEVTO = 0
      NLEVC8 = 0
 
      DO K = 1,NUMCAT
         JCAT(LVDX(K)) = NCAT(K)
         IF(IKAT(K).NE.8)  THEN
            NLEVTO = NLEVTO + NCAT(K)
         ELSE
            NLEVC8 = NLEVC8 + NCAT(K)
         END IF
         IF(NCAT(K).GT.0) THEN
            JCAT(LVDX(K)+1) = INDX
         ELSE
            JCAT(LVDX(K)+1) = 0
         END IF
         DO J = 1,NCAT(K)
            DO I = 1,MCAT(K)

C  UNPACKED REPORT CONTAINS MORE THAN MAXOBS WORDS - RETURNS A 999
C  -------------------------------------------------------------

               IF(INDX.GT.MAXOBS)  THEN
                  PRINT'(" ~~IW3UNPBF/S03UBF: RPT with ID= ",A,
     $             " TOSSED - CONTAINS ",I0," WORDS, > LIMIT OF ",I0)',
     $             STNIDX,INDX,MAXOBS
                  RETURN 3
               END IF
               UNP(INDX) = RCATS(I,J,K)
               INDX = INDX+1
            ENDDO
         ENDDO
      ENDDO

C  RETURN WITHOUT PROCESSING THIS REPORT IF NO DATA IN CAT. 1-6, 51
C   (UNLESS SSM/I REPORT, THEN DO NOT RETURN UNLESS ALSO NO CAT. 8 DATA)
C  ---------------------------------------------------------------------

      IF(NLEVTO.EQ.0)  THEN
         IF(SUBSET(1:5).NE.'NC012')  THEN
            RETURN 2
         ELSE
            IF(NLEVC8.EQ.0)  RETURN 2
         END IF
      END IF

C  TRANSFER THE HEADER AND POINTER ARRAYS INTO UNP
C  -----------------------------------------------
 
      UNP(1:12)  = HDR
      UNP(13:52) = RCAT(13:52)
 
      RETURN
      END
C***********************************************************************
C***********************************************************************
C***********************************************************************
      SUBROUTINE S04UBF
C     ---> SORTS DATA LEVEL CATEGORIES
 
      PARAMETER (NUMCAT=8, LEVLIM=300)

      COMMON/IUBFAA/BMISS
      COMMON/IUBFDD/HDR(12),RCATS(50,LEVLIM,NUMCAT),IKAT(NUMCAT),
     $ MCAT(NUMCAT),NCAT(NUMCAT),LVDX(NUMCAT)
      COMMON/IUBFNN/STNIDX,CRES1X,CRES2X
      COMMON/IUBFPP/LWI,LWR

      CHARACTER*8 STNIDX,CRES1X,CRES2X
 
      REAL(8)     BMISS

      DIMENSION RCAT(50,LEVLIM),SCAT(50,LEVLIM),IORD(LEVLIM),
     $ IWORK(65536),RCTL(3)
      DIMENSION PMAND(21)

      SAVE

      DATA XMISS/99999./,PMAND/10000.,9250.,8500.,7000.,5000.,4000.,
     $ 3000.,2500.,2000.,1500.,1000.,700.,500.,300.,200.,100.,70.,50.,
     $ 30.,20.,10./
 
C  INSERT DATA LEVEL CATEGORY 1 PRESSURE & DEF. Q.M.'S INTO THOSE LEVELS
C   WHERE MSSING
C  ---------------------------------------------------------------------

      DO I=1,NCAT(1)
         IF(RCATS(1,I,1).GE.XMISS)  THEN
            RCATS(1,I,1) = PMAND(I)
            RCATS(7:11,I,1) = 2.0
         END IF
      ENDDO

C  SORT DATA LEVEL CATEGORIES 2, 3, AND 4 - LEAVE THE FIRST LEVEL IN
C   EACH INTACT
C  ------------------------------------------------------------------
 
      DO K=2,4
         IF(NCAT(K).GT.1) THEN
            DO J=1,NCAT(K)-1
               DO I=1,MCAT(K)
                  SCAT(I,J) = RCATS(I,J+1,K)
               ENDDO
            ENDDO
            CALL ORDERS(2,IWORK,SCAT(1,1),IORD,NCAT(K)-1,50,LWR,2)
            RCTL = BMISS
            DO J=1,NCAT(K)-1
               IF(K.LT.4) JJ = IORD((NCAT(K)-1)-J+1)
               IF(K.EQ.4) JJ = IORD(J)
               DO I=1,MCAT(K)
                  RCAT(I,J) = SCAT(I,JJ)
               ENDDO
               IDUP = 0
               IFLAG = 0
               IF(NINT(RCAT(1,J)).EQ.NINT(RCTL(1)))  THEN
                  IF(NINT(RCAT(2,J)).EQ.NINT(RCTL(2)).AND.
     $               NINT(RCAT(3,J)).EQ.NINT(RCTL(3)))  THEN
                     if(k.ne.4)  then
                        print'(" ~~@@IW3UNPBF/S04UBF: ID ",A," has a ",
     $                   "dupl. cat. ",I0," lvl (all data) at ",G0," ",
     $                   "mb -- lvl will be excluded from processing")',
     $                   stnidx,k,rcat(1,j)*.1
                     else
                        print'(" ~~@@IW3UNPBF/S04UBF: ID ",A," has a ",
     $                   "dupl. cat. ",I0," lvl (all data) at ",G0," m",
     $                   " -- lvl will be excluded from processing")',
     $                   stnidx,k,rcat(1,j)
                     end if
                     IDUP = 1
                  ELSE
                     if(k.ne.4)  then
                        print'(" ~~@@#IW3UNPBF/S04UBF: ID ",A," has a ",
     $                   "dupl. cat. ",I0," press. lvl (data differ) ",
     $                   "at ",G0," mb -- all q.m. will be FLAGGED")',
     $                   stnidx,k,rcat(1,j)*.1
                     else
                        print'(" ~~@@#IW3UNPBF/S04UBF: ID ",A," has a ",
     $                   "dupl. cat. ",I0," height lvl (data differ) ",
     $                   "at ",G0," m -- all q.m. will be FLAGGED")',
     $                   stnidx,k,rcat(1,j)
                     end if
                     IFLAG = 1
                  END IF
               END IF
               RCTL = RCAT(1:3,J)
               IF(IDUP.EQ.1)  THEN
                  RCAT(1,J) = BMISS
               ELSE IF(IFLAG.EQ.1)  THEN
                  RCAT(4,J) = 14
                  RCAT(5,J) = 14
                  RCAT(4,J-1) = 14
                  RCAT(5,J-1) = 14
               END IF
            ENDDO
            JJJ = 1
            LOOP1: DO J=2,NCAT(K)
               IF(RCAT(1,J-1).GE.BMISS)  CYCLE LOOP1
               JJJ = JJJ + 1
               LOOP1n1: DO I=1,MCAT(K)
                  RCATS(I,JJJ,K) = RCAT(I,J-1)
               ENDDO LOOP1n1
            ENDDO LOOP1
            if(jjj.ne.NCAT(K))
     $       print'(" ~~@@IW3UNPBF/S04UBF: ID ",A," has had ",I0,
     $        " lvls removed due to their being duplicates")',
     $        stnidx,NCAT(K)-jjj
            ncat(k) = jjj
         end if
         IF(NCAT(K).EQ.1)  THEN
            IF(MIN(RCATS(1,1,K),RCATS(2,1,K),RCATS(3,1,K)).GT.99998.8)
     $       NCAT(K) = 0
         END IF
      ENDDO
 
C  SORT DATA LEVEL CATEGORY 08 BY CODE FIGURE
C  ------------------------------------------
 
      DO K=8,8
         IF(NCAT(K).GT.1) THEN
            CALL ORDERS(2,IWORK,RCATS(2,1,K),IORD,NCAT(K),50,LWR,2)
            DO J=1,NCAT(K)
               DO I=1,MCAT(K)
                  RCAT(I,J) = RCATS(I,IORD(J),K)
               ENDDO
            ENDDO
            DO J=1,NCAT(K)
               DO I=1,MCAT(K)
                  RCATS(I,J,K) = RCAT(I,J)
               ENDDO
            ENDDO
         END IF
      ENDDO
 
C  NORMAL EXIT
C  -----------
 
      RETURN
      END
C***********************************************************************
C***********************************************************************
C***********************************************************************
      SUBROUTINE S05UBF
C     ---> INITIALIZES INPUT ARRAYS
 
      CHARACTER*8  STNIDX,CRES1X,CRES2X
      CHARACTER*11 CBULLX
      REAL(8)      BMISS

      COMMON/IUBFAA/BMISS
      COMMON/IUBFEE/OBS(255,9)
      COMMON/IUBFFF/QMS(255,5)
      COMMON/IUBFGG/SFO(6)
      COMMON/IUBFHH/SFQ(5)
      COMMON/IUBFLL/Q8(255,2)
      COMMON/IUBFMM/XIND(255)
      COMMON/IUBFNN/STNIDX,CRES1X,CRES2X
      COMMON/IUBFSS/CBULLX
 
      SAVE
 
      DATA IMISS/99999/
 
C  SET THE INPUT OBS DATA ARRAYS TO MISSING, INPUT Q.M. DATA ARRAYS
C  TO 2, INPUT CAT. 8 INDICATORS TO IMISS AND INPUT SPECIAL LEVEL
C  INDICATORS TO 0
C  ----------------------------------------------------------------
 
      OBS  = BMISS
      QMS  = 2
      SFO  = BMISS
      SFQ  = 2
      XIND = 0
      Q8   = IMISS
      STNIDX = '        '
      CRES1X = '        '
      CRES2X = '        '
      CBULLX = '           '
 
      RETURN
      END
C***********************************************************************
C***********************************************************************
C***********************************************************************
      FUNCTION I04UBF(P)
C     ---> ASSIGNS NUMBER TO MANDATORY PRESSURE LEVEL
 
      COMMON/IUBFJJ/ISET,MANLIN(1001)

      SAVE
 
      IF(ISET.EQ.0) THEN
         MANLIN = 0

         MANLIN(1000) =  1
         MANLIN(925)  =  2
         MANLIN(850)  =  3
         MANLIN(700)  =  4
         MANLIN(500)  =  5
         MANLIN(400)  =  6
         MANLIN(300)  =  7
         MANLIN(250)  =  8
         MANLIN(200)  =  9
         MANLIN(150)  = 10
         MANLIN(100)  = 11
         MANLIN(70)   = 12
         MANLIN(50)   = 13
         MANLIN(30)   = 14
         MANLIN(20)   = 15
         MANLIN(10)   = 16
         MANLIN(7)    = 17
         MANLIN(5)    = 18
         MANLIN(3)    = 19
         MANLIN(2)    = 20
         MANLIN(1)    = 21

         ISET = 1
      END IF
 
      IP = NINT(P*10.)
 
      IF(IP.GT.10000 .OR. IP.LT.10 .OR. MOD(IP,10).NE.0) THEN
         I04UBF = 0
      ELSE
         I04UBF = MANLIN(IP/10)
      END IF
 
      RETURN

      END
C***********************************************************************
C***********************************************************************
C***********************************************************************
      FUNCTION R02UBF()
 
      CHARACTER*8 QMARK,SUBSET,RPID
      LOGICAL     L02UBF,L03UBF
      REAL(8)     BMISS

      COMMON/IUBFAA/BMISS

      SAVE
 
      R02UBF = 0
 
      RETURN

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

      ENTRY ERTUBF(SUBSET,RPID)
         ERTUBF = BMISS
         IF(SUBSET(1:5).EQ.'NC000')  THEN
            IF(SUBSET(6:8).EQ.'002')  THEN

C  LAND SYNOPTIC SURFACE - MOBILE
C  ------------------------------

               ERTUBF = 514
            ELSE

C  LAND SYNOPTIC SURFACE - FIXED (RESTRICTED WMO RES. 40 & UNRESTRICTED)
C  ---------------------------------------------------------------------

               IF(L02UBF(RPID))  ERTUBF = 511

C  METAR SURFACE - FIXED
C  ---------------------

               IF(L03UBF(RPID))  ERTUBF = 512
            END IF
         ELSE  IF(SUBSET(1:5).EQ.'NC255')  THEN

C  MESONET SURFACE
C  ---------------

            ERTUBF = 540
         ELSE  IF(SUBSET(1:5).EQ.'NC001')  THEN

!_ships     nem 001001  #> Ship - manual and automatic, restricted |
!_shipsu    nem 001013  #> Ship - manual and automatic, unrestricted |
!_shipsb    nem 001101  #> Ship - manual and automatic, restricted (BUFR) |
!_shipub    nem 001113  #> Ship - manual and automatic, unrestricted (BUFR) |
            IF(SUBSET(7:8).EQ.'01'.OR.SUBSET(7:8).EQ.'13')  THEN
               IF(RPID.NE.'SHIP')  THEN

C  SHIP WITH NAME
C  --------------

                  if(subset(6:8).eq.'001'.or.subset(6:8).eq.'013')then
                    ERTUBF = 522   ! TAC-feed  -- ID not 'SHIP'
                  else
                    ERTUBF = 524   ! FM94/BUFR-feed -- ID not 'SHIP'
                  endif
               ELSE

C  SHIP WITHOUT NAME
C  -----------------

                  if(subset(6:8).eq.'101'.or.subset(6:8).eq.'113')then
                    ERTUBF = 523   ! TAC-feed -- ID = 'SHIP'
                  else
                    ERTUBF = 525   ! FM94/BUFR-feed --  ID = 'SHIP'
                  endif
               END IF

            ELSE  IF(SUBSET(6:8).EQ.'002') THEN

C  BUOYS ARRIVING IN WMO FM18 FORMAT (FIXED OR DRIFTING)
C  -----------------------------------------------------

               ERTUBF = 562
            ELSE  IF(SUBSET(6:8).EQ.'003') THEN

C  BUOYS ARRIVING IN WMO FM13 FORMAT (FIXED)
C  -----------------------------------------

               ERTUBF = 561
            ELSE  IF(SUBSET(6:8).EQ.'102') THEN
    
C  BUOYS ARRIVING IN WMO FM94/BUFR FORMAT (FIXED OR DRIFTING)
C  ----------------------------------------------------------
               ERTUBF = 564
            ELSE  IF(SUBSET(6:8).EQ.'103') THEN
    
C  BUOYS ARRIVING IN WMO FM94/BUFR FORMAT (FIXED)
C  ----------------------------------------------
    
               ERTUBF = 563
            ELSE  IF(SUBSET(6:8).EQ.'004' ) THEN

C  C-MAN PLATFORM (TAC-feed)
C  -------------------------

               ERTUBF = 531
            ELSE  IF(SUBSET(6:8).EQ.'104' ) THEN

C  C-MAN PLATFORM (BUFR-feed)
C  -------------------------

               ERTUBF = 530
            ELSE  IF(SUBSET(6:8).EQ.'005') THEN

C  TIDE GAUGE
C  ----------

               ERTUBF = 532
            ELSE  IF(SUBSET(6:8).EQ.'006') THEN

C  SEA-LEVEL PRESSURE BOGUS
C  ------------------------

               ERTUBF = 551
            ELSE  IF(SUBSET(6:8).EQ.'007') THEN

C  COAST GUARD TIDE GAUGE
C  ----------------------

               ERTUBF = 534
            END IF
         ELSE  IF(SUBSET(1:5).EQ.'NC002')  THEN
            IF(SUBSET(6:8).EQ.'001')  THEN

C  LAND RADIOSONDE - FIXED
C  -----------------------

               ERTUBF = 011
               IF(L03UBF(RPID)) ERTUBF = 012
               IF(RPID(1:4).EQ.'CLAS') ERTUBF = 013
            ELSE  IF(SUBSET(6:8).EQ.'002') THEN

C  LAND RADIOSONDE - MOBILE
C  ------------------------

               ERTUBF = 013
            ELSE  IF(SUBSET(6:8).EQ.'003') THEN

C  SHIP RADIOSONDE
C  ---------------

               ERTUBF = 022
               IF(RPID(1:4).EQ.'SHIP') ERTUBF = 023
            ELSE  IF(SUBSET(6:8).EQ.'004') THEN

C  DROPWINSONDE
C  -------------

               ERTUBF = 031
            ELSE  IF(SUBSET(6:8).EQ.'005') THEN

C  PIBAL
C  -----

               ERTUBF = 011
               IF(L03UBF(RPID)) ERTUBF = 012
            ELSE  IF(SUBSET(6:8).EQ.'009') THEN

C  WIND PROFILERS ORIGINATING FROM PILOT (PIBAL) FORMAT BULLETINS
C  --------------------------------------------------------------

               ERTUBF = 073
            END IF

         ELSE  IF(SUBSET.EQ.'NC004005')  THEN

C  RECCOS/DROPS
C  ------------

            ERTUBF = 031
         END IF
         RETURN

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

      ENTRY MQMUBF(QMARK)
         IF(QMARK(1:1).EQ.'S'.OR.QMARK(1:1).EQ.'V')  THEN
CCCCCCCCCCC MQMUBF =  1   ! good
            MQMUBF =  2   ! good
         ELSE  IF(QMARK(1:1).EQ.'Q')  THEN
            MQMUBF =  3   ! suspect
         ELSE  IF(QMARK(1:1).EQ.'X')  THEN
            MQMUBF = 13   ! failed
         ELSE  IF(QMARK(1:1).EQ.'Z'.OR.QMARK(1:1).EQ.'C')  THEN
            MQMUBF =  2   ! neutral
         ELSE
            MQMUBF = 15   ! missing or unknown (make 15 for now
                          !  for diag. checks, later change to 13)
                          ! DAK: 7/2017: believe this ends up as a 2 (?)
         END IF
         RETURN

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

      ENTRY EQMUBF(QMK)
         IF((NINT(QMK).GE.0 .AND. NINT(QMK).LT.4) .OR.
     $      (NINT(QMK).GT.9 .AND. NINT(QMK).LT.15))  THEN
            EQMUBF = NINT(QMK)
         ELSE  IF(NINT(QMK).EQ.6)  THEN
C  To get around the 3-bit limit to SDMEDIT/QUIPS pressure q.m. mnemonic
C   "QMPR", purge or reject flag on pressure is changed from 12 or 14 to
C   6 to fit in 3-bits)
            EQMUBF = 14
         ELSE
            EQMUBF = 2
         END IF
         RETURN

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

      ENTRY EQSUBF(QMK)
         IF(NINT(QMK).GE.0 .AND. NINT(QMK).LT.15)  THEN
            EQSUBF = NINT(QMK)
         ELSE
            EQSUBF = 2
         END IF

         IF(NINT(QMK).EQ.6)  THEN
C  (NOTE: Prior to mid-March 1999, a purge or reject flag on pressure
C         was set to 6 (instead of 14 or 12, resp.) to get around the
C         3-bit limit to SDMEDIT/QUIPS pressure q.m. mnemonic "QMPR".
C         The 3-bit limit on "QMPR" was changed to 4-bits with a decoder
C         change in February 1999.  However, the codes that write the
C         q.m.'s out (EDTBUFR and QUIPC) weren't changed to write out 14
C         or 12 for purge or reject until mid-March 1999.  In order to
C         allow old runs to work properly, a q.m. of 6 will be reset to
C         14.  This would have to change if q.m.=6 ever has a defined
C         meaning.)
            EQSUBF = 14
         END IF
         RETURN
      END
C***********************************************************************
C***********************************************************************
C***********************************************************************
      FUNCTION L01UBF()
      CHARACTER*8 RPID
      LOGICAL L01UBF,L02UBF,L03UBF

      SAVE

      L01UBF = .TRUE.

      RETURN

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

      ENTRY L02UBF(RPID)
         L02UBF = .FALSE.
         READ(RPID,'(I5)',ERR=1) IBKS
         L02UBF = .TRUE.
1        RETURN

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

      ENTRY L03UBF(RPID)
         L03UBF = .TRUE.
         READ(RPID,'(I5)',ERR=2) IBKS
         L03UBF = .FALSE.
2        RETURN
      END
C***********************************************************************
C***********************************************************************
C***********************************************************************
      FUNCTION R03UBF(LUNIT,OBS,OBS2,OBS3,NOBS3,obs8_8)
C     ---> PROCESSES ADPUPA DATA (002/*, 004/005)
 
      PARAMETER (NUMCAT=8, LEVLIM=300)

      COMMON/IUBFAA/BMISS
      COMMON/IUBFBB/KNDX,KSKACF(8),KSKUPA,KSKSFC,KSKSAT,KFLSAT(12),
     $ KSKSMI
      COMMON/IUBFCC/SUBSET
      COMMON/IUBFDD/HDR(12),RCATS(50,LEVLIM,NUMCAT),IKAT(NUMCAT),
     $ MCAT(NUMCAT),NCAT(NUMCAT),LVDX(NUMCAT)
      COMMON/IUBFEE/POB(255),QOB(255),TOB(255),ZOB(255),DOB(255),
     $              SOB(255),VSG(255),OB8(255),CF8(255)
      COMMON/IUBFFF/PQM(255),QQM(255),TQM(255),ZQM(255),WQM(255)
      COMMON/IUBFII/PWMIN
      COMMON/IUBFLL/Q81(255),Q82(255)
      COMMON/IUBFMM/XIND(255)
 
      CHARACTER*80 HDSTR,LVSTR,QMSTR,RCSTR
      CHARACTER*8  SUBSET,SID,RSV1,RSV2
      REAL(8)  RID_8,HDR_8(12),VSG_8(255),OBS2_8(43),OBS3_8(5,255,7),
     $ RCT_8(5,255),ARR_8(10,255),RAT_8(255),RMORE_8(4),RGP10_8(255),
     $ PRGP10_8(255),RPMSL_8,RPSAL_8,BMISS,AMINIMUM_8,obs8_8(2)
      DIMENSION  OBS(*),OBS2(43),OBS3(5,255,7),NOBS3(7),RCT(5,255),
     $ ARR(10,255), RAT(255),RMORE(4),RGP10(255),PRGP10(255),P2(255),
     $ P8(255),P16(255)

      EQUIVALENCE  (RID_8,SID)
      LOGICAL      L02UBF

      SAVE
 
      DATA HDSTR/'NUL  CLON CLAT HOUR MINU SELV               '/
      DATA LVSTR/'PRLC TMDP TMDB GP07 GP10 WDIR WSPD          '/
      DATA QMSTR/'QMPR QMAT QMDD QMGP QMWN                    '/
      DATA RCSTR/'RCHR RCMI RCTS                              '/
 
      DATA XMISS/99999./, IMISS/99999/, GRAV/9.8/
 
      PRS1(Z) = 1013.25 * (((288.15 - (.0065 * Z))/288.15)**5.256)
      PRS2(Z) = 226.3 * EXP(1.576106E-4 * (11000. - Z))

C  FCNS BELOW CONVERT TEMP/TD(K) & PRESS(MB) INTO SAT./SPEC. HUM.(KG/KG)
C  ---------------------------------------------------------------------

      ES(T) = 6.1078 * EXP((17.269 * (T - 273.16))/((T - 273.16)+237.3))
      QFRMTP(T,P) = (0.622 * ES(T))/(P - (0.378 * ES(T)))

      R03UBF = 0
 
C  STORE SINGLE LEVEL REPORT DATA DIRECTLY INTO OBS2 ARRAY AND
C   MULTIPLE LEVEL REPORT DATA DIRECTLY INTO OBS3,
C   DOUBLE-PRECISION SINGLE LEVEL REPORT DATA DIRECTLY INTO OBS8_8 ARRAY
C  ---------------------------------------------------------------------

      OBS2_8 = BMISS
      OBS3_8 = BMISS
      NOBS3  = 0
      obs8_8 = bmiss
      CALL UFBINT(LUNIT,OBS2_8( 1),2,1,IRET,'RSRD EXPRSRD')
      CALL UFBINT(LUNIT,OBS2_8( 4),1,1,IRET,'SST1')
      IF(IBFMS(OBS2_8(4)).EQ.0)  OBS2_8(41) = 2.0
      CALL UFBINT(LUNIT,OBS3_8(1,1,3),5,255,IRET,
     $                                        'NUL CLAM CLTP HOCB HOCT')
      IF(IRET.EQ.1) THEN ! reset iret from 1 to 0 if all obs missing
                         !  (iret can be 1 even if all obs missing)
         AMINIMUM_8 = MIN(OBS3_8(2,1,3),OBS3_8(3,1,3),OBS3_8(4,1,3),
     $    OBS3_8(5,1,3))
         IF(IBFMS(AMINIMUM_8).NE.0)  IRET = 0
      END IF
      NOBS3(3) = IRET

      IF(SUBSET.EQ.'NC004005') THEN                            ! RECCOs
         CALL UFBINT(LUNIT,OBS3_8(1,1,2),5,255,IRET,'PRWE')
         IF(IRET.EQ.1) THEN ! reset iret from 1 to 0 if all obs missing
                            !  (iret can be 1 even if all obs missing)
            IF(IBFMS(OBS3_8(1,1,2)).NE.0)  IRET = 0
         END IF
         NOBS3(2) = IRET
         CALL UFBINT(LUNIT,OBS3_8(1,1,6),5,255,IRET,'AFIC HBOI HTOI')
         IF(IRET.EQ.1) THEN ! reset iret from 1 to 0 if all obs missing
                            !  (iret can be 1 even if all obs missing)
            AMINIMUM_8 = MIN(OBS3_8(1,1,6),OBS3_8(2,1,6),OBS3_8(3,1,6))
            IF(IBFMS(AMINIMUM_8).NE.0)  IRET = 0
         END IF
         NOBS3(6) = IRET
         CALL UFBINT(LUNIT,OBS3_8(1,1,7),5,255,IRET,'DGOT HBOT HTOT')
         IF(IRET.EQ.1) THEN ! reset iret from 1 to 0 if all obs missing
                            !  (iret can be 1 even if all obs missing)
            AMINIMUM_8 = MIN(OBS3_8(1,1,7),OBS3_8(2,1,7),OBS3_8(3,1,7))
            IF(IBFMS(AMINIMUM_8).NE.0)  IRET = 0
         END IF
         NOBS3(7) = IRET
         CALL UFBINT(LUNIT,OBS2_8(27),2,1,IRET,'WDIR1 WSPD1')
      ELSE                                              ! RAOBs, PIBALs
c HBLCS is replicated for NC002* but is always missng on all but 1st lvl
         CALL UFBINT(LUNIT,OBS2_8(24),1,1,IRET,'HBLCS')
      END IF
      OBS2 = OBS2_8
      OBS3 = OBS3_8

      CALL S05UBF
 
C  VERTICAL SIGNIFICANCE DESCRIPTOR TO ASSIGN UNPACKED DATA LEVEL
C   CATEGORY
C  --------------------------------------------------------------

C NOTE: MNEMONIC "VSIG" 008001 IS DEFINED AS VERTICAL SOUNDING
C       SIGNIFICANCE -- CODE TABLE FOLLOWS:
C        64   Surface 
C              processed as unpacked category 2 and/or 3 and/or 4
C        32   Standard (mandatory) level
C              processed as unpacked category 1
C        16   Tropopause level
C              processed as unpacked category 5
C         8   Maximum wind level
C              processed as unpacked category 3 or 4
C         4   Significant level, temperature
C              processed as unpacked category 2
C         2   Significant level, wind
C              processed as unpacked category 3 or 4
C
C NOTE: THIS SUBR. ASSIGNS VSIG=1 TO LEVELS THAT SHOULD BE
C       PROCESSED AS UNPACKED CATEGORY 6 (ONLY APPLIES TO
C       RECCOS)
C
C  anything else - the level is not processed
 
      CALL UFBINT(LUNIT,VSG_8,1,255,NLEV,'VSIG');VSG=VSG_8
 
C  PUT THE HEADER INFORMATION INTO UNPACKED FORMAT
C  -----------------------------------------------
 
      CALL UFBINT(LUNIT,HDR_8,12,  1,IRET,HDSTR);HDR=HDR_8
      IF(HDR(5).GE.BMISS) HDR(5) = 0
      CALL UFBINT(LUNIT,RID_8,1,1,IRET,'RPID')
cccc  IF(IRET.NE.1.OR.(RID_8.GT.BMISS-5000..AND.RID_8.LT.BMISS+5000.))
cccc $  SID = 'MISSING '
cxxxx
cpppppppppp
cc    print'(" rid_8,icbfms(sid,8): ",G0,1X,I0)', rid_8,icbfms(sid,8)
cpppppppppp

ccccc IF(ICBFMS(SID,8).NE.0)  SID = 'MISSING '
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.'        ')  sid = 'MISSING '
cxxxx
cppppp-ID
      iprint = 0
cc         iprint = 1
c     if(sid.eq.'89571   ')  iprint = 1
c     if(sid.eq.'68906   ')  iprint = 1
c     if(sid.eq.'68842   ')  iprint = 1
c     if(sid.eq.'59362   ')  iprint = 1
c     if(sid.eq.'57957   ')  iprint = 1
c     if(sid.eq.'74794   ')  iprint = 1
c     if(sid.eq.'74389   ')  iprint = 1
c     if(sid.eq.'96801A  ')  iprint = 1
      if(iprint.eq.1)
     $ print'(" @@@ START DIAGNOSTIC PRINTOUT FOR ID ",A)', sid
cppppp-ID

      RGP10  = BMISS
      PRGP10 = BMISS
      CALL UFBINT(LUNIT,RPMSL_8,1,  1,IRET,'PMSL');RPMSL=RPMSL_8
      IF(SUBSET.EQ.'NC004005')  THEN
         CALL UFBINT(LUNIT,RGP10_8,1,255,NLEV,'GP10');RGP10=RGP10_8
         CALL UFBINT(LUNIT,RPSAL_8,1,1,IRET,'PSAL');RPSAL=RPSAL_8
         IF(NINT(VSG(1)).EQ.32.AND.RPMSL.GE.BMISS.AND.
     $    MAX(RGP10(1),RPSAL).LT.BMISS)  THEN
cpppppppppp
cc          print'(" ~~IW3UNPBF/R03UBF: ID ",A," is a Cat. 6 type ",
cc   $       "RECCO with a mand-lvl GEOPOT")', sid
cpppppppppp
            VSG(1) = 1
            CALL UFBINT(LUNIT,PRGP10_8,1,255,NLEV,'PRLC')
            PRGP10=PRGP10_8
            HDR(6) = RPSAL + SIGN(0.0000001,RPSAL)
         ELSE  IF(MIN(VSG(1),RPMSL,RGP10(1)).GE.BMISS.AND.RPSAL.LT.
     $    BMISS)  THEN
cpppppppppp
cc          print'(" ~~IW3UNPBF/R03UBF: ID ",A," is a Cat. 6 type ",
cc   $       "RECCO")', sid
cpppppppppp
            VSG(1) = 1
            HDR(6) = RPSAL + SIGN(0.0000001,RPSAL)
         ELSE  IF(MIN(VSG(1),RGP10(1)).GE.BMISS.AND.MAX(RPMSL,RPSAL)
     $    .LT.BMISS)  THEN
cpppppppppp
cc          print'(" ~~IW3UNPBF/R03UBF: ID ",A," is a Cat. 6 type ",
cc   $       "RECCO with a valid PMSL")', sid
cpppppppppp
            VSG(1) = 1
            HDR(6) = RPSAL + SIGN(0.0000001,RPSAL)
         ELSE
            print'(" ~~IW3UNPBF/R03UBF: ID ",A," is currently an ",
     $       "unknown type of RECCO - VSIG =",G0,"; PMSL =",G0,"; GP10",
     $       " =",G0," -- SKIP IT for now")', sid,VSG(1),RPMSL,RGP10(1)
            R03UBF = -9999
            KSKUPA =KSKUPA + 1
            RETURN
         END IF
      END IF

      obs8_8(1) = hdr_8(3)
      obs8_8(2) = hdr_8(2)

      XOB = HDR(2)
      YOB = HDR(3)

      RHR = BMISS
      IF(HDR(4).LT.BMISS)  RHR = NINT(HDR(4))+NINT(HDR(5))/60.

      RCTIM = BMISS
      RSV1 = '        '
      RSV2 = '        '
      ELV = HDR(6)
      QMELV = XMISS
     
      CALL UFBINT(LUNIT,RAT_8, 1,255,NLEV,'RATP');RAT=RAT_8
      ITP = MIN(IMISS,NINT(RAT(1)))
      RTP = ERTUBF(SUBSET,SID)
      IDS = IMISS
      IF(ELV.GE.BMISS)  THEN
         IF((RTP.GT.20.AND.RTP.LT.24).OR.SUBSET.EQ.'NC002004')  THEN
            print'(" IW3UNPBF/R03UBF: ID ",A," has a missing elev, so ",
     $       "elevation set to ZERO")', sid
            ELV = 0
         ELSE
            print'(" ~~IW3UNPBF/R03UBF: ID ",A," has a missing elev")',
     $       sid
         END IF
      END IF
cdak  if(sid(5:5).eq.' ') print, sid
      IF(L02UBF(SID).AND.SID(5:5).EQ.' ') SID = '0'//SID
      RSTP = IMISS
      IF(RTP.EQ.31)  THEN
         IF(SUBSET.EQ.'NC004005')  THEN
            RSTP = 1
         ELSE
            RSTP = 2
         END IF
      END IF
      CALL S01UBF(SID,XOB,YOB,RHR,RCTIM,RSV1,RSV2,ELV,QMELV,ITP,RTP,
     $ RSTP,IDS)
 
C  PUT THE LEVEL DATA INTO SPECIFIED UNPACKED FORMAT
C  -------------------------------------------------
 
      CALL UFBINT(LUNIT,ARR_8,10,255,NLEV,LVSTR);ARR=ARR_8

      PWMIN = 999999.

      DO L=1,NLEV

         POB(L) = BMISS
         IF(ARR(1,L).LT.BMISS)  POB(L) = NINT(ARR(1,L)*.1)
         
         IF(NINT(ARR(1,L)).LE.0) THEN
            POB(L) =  BMISS
            print'(" ~~@@IW3UNPBF/R03UBF: ID ",A," has a ZERO or ",
     $       "negative reported pressure that is reset to missing")',
     $       sid
         END IF

         QOB(L) = BMISS
         IF(ARR(2,L).LT.BMISS .AND. ARR(3,L).LT.BMISS)
     $    QOB(L) = (ARR(3,L)-ARR(2,L))*10.

         TOB(L) = BMISS
         IF(ARR(3,L).LT.BMISS) THEN
            ITMP = NINT(ARR(3,L)*100.)
            TOB(L) = NINT((ITMP-27315)*0.1)
         END IF

         XXX = BMISS
         IF(ARR(4,L).LT.BMISS) XXX = (ARR(4,L)/GRAV)
         YYY = BMISS
         IF(ARR(5,L).LT.BMISS) YYY = (ARR(5,L)/GRAV)
         ZOB(L) = MIN(XXX,YYY)

         DOB(L) = ARR(6,L)
         SOB(L) = MIN(ARR(7,L)*10.,BMISS)
         IF(NINT(DOB(L)).EQ.0.AND.NINT(SOB(L)).GT.0)  THEN
            DOB(L) = 360
         ELSE  IF(NINT(DOB(L)).EQ.360.AND.NINT(SOB(L)).EQ.0)  THEN
            DOB(L) = 0
         END IF
         if(iprint.eq.1)  then
            print'(" At lvl=",I0,"; VSG=",G0,"; POB = ",G0,"; QOB = ",
     $       G0,"; TOB = ",G0,"; ZOB = ",G0,"; DOB = ",G0,"; SOB = ",
     $       G0)', L,vsg(L),pob(L),qob(L),tob(L),zob(L),dob(L),sob(L)
         end if
         IF(MAX(POB(L),DOB(L),SOB(L)).LT.BMISS) PWMIN =MIN(PWMIN,POB(L))
      ENDDO

      CALL UFBINT(LUNIT,ARR_8,10,255,NLEV,QMSTR);ARR=ARR_8

      DO L=1,NLEV
         PQM(L) = EQMUBF(ARR(1,L))
         TQM(L) = EQMUBF(ARR(2,L))
         QQM(L) = EQMUBF(ARR(3,L))
         ZQM(L) = EQMUBF(ARR(4,L))
         WQM(L) = EQMUBF(ARR(5,L))
      ENDDO

C  SURFACE DATA MUST GO FIRST
C  --------------------------
 
      CALL S02UBF(2,0,*9999)
      CALL S02UBF(3,0,*9999)
      CALL S02UBF(4,0,*9999)

      INDX2  = 0
      INDX8  = 0
      INDX16 = 0
      P2  = BMISS
      P8  = BMISS
      P16 = BMISS

      LOOP1: DO L=1,NLEV
         IF(NINT(VSG(L)).EQ.64) THEN
            if(iprint.eq.1)  then
               print'(" Lvl=",I0," is a surface level")', L
            end if
            if(iprint.eq.1.and.POB(L).LT.BMISS.AND.TOB(L).LT.BMISS) then
               print'(" --> valid cat. 2 sfc. lvl ")'
            end if
            IF(POB(L).LT.BMISS.AND.TOB(L).LT.BMISS)  CALL SE01UBF(2,L)
            if(iprint.eq.1.and.POB(L).LT.BMISS.AND.DOB(L).LT.BMISS) then
               print'(" --> valid cat. 3 sfc. lvl ")'
            end if
            IF(POB(L).LT.BMISS.AND.DOB(L).LT.BMISS)  CALL SE01UBF(3,L)
            IF(MAX(ZOB(L),DOB(L)).LT.BMISS) THEN
               if(iprint.eq.1)  print'(" --> valid cat. 4 sfc. lvl ")'

C  DATA LEVEL CATEGORY 4 HEIGHT DOES NOT PASS ON A KEEP, PURGE, OR REJECT
C   LIST Q.M.

               ZQM(L) = 2
               CALL SE01UBF(4,L)
            END IF
            VSG(L) = 0
         ELSE  IF(NINT(VSG(L)).EQ.2)  THEN
            P2(L) = POB(L)
            INDX2 = L
            IF(INDX8.GT.0)  THEN
               LOOP1n1: DO II = 1,INDX8
                  IF(NINT(POB(L)).EQ.NINT(P8(II)).AND.POB(L).LT.BMISS)
     $             THEN
                     if(iprint.eq.1)  then
                        print'(" ## This cat. 3 level, on lvl ",I0,
     $                   " will have already been processed as a cat. ",
     $                   "3 MAX wind lvl (on lvl ",I0,") - skip this ",
     $                   "Cat. 3 lvl")', L,II
                     end if
                     IF(MAX(SOB(II),DOB(II)).GE.BMISS)  THEN
                        SOB(II) = SOB(L)
                        DOB(II) = DOB(L)
                        if(iprint.eq.1)  then
                           print'("  ...... also on lvl ",I0," - ",
     $                      "transfer wind data to dupl. MAX wind lvl ",
     $                      "because its missing there")', L
                        end if
                     END IF
                     VSG(L) = 0
                     CYCLE LOOP1
                  END IF
               ENDDO LOOP1n1
            END IF
         ELSE  IF(NINT(VSG(L)).EQ.8)  THEN
            P8(L) = POB(L)
            INDX8 = L
            IF(INDX2.GT.0)  THEN
               LOOP1n2: DO II = 1,INDX2
                  IF(NINT(POB(L)).EQ.NINT(P2(II)).AND.POB(L).LT.BMISS)
     $             THEN
                     if(iprint.eq.1)  then
                        print'("  ## This MAX wind level, on lvl ",I0,
     $                   " will have already been processed as a cat. ",
     $                   "3 lvl (on lvl ",I0,") - skip this MAX wind ",
     $                   "lvl but set")', L,II
                        print'("     cat. 3 lvl XIND to ""2""")'
                     end if
                     XIND(II) = 2
                     IF(NINT(POB(L)).EQ.NINT(PWMIN))  XIND(II) = 3
                     IF(MAX(SOB(II),DOB(II)).GE.BMISS)  THEN
                        SOB(II) = SOB(L)
                        DOB(II) = DOB(L)
                        if(iprint.eq.1)  then
                           print'(" ...... also on lvl ",I0," - ",
     $                      "transfer wind data to dupl. cat. 3 lvl ",
     $                      "because its missing there")', L
                        end if
                     END IF
                     VSG(L) = 0
                     CYCLE LOOP1
                  END IF
               ENDDO LOOP1n2
            END IF
            IF(INDX8-1.GT.0)  THEN
               LOOP1n3: DO II = 1,INDX8-1
                  IF(NINT(POB(L)).EQ.NINT(P8(II)).AND.POB(L).LT.BMISS)
     $             THEN
                     if(iprint.eq.1)  then
                        print'(" ## This cat. 3 MAX wind lvl, on lvl ",
     $                   I0," will have already been processed as a ",
     $                   "cat. 3 MAX wind lvl (on lvl ",I0,") - skip ",
     $                   "this Cat. 3 MAX wind lvl")', L,II
                     end if
                     IF(MAX(SOB(II),DOB(II)).GE.BMISS)  THEN
                        SOB(II) = SOB(L)
                        DOB(II) = DOB(L)
                        if(iprint.eq.1)  then
                           print'(" ...... also on lvl ",I0," - ",
     $                      "transfer wind data to dupl. MAX wind lvl ",
     $                      "because its missing there")', L
                        end if
                     END IF
                     VSG(L) = 0
                     CYCLE LOOP1
                  END IF
               ENDDO LOOP1n3
            END IF
         ELSE  IF(NINT(VSG(L)).EQ.16)  THEN
            INDX16 = INDX16 + 1
            P16(INDX16) = POB(L)
         END IF
      ENDDO LOOP1
 
 
C  REST OF THE DATA
C  ----------------
 
      DO L=1,NLEV
         IF(NINT(VSG(L)).EQ.32) THEN
            LL = I04UBF(POB(L)*.1)
            IF(LL.LE.0)  THEN
               print'("~~IW3UNPBF/R03UBF: ID ",A," has VSG=32 for lvl ",
     $          I0," but pressure (=",G0,"mb) not mand.!! --> this ",
     $          "level not processed")', sid,L,POB(L)*.1
            ELSE
               IF(MIN(DOB(L),ZOB(L),TOB(L)).GE.BMISS)  THEN
                  if(iprint.eq.1)  then
                     print'(" ==> For lvl ",I0,"; VSG=32 & DOB,ZOB,TOB",
     $                " all missing --> this level not processed")', L
                  end if
                  VSG(L) = 0
               ELSE
                  if(iprint.eq.1)  then
                     print'(" ==> For lvl ",I0,"; VSG=32 & one or more",
     $                " of ZOB,TOB,DOB non-missing --> valid cat. 1 ",
     $                "lvl")', L
                  end if
                  CALL S02UBF(1,L,*9999)
                  VSG(L) = 0
               END IF
            END IF
         ELSE  IF(NINT(VSG(L)).EQ. 4) THEN
            if(iprint.eq.1)  then
               print'(" ==> For lvl ",I0,"; VSG= 4 --> valid cat. 2 ",
     $          "lvl")', L
            end if
            IF(INDX16.GT.0)  THEN
               DO II = 1,INDX16
                  IF(NINT(POB(L)).EQ.NINT(P16(II)).AND.POB(L).LT.BMISS)
     $             THEN
                     if(iprint.eq.1)  then
                        print'(" ## This cat. 2 level, on lvl ",I0,
     $                   " is also the tropopause level, as its ",
     $                   "pressure matches that of trop. lvl no. ",I0,
     $                   " - set this cat. 2")', L,II
                        print'("    lvl XIND to ""1""")'
                     end if
                     XIND(L) = 1
                     EXIT
                  END IF
               ENDDO
            END IF
            CALL S02UBF(2,L,*9999)
            VSG(L) = 0
         ELSEIF(NINT(VSG(L)).EQ.16) THEN
            if(iprint.eq.1)  then
               print'(" ==> For lvl ",I0,"; VSG=16 --> valid cat. 5 ",
     $          "lvl")', L
            end if
            CALL S02UBF(5,L,*9999)
            VSG(L) = 0
         ELSEIF(NINT(VSG(L)).EQ. 1) THEN
            if(iprint.eq.1)  then
               print'(" ==> For lvl ",I0,"; VSG=1 --> valid cat. 6 lvl",
     $          " - can only be a Recco")', L
            end if
            POB(L) = BMISS
            ZOB(L) = ELV

C  All data level category 6 reports store specific humidity (g/kg)
C   as moisture variable
C  ----------------------------------------------------------------

            TDD    = BMISS
            IF(QOB(L).LT.BMISS)  TDD = QOB(L) * 0.1
            QOB(L) = BMISS
            IF(MAX(TOB(L),TDD).LT.BMISS.AND.TDD.GT.0)  THEN
               IF(ZOB(L).LT.XMISS)  THEN
                  IF(NINT(ZOB(L)).LE.11000)  THEN
                     P = PRS1(ZOB(L))
                  ELSE
                     P = PRS2(ZOB(L))
                  END IF
                  TD = ((TOB(L) * 0.1) + 273.15) - TDD
                  QQ = QFRMTP(TD,P)
                  IF(QQ.GT.0.0)  QOB(L) = QQ * 1000.
               END IF
cpppppppppp
cc    print'("~#~# For sid = ",A,", a valid tdd = ",G0,"C, a valid tob",
cc   $ " = ",G0,"C, and a valid zob = ",G0,"m")', sid,tdd,tob(L)*0.1,
cc   $ zob(L)
cc    print'("  -- calc. quantities: p = ",G0,"mb, td = ",G0,"K, qq = ",
cc   $ G0,"kg/kg, qob = ",G0,"g/kg")', p,td,qq,qob(L)
cpppppppppp
            END IF
cpppppppppp
cc    print'("~#~# GOING INTO S02UFB, QOB(L) = ",G0)', qob(L)
cpppppppppp
            CALL S02UBF(6,L,*9999)
            VSG(L) = 0
         ELSEIF(NINT(VSG(L)).EQ. 2)  THEN
            IF(POB(L).LT.BMISS) THEN
               IF(MAX(SOB(L),DOB(L)).LT.BMISS)  THEN
               if(iprint.eq.1)  then
                  print'(" ==> For lvl ",I0,"; VSG= 2 & POB .ne. ",
     $             "missing --> valid cat. 3 lvl (expect that ZOB is ",
     $             "missing)")', L
               end if
               IF(INDX16.GT.0)  THEN
                  DO II = 1,INDX16
                     IF(NINT(POB(L)).EQ.NINT(P16(II))) THEN
                        if(iprint.eq.1)  then
                           print'(" ## This cat. 3 level, on lvl ",I0,
     $                      " is also the tropopause level, as its ",
     $                      "pressure matches that of trop. lvl no. ",
     $                      I0," - set this cat. 3")', L,II
                           print'("    lvl XIND to ""1""")'
                        end if
                        XIND(L) = 1
                        EXIT
                     END IF
                  ENDDO
               END IF
               CALL S02UBF(3,L,*9999)
            ELSE
               if(iprint.eq.1)  then
                  print'(" ==> For lvl ",I0,"; VSG= 2 & POB .ne. ",
     $             "missing --> Cat. 3 level not processed - wind is ",
     $             "missing")', L
               end if
               END IF
               VSG(L) = 0
            ELSE IF(ZOB(L).LT.BMISS) THEN
               IF(MAX(SOB(L),DOB(L)).LT.BMISS)  THEN
                  if(iprint.eq.1)  then
                     print'(" ==> For lvl ",I0,"; VSG= 2 & ZOB .ne. ",
     $                "missing --> valid cat. 4 lvl (POB must always ",
     $                "be missing)")', L
                  end if

C  DATA LEVEL CATEGORY 4 HEIGHT DOES NOT PASS ON A KEEP, PURGE, OR
C   REJECT LIST Q.M.
C  ---------------------------------------------------------------

                  ZQM(L) = 2

                  CALL S02UBF(4,L,*9999)
               ELSE
                  if(iprint.eq.1)  then
                     print'(" ==> For lvl ",I0,"; VSG= 2 & ZOB .ne. ",
     $                "missing --> Cat. 4 level not processed - wind ",
     $                "is missing")', L
                  end if
               END IF
               VSG(L) = 0
            END IF
         ELSEIF(NINT(VSG(L)).EQ. 8)  THEN
            IF(POB(L).LT.BMISS) THEN
               if(iprint.eq.1)  then
                  print'(" ==> For lvl ",I0,"; VSG= 8 & POB .ne. ",
     $             "missing --> valid cat. 3 lvl (expect that ZOB ",
     $             "is missing)")', L
               end if
               IF(INDX16.GT.0)  THEN
                  DO II = 1,INDX16
                     IF(NINT(POB(L)).EQ.NINT(P16(II))) THEN
                        if(iprint.eq.1)  then
                           print'(" ## This cat. 3 level, on lvl ",I0,
     $                      " is also the tropopause level, as its ",
     $                      "pressure matches that of trop. lvl no. ",
     $                      I0," - set this cat. 3")', L,II
                           print'("    lvl XIND to ""1""")'
                        end if
                        XIND(L) = 1
                        EXIT
                     END IF
                  ENDDO
               END IF
               CALL S02UBF(3,L,*9999)
               VSG(L) = 0
            ELSE  IF(ZOB(L).LT.BMISS) THEN
               IF(MAX(SOB(L),DOB(L)).LT.BMISS)  THEN
                  if(iprint.eq.1)  then
                     print'(" ==> For lvl ",I0,"; VSG= 8 & ZOB .ne. ",
     $                "missing --> valid cat. 4 lvl (POB must always ",
     $                "be missing)")', L
                  end if

C  DATA LEVEL CATEGORY 4 HEIGHT DOES NOT PASS ON A KEEP, PURGE, OR
C   REJECT LIST Q.M.
C  ---------------------------------------------------------------

                  ZQM(L) = 2

                  CALL S02UBF(4,L,*9999)
               ELSE
                  if(iprint.eq.1)  then
                     print'(" ==> For lvl ",I0,"; VSG= 8 & ZOB .ne. ",
     $                "missing --> Cat. 4 level not processed - wind ",
     $                "is missing")', L
                  end if
               END IF
               VSG(L) = 0
            END IF
         END IF
 
C  CHECK FOR LEVELS WHICH GOT LEFT OUT
C  -----------------------------------
 
         IF(NINT(VSG(L)).GT.0)  THEN
            PRINT 887, L,SID,NINT(VSG(L))
  887       FORMAT('##IW3UNPBF/R03UBF - ~~ON LVL',I4,' OF ID ',A8,
     $       ', A VERTICAL SIGNIFICANCE OF',I3,' WAS NOT SUPPORTED - ',
     $       'LEAVE THIS LEVEL OUT OF THE PROCESSING')
            print'(" ..... at lvl=",I0,"; POB = ",G0,"; QOB = ",G0,
     $       "; TOB = ",G0,"; ZOB = ",G0,"; DOB = ",G0,";")',
     $        L,pob(L),qob(L),tob(L),zob(L),dob(L)
            print'("                  SOB = ",G0)', sob(L)
         END IF
      ENDDO
 
C  -----------------------------------------------------
C  MISC DATA GOES INTO DATA LEVEL CATEGORY 08
C  -----------------------------------------------------
C  CODE FIGURE 104 - RELEASE TIME IN .01*HR
C  CODE FIGURE 105 - RECEIPT TIME IN .01*HR
C  CODE FIGURE 351 - GEOPOTENTIAL HEIGHT (METERS)
C                    INDICATOR 1 IS PRESSURE LEVEL (MB)
C                    INDICATOR 2 CONTAINS GEOPOTENTIAL QUALITY MARKER
C  CODE FIGURE 352 - MEAN-SEA LEVEL PRESSURE IN .1*MB
C  CODE FIGURE 353 - SOLAR AND INFRARED RADIATION CORRECTION
C                    INDICATOR
C  CODE FIGURE 354 - TRACKING TECHNIQUE/STATUS OF SYSTEM USED
C                    INDICATOR
C  -----------------------------------------------------------
 
      CALL UFBINT(LUNIT,RCT_8, 5,255,NRCT,RCSTR);RCT=RCT_8

C NOTE: MNEMONIC "RCTS" 008202 IS A LOCAL DESCRIPTOR DEFINED AS
C       RECEIPT TIME SIGNIFICANCE - THIS IS STORED IN INDICATOR 1
C       FOR CATEGORY 8 CODE FIGURE 105 -- CODE TABLE FOLLOWS:
C         0   General decoder receipt time
C         1   NCEP receipt time
C         2   OSO  receipt time
C         3   ARINC ground station receipt time
C         4   Radiosonde TEMP AA part receipt time
C         5   Radiosonde TEMP BB part receipt time
C         6   Radiosonde TEMP CC part receipt time
C         7   Radiosonde TEMP DD part receipt time
C         8   Radiosonde PILOT AA part receipt time
C         9   Radiosonde PILOT BB part receipt time
C        10   Radiosonde PILOT CC part receipt time
C        11   Radiosonde PILOT DD part receipt time
C      12-62  Reserved for future use
C        63   Missing

      DO L=1,NRCT
         CF8(L) = 105
         OB8(L) = NINT((NINT(RCT(1,L))+NINT(RCT(2,L))/60.) * 100.)
         Q81(L) = IMISS
         IF(RCT(3,L).LT.BMISS)  Q81(L) = NINT(RCT(3,L))
         Q82(L) = IMISS
         CALL S02UBF(8,L,*9999)
      ENDDO

      CALL UFBINT(LUNIT,RMORE_8,4,1,NRMORE,'SIRC TTSS UALNHR UALNMN')
      RMORE=RMORE_8
      IF(MAX(RMORE(3),RMORE(4)).LT.BMISS)  THEN
         CF8(1) = 104
         OB8(1) = NINT((RMORE(3)+RMORE(4)/60.) * 100.)
         Q81(1) = IMISS
         Q82(1) = IMISS
         CALL S02UBF(8,1,*9999)
      END IF
      IF(SUBSET.EQ.'NC004005')  THEN
         IF(MAX(PRGP10(1),RGP10(1)).LT.BMISS)  THEN
            RGP10(1) = (NINT(RGP10(1))/GRAV)
            if(iprint.eq.1)  print'(" orig. RGP10 = ",G0)', rgp10(1)
            IF(MOD(NINT(RGP10(1)),10).NE.0)  RGP10(1) =
     $       INT(RGP10(1)/10.) * 10
            CF8(1) = 351
            OB8(1) = NINT(RGP10(1))
            Q81(1) = NINT(PRGP10(1)/100.)
            Q82(1) = 3
            CALL S02UBF(8,1,*9999)
         END IF
         IF(RPMSL.LT.BMISS)  THEN
            CF8(1) = 352
            OB8(1) = NINT(RPMSL*.1)
            Q81(1) = IMISS
            Q82(1) = IMISS
            CALL S02UBF(8,1,*9999)
         END IF
      END IF
      IF(RMORE(1).LT.BMISS)  THEN
         CF8(1) = 353
         OB8(1) = NINT(RMORE(1))
         Q81(1) = IMISS
         Q82(1) = IMISS
         CALL S02UBF(8,1,*9999)
      END IF
      IF(RMORE(2).LT.BMISS)  THEN
         CF8(1) = 354
         OB8(1) = NINT(RMORE(2))
         Q81(1) = IMISS
         Q82(1) = IMISS
         CALL S02UBF(8,1,*9999)
      END IF
 
C  PUT THE UNPACKED REPORT INTO OBS
C  --------------------------------
 
      CALL S03UBF(OBS,SUBSET,*9999,*9998,*9997)
 
      RETURN
 9999 CONTINUE
      R03UBF = 999
      RETURN
 9998 CONTINUE
      print'("IW3UNPBF/R03UBF: RPT with ID= ",A," TOSSED - ZERO ",
     $ "CAT.1-6,51 LVLS")', SID
 9997 CONTINUE
      R03UBF = -9999
      KSKUPA =KSKUPA + 1
      RETURN
      END
C***********************************************************************
C***********************************************************************
C***********************************************************************
      FUNCTION R04UBF(LUNIT,OBS,OBS2,OBS3,NOBS3,obs8_8)
C     ---> PROCESSES SURFACE AND MESONET DATA (000/*, 001/*, 255/*)
 
      COMMON/IUBFAA/BMISS
      COMMON/IUBFBB/KNDX,KSKACF(8),KSKUPA,KSKSFC,KSKSAT,KFLSAT(12),
     $ KSKSMI
      COMMON/IUBFCC/SUBSET
      COMMON/IUBFEE/POB(255),QOB(255),TOB(255),ZOB(255),DOB(255),
     $              SOB(255),VSG(255),OB8(255),CF8(255)
      COMMON/IUBFGG/PSL,STP,SDR,SSP,STM,DPD
      COMMON/IUBFHH/PSQ,SPQ,SWQ,STQ,DDQ
      COMMON/IUBFLL/Q81(255),Q82(255)
 
      CHARACTER*80 HDSTR,RCSTR
      CHARACTER*8  SUBSET,SID,RSV1,RSV2,PRVSTG,SPRVSTG,QCD
      INTEGER ITIWM(0:15)
      REAL(8) RID_8,UFBINT_8,OBS2_8(43),OBS3_8(5,255,7),RRVSTG_8(255),
     $        UFBINT2_8(12,255), RTMP(5,255),RRTMP,
     $ RPRVSTG_8(255),HDR_8(20),RCT_8(5,255),SOLR_8(3,255),
     $ TOPC_8(5,255),RMSO_8(2),RQCD_8,BMISS,AMINIMUM_8,obs8_8(2)
      DIMENSION  OBS(*),OBS2(43),OBS3(5,255,7),NOBS3(7),HDR(20),
     $ RCT(5,255),RRSV(5),SOLR(3,255),TOPC(5,255)
      EQUIVALENCE  (RID_8,SID),(RRVSTG_8,PRVSTG),(RPRVSTG_8,SPRVSTG),
     $ (RQCD_8,QCD)

      SAVE
 
      DATA HDSTR/'RPID CLON CLAT HOUR MINU SELV QCEVR         '/
      DATA RCSTR/'RCHR RCMI RCTS                              '/
 
      DATA IMISS/99999/
      
      DATA ITIWM/0,3*7,3,3*7,1,3*7,4,3*7/

      R04UBF = 0

C  STORE SINGLE LEVEL REPORT DATA DIRECTLY INTO OBS2 ARRAY,
C   MULTIPLE LEVEL REPORT DATA DIRECTLY INTO OBS3 ARRAY AND
C   DOUBLE-PRECISION SINGLE LEVEL REPORT DATA DIRECTLY INTO OBS8_8 ARRAY
C  ---------------------------------------------------------------------

      OBS2_8 = BMISS
      OBS3_8 = BMISS
      NOBS3  = 0
      obs8_8 = bmiss
      RTMP = bmiss
      UFBINT2_8 = bmiss
      CALL UFBINT(LUNIT,OBS2_8(1),2,1,IRET,'RSRD EXPRSRD')
      CALL UFBINT(LUNIT,OBS2_8(4),1,1,IRET,'SST1')
      IF(IBFMS(OBS2_8(4)).EQ.0)  OBS2_8(41) = 2.0
      IF(SUBSET(1:5).EQ.'NC000')  THEN               ! All surface land
         IF(SUBSET(6:7).EQ.'10') THEN
            CALL UFBSEQ(LUNIT,UFBINT2_8(1,1),4,255,IRET, 'VISBSEQN')
            IF(UFBINT2_8(3,1).EQ.0) OBS2_8(7)=2
            IF(UFBINT2_8(3,1).EQ.1) OBS2_8(7)=0
            IF(UFBINT2_8(3,1).EQ.2) OBS2_8(7)=4
            IF(UFBINT2_8(3,1).EQ.3) OBS2_8(7)=7
            OBS2_8(8)=UFBINT2_8(4,1)
         ELSE
            CALL UFBINT(LUNIT,OBS2_8( 8),2,1,IRET,'HOVI VTVI')
         ENDIF
         IF(SUBSET(6:7).EQ.'10') THEN
            CALL UFBSEQ(LUNIT,UFBINT2_8(1,1),3,255,IRET, 'BSYWND2')
            RRTMP = UFBINT2_8(1,1)
            IF(RRTMP.LT.0.0) RRTMP=-RRTMP
            OBS2_8(14) = RRTMP
            OBS2_8(15) = UFBINT2_8(3,1)
         ELSE
            CALL UFBINT(LUNIT,OBS2_8(14),2,1,IRET,'.DTMMXGS MXGS')
         ENDIF
         CALL UFBINT(LUNIT,OBS2_8(17),3,1,IRET,'TP01 TP03 TP06')
         CALL UFBINT(LUNIT,OBS2_8(21),1,1,IRET,'TP24')
         CALL UFBINT(LUNIT,OBS2_8(30),2,1,IRET,'DOFS TOSD')
         CALL UFBINT(LUNIT,OBS3_8(1,1,2),5,255,IRET,'PRWE')
         IF(IRET.EQ.1) THEN ! reset iret from 1 to 0 if all obs missing
                            !  (iret can be 1 even if all obs missing)
            IF(IBFMS(OBS3_8(1,1,2)).NE.0)  IRET = 0
         END IF
         NOBS3(2) = IRET
         IF(SUBSET(6:7).EQ.'10') THEN
            CALL UFBSEQ(LUNIT,OBS3_8(1,1,3),5,255,JRET, 'BSYBCLD')
            DO I=1,JRET
               DO J=1,5
                  RTMP(J,I)=OBS3_8(J,I,3)
               ENDDO
            ENDDO
            CALL UFBSEQ(LUNIT,OBS3_8(1,1,3),5,255,IRET, 'BSYSCLD')
            DO I=1,IRET
               OBS3_8(4,I,3)=OBS3_8(5,I,3)
               OBS3_8(5,I,3)=BMISS
            ENDDO
CDONG -- BELOW NEED TO CHANGE IN THE FUTURE
            DO I=1,JRET
               OBS3_8(5,I,3)=RTMP(4,I)
            ENDDO
         ELSE
            CALL UFBINT(LUNIT,OBS3_8(1,1,3),5,255,IRET,
     $                                       'VSSO CLAM CLTP HOCB HOCT')
         ENDIF
         IF(IRET.EQ.1) THEN ! reset iret from 1 to 0 if all obs missing
                            !  (iret can be 1 even if all obs missing)
            AMINIMUM_8 = MIN(OBS3_8(1,1,3),OBS3_8(2,1,3),OBS3_8(3,1,3),
     $       OBS3_8(4,1,3),OBS3_8(5,1,3))
            IF(IBFMS(AMINIMUM_8).NE.0)  IRET = 0
         END IF
         NOBS3(3) = IRET
         IF(SUBSET(6:7).EQ.'10') THEN   ! SYNOPs (NC000100, NC000101, NC000102)
            CALL UFBSEQ(LUNIT,UFBINT2_8(1,1),12,255,IRET,'BSYEXTM')
            DO I=1,IRET
               IF(UFBINT2_8(3,I).LT.BMISS.AND.UFBINT2_8(4,I).LT.BMISS)
     $            OBS3_8(1,I,4)=UFBINT2_8(4,I)-UFBINT2_8(3,I)
               IF(UFBINT2_8(5,I).LT.BMISS) OBS3_8(2,I,4)=UFBINT2_8(5,I)
               IF(UFBINT2_8(6,I).LT.BMISS.AND.UFBINT2_8(7,I).LT.BMISS)
     $            OBS3_8(3,I,4)=UFBINT2_8(7,I)-UFBINT2_8(6,I)
               IF(UFBINT2_8(8,I).LT.BMISS) OBS3_8(4,I,4)=UFBINT2_8(8,I)
            ENDDO
         ELSE
            CALL UFBINT(LUNIT,OBS3_8(1,1,4),5,255,IRET,
     $                                    '.DTHMXTM MXTM .DTHMITM MITM')
         ENDIF
         IF(IRET.EQ.1) THEN ! reset iret from 1 to 0 if all obs missing
                            !  (iret can be 1 even if all obs missing)
            AMINIMUM_8 = MIN(OBS3_8(1,1,4),OBS3_8(2,1,4),OBS3_8(3,1,4),
     $       OBS3_8(4,1,4))
            IF(IBFMS(AMINIMUM_8).NE.0)  IRET = 0
         END IF
         NOBS3(4) = IRET
         IF(SUBSET(6:8).EQ.'007')  THEN                        ! METARs
            CALL UFBINT(LUNIT,OBS2_8( 7),1,1,IRET,'.REHOVI')
            CALL UFBINT(LUNIT,OBS2_8(12),2,1,IRET,'PKWDSP PKWDDR')
            CALL UFBINT(LUNIT,OBS2_8(22),1,1,IRET,'TOSS')
            CALL UFBINT(LUNIT,OBS2_8( 3),1,1,IRET,'ALSE')
         ELSE IF(SUBSET(6:7).EQ.'10') THEN   ! SYNOPs (NC000100, NC000101, NC000102)
            CALL UFBSEQ(LUNIT,UFBINT2_8(1,1),4,255,IRET, 'PWEATHER')
            OBS2_8(10)=UFBINT2_8(3,1)
            OBS2_8(11)=UFBINT2_8(4,1)
            CALL UFBINT(LUNIT,OBS2_8(23),2,1,IRET,'TOCC HBLCS')
            CALL UFBINT(LUNIT,OBS2_8(29),1,1,IRET,'.DTHDOFS')
            CALL UFBINT(LUNIT,OBS2_8(32),4,1,IRET,'HOWV POWV HOWW POWW')
            CALL UFBINT(LUNIT,OBS2_8(38),3,1,IRET,'CHPT 3HPC 24PC')
            CALL UFBSEQ(LUNIT,OBS3_8(1,1,1),5,255,IRET,'BSYPCP2')
            DO I=1,IRET
               RRTMP=OBS3_8(1,I,1)
               IF(RRTMP.LT.0.0) RRTMP=-RRTMP
               IF(RRTMP.EQ. 1.0) OBS2_8(17)=OBS3_8(2,I,1)
               IF(RRTMP.EQ. 3.0) OBS2_8(18)=OBS3_8(2,I,1)
               IF(RRTMP.EQ. 6.0) OBS2_8(19)=OBS3_8(2,I,1)
               IF(RRTMP.EQ.12.0) OBS2_8(20)=OBS3_8(2,I,1)
               IF(RRTMP.EQ.24.0) OBS2_8(21)=OBS3_8(2,I,1)
            ENDDO
            JRET=0
            DO I=1,IRET
               RRTMP=OBS3_8(1,I,1)
               IF(RRTMP.LT.0.0) RRTMP=-RRTMP

               IF(RRTMP.NE.1.0.AND.RRTMP.NE.3.0.AND.RRTMP.NE.6.0
     $           .AND.RRTMP.NE.12.AND.RRTMP.NE.24.0) THEN
                  DO J=2,23
                     IF(RRTMP.EQ.J) THEN
                        JRET=1
                        OBS3_8(1,JRET,1)=RRTMP
                        OBS3_8(2,JRET,1)=OBS3_8(2,I,1)
                     ENDIF
                  ENDDO
               ENDIF
            ENDDO
            IRET=JRET
            IF(IRET.EQ.1) THEN ! reset iret from 1 to 0 if all obs msng
                               !  (iret can be 1 even if all obs msng)
               AMINIMUM_8 = MIN(OBS3_8(1,1,1),OBS3_8(2,1,1))
               IF(IBFMS(AMINIMUM_8).NE.0)  IRET = 0
            END IF
            NOBS3(1) = IRET
            CALL UFBINT(LUNIT,OBS3_8(1,1,5),5,255,IRET,'DOSW HOSW POSW')
            IF(IRET.EQ.1) THEN ! reset iret from 1 to 0 if all obs msng
                               !  (iret can be 1 even if all obs msng)
               AMINIMUM_8 = MIN(OBS3_8(1,1,5),OBS3_8(2,1,5),
     $          OBS3_8(3,1,5))
               IF(IBFMS(AMINIMUM_8).NE.0)  IRET = 0
            END IF
            NOBS3(5) = IRET
         ELSE                                ! SYNOPs (NC000000, NC000001, NC000002)
            CALL UFBINT(LUNIT,OBS2_8(10),2,1,IRET,'PSW1 PSW2')
            CALL UFBINT(LUNIT,OBS2_8(20),1,1,IRET,'TP12')
            CALL UFBINT(LUNIT,OBS2_8(23),2,1,IRET,'TOCC HBLCS')
            CALL UFBINT(LUNIT,OBS2_8(29),1,1,IRET,'.DTHDOFS')
            CALL UFBINT(LUNIT,OBS2_8(32),4,1,IRET,'HOWV POWV HOWW POWW')
            CALL UFBINT(LUNIT,OBS2_8(38),3,1,IRET,'CHPT 3HPC 24PC')
            CALL UFBINT(LUNIT,OBS3_8(1,1,1),5,255,IRET,'.DTHTOPC TOPC')
            IF(IRET.EQ.1) THEN ! reset iret from 1 to 0 if all obs msng
                               !  (iret can be 1 even if all obs msng)
               AMINIMUM_8 = MIN(OBS3_8(1,1,1),OBS3_8(2,1,1))
               IF(IBFMS(AMINIMUM_8).NE.0)  IRET = 0
            END IF
            NOBS3(1) = IRET
            CALL UFBINT(LUNIT,OBS3_8(1,1,5),5,255,IRET,'DOSW HOSW POSW')
            IF(IRET.EQ.1) THEN ! reset iret from 1 to 0 if all obs msng
                               !  (iret can be 1 even if all obs msng)
               AMINIMUM_8 = MIN(OBS3_8(1,1,5),OBS3_8(2,1,5),
     $          OBS3_8(3,1,5))
               IF(IBFMS(AMINIMUM_8).NE.0)  IRET = 0
            END IF
            NOBS3(5) = IRET
         END IF
      ELSE IF(SUBSET(1:5).EQ.'NC001')  THEN        ! All surface marine
         IF(IBFMS(OBS2_8(4)).NE.0) THEN                  ! SST1 missing

c -- Buoy SSTs
            IF(SUBSET(6:8).EQ.'102'.or.SUBSET(6:8).EQ.'103') THEN ! buoys
C         Retrieve field SST0 from buoy reports originating in BUFR form 
              CALL UFBINT(LUNIT,OBS2_8(4),1,1,IRET,'SST0')
            ELSE IF(SUBSET(6:8).EQ.'002') THEN
C DBUOYs store sub-sfc temp, use 1st lvl if SST1 msg (unless > 10m down)
              CALL UFBINT(LUNIT,OBS2_8(4),2,1,IRET,'STMP DBSS')
              IF(OBS2_8(5).GT.10.)  THEN
                 OBS2_8(4:5) = BMISS
              END IF
            END IF ! subset(6:7) = 10  ! BUFR-feed types
         END IF ! obs2_8(4) ne 0 (SST1 missing)

         IF(IBFMS(OBS2_8(4)).EQ.0)  OBS2_8(41) = 2.0
         CALL UFBINT(LUNIT,OBS2_8( 6),1,1,IRET,'MSST')

c -- BUFR Ships reports need ufbint() mnemonics split up
         CALL UFBINT(LUNIT,OBS2_8( 8),2,1,IRET,'HOVI VTVI')
         CALL UFBINT(LUNIT,OBS2_8(10),2,1,IRET,'PSW1 PSW2')
         CALL UFBINT(LUNIT,OBS2_8(12),4,1,IRET,
     $                          'PKWDSP PKWDDR .DTMMXGS MXGS')


         CALL UFBINT(LUNIT,OBS2_8(23),4,1,IRET,'TOCC HBLCS XS10 XS20')

         if(subset(6:8).eq.'102'.or.subset(6:8).eq.'103') then ! BUFR buoys
           CALL UFBINT(LUNIT,OBS2_8(32),2,1,IRET,'SGWH AVWP')
         else ! TAC reports
           CALL UFBINT(LUNIT,OBS2_8(32),4,1,IRET,'HOWV POWV HOWW POWW')
         endif ! not 102 103

         CALL UFBINT(LUNIT,OBS2_8(36),5,1,IRET,
     $    'TDMP ASMP CHPT 3HPC 24PC')
         CALL UFBINT(LUNIT,OBS3_8(1,1,2),5,255,IRET,'PRWE')
         IF(IRET.EQ.1) THEN ! reset iret from 1 to 0 if all obs missing
                            !  (iret can be 1 even if all obs missing)
            IF(IBFMS(OBS3_8(1,1,2)).NE.0)  IRET = 0
         END IF
         NOBS3(2) = IRET
         IF(SUBSET(6:6).EQ.'1') THEN   ! SFCSHP in BUFR-Feed
            CALL UFBSEQ(LUNIT,UFBINT2_8(1,1),12,255,IRET,'GENCLOUD')
            I=1
            OBS3_8(1,I,3)=UFBINT2_8(2,I)
            OBS3_8(2,I,3)=UFBINT2_8(3,I)
            OBS3_8(4,I,3)=UFBINT2_8(4,I)
            OBS3_8(3,I,3)=UFBINT2_8(5,I)
            OBS3_8(3,I+1,3)=UFBINT2_8(6,I)
            OBS3_8(3,I+2,3)=UFBINT2_8(7,I)
            NOBS3(3) = IRET
            IF(UFBINT2_8(6,I).LT.BMISS) NOBS3(3) = 2
            IF(UFBINT2_8(7,I).LT.BMISS) NOBS3(3) = 3
         ELSE
            CALL UFBINT(LUNIT,OBS3_8(1,1,3),5,255,IRET,
     $       'VSSO CLAM CLTP HOCB')
            IF(IRET.EQ.1) THEN ! reset iret from 1 to 0 if all obs missing
                            !  (iret can be 1 even if all obs missing)
               AMINIMUM_8 = MIN(OBS3_8(1,1,3),OBS3_8(2,1,3),
     $          OBS3_8(3,1,3),OBS3_8(4,1,3))
               IF(IBFMS(AMINIMUM_8).NE.0)  IRET = 0
            END IF
            NOBS3(3) = IRET
         ENDIF
         CALL UFBINT(LUNIT,OBS3_8(1,1,5),5,255,IRET,'DOSW HOSW POSW')
         IF(IRET.EQ.1) THEN ! reset iret from 1 to 0 if all obs missing
                            !  (iret can be 1 even if all obs missing)
            AMINIMUM_8 = MIN(OBS3_8(1,1,5),OBS3_8(2,1,5),OBS3_8(3,1,5))
            IF(IBFMS(AMINIMUM_8).NE.0)  IRET = 0
         END IF
         NOBS3(5) = IRET
      ELSE IF(SUBSET(1:5).EQ.'NC255')  THEN              ! All Mesonets
            CALL UFBINT(LUNIT,OBS2_8(15),2,1,IRET,'MXGS MXGD')
            CALL UFBINT(LUNIT,OBS2_8( 8),1,1,IRET,'HOVI')
            CALL UFBINT(LUNIT,OBS2_8( 3),1,1,IRET,'ALSE')
            CALL UFBINT(LUNIT,OBS3_8(1,1,1),5,255,IRET,'TPHR TOPC')
            IF(IRET.EQ.1) THEN ! reset iret from 1 to 0 if all obs msng
                               !  (iret can be 1 even if all obs msng)
               AMINIMUM_8 = MIN(OBS3_8(1,1,1),OBS3_8(2,1,1))
               IF(IBFMS(AMINIMUM_8).NE.0)  IRET = 0
            END IF
            NOBS3(1) = IRET
      END IF
      OBS2 = OBS2_8
      OBS3 = OBS3_8
 
      CALL S05UBF

C  PUT THE HEADER INFORMATION INTO UNPACKED FORMAT
C  -----------------------------------------------
 
      CALL UFBINT(LUNIT,HDR_8,20,  1,IRET,HDSTR);HDR(2:)=HDR_8(2:)

C  IN EARLY 2004, MESONETS WILL CONVERT TO HIGH-RESOLUTION LAT/LON
C
C  EXPLOITING HIGH-RESOLUTION LAT/LON DATA FROM MARINE STATIONS AS OF 10/2019
C  ---------------------------------------------------------------

      IF(HDR_8(2).GE.BMISS)  THEN
         CALL UFBINT(LUNIT,UFBINT_8,1,1,IRET,'CLONH')
         HDR_8(2)=UFBINT_8
      END IF
      IF(HDR_8(3).GE.BMISS)  THEN
         CALL UFBINT(LUNIT,UFBINT_8,1,1,IRET,'CLATH')
         HDR_8(3)=UFBINT_8
      END IF
      IF(HDR_8(6).GE.BMISS)  THEN
         CALL UFBINT(LUNIT,UFBINT_8,1,1,IRET,'HSMSL')
         HDR_8(6)=UFBINT_8
         HDR(6)=HDR_8(6)
      END IF
      obs8_8(1) = hdr_8(3)
      obs8_8(2) = hdr_8(2)

      CALL UFBINT(LUNIT,RCT_8, 5,255,NRCT,RCSTR);RCT=RCT_8
      IF(HDR(5).GE.BMISS) HDR(5) = 0
      RCTIM = NINT(RCT(1,1))+NINT(RCT(2,1))/60.
      RID_8 = HDR_8(1)
      XOB   = HDR_8(2)
      YOB   = HDR_8(3)
      RHR   = BMISS
      IF(HDR(4).LT.BMISS)  RHR = NINT(HDR(4))+NINT(HDR(5))/60.
      ELV   = HDR(6)
      QMELV = HDR(7)
      ITP = IMISS
      RTP = ERTUBF(SUBSET,SID)
      IDS = IMISS

      RSV1 = '        '
      RSV2 = '        '

      IF(SUBSET(1:5).NE.'NC255')  THEN
C---------------------------------------------------------------------
C                   MESONET REPORTS DO NOT COME HERE
C---------------------------------------------------------------------

C  INDICATOR FOR PRECIPITATION (INCLUDED/EXCLUDED STORED IN BYTE 1 OF
C   HEADER RESERVE CHARACTER WORD 1
C  INDICATOR FOR WIND SPEED (SOURCE/UNITS) STORED IN BYTE 3 OF HEADER
C   RESERVE CHARACTER WORD 1
C         '0' - Wind speed estimated in m/s (uncertified instrument)
C         '1' - Wind speed obtained from anemometer in m/s (certified
C               instrument)
C         '3' - Wind speed estimated in knots (uncertified instrument)
C         '4' - Wind speed obtained from anemometer in knots (certified
C               instrument)
C         '7' - Missing
C  INDICATOR FOR STATION OPERATION/PAST WEATHER DATA STORED IN BYTE 5 OF
C   HEADER RESERVE CHARACTER WORD 1

         CALL UFBINT(LUNIT,UFBINT_8,1,1,NRSV,'INPC');RRSV(1)=UFBINT_8
         CALL UFBINT(LUNIT,UFBINT_8,1,1,NRSV,'TIWM');TIWM=UFBINT_8
         IF(TIWM.LT.BMISS)  THEN   ! Effective 5/2002
            RRSV(2) = 7
            IF(NINT(TIWM).LE.15)  RRSV(2) = ITIWM(NINT(TIWM))
         ELSE                      ! Prior to 5/2002
            CALL UFBINT(LUNIT,UFBINT_8,1,1,NRSV,'SUWS');RRSV(2)=UFBINT_8
         END IF
         CALL UFBINT(LUNIT,UFBINT_8,1,1,NRSV,'ITSO');RRSV(3)=UFBINT_8
         J = -1
         DO  I=1,3
            J = J + 2
            IF(RRSV(I).LT.BMISS)  WRITE(RSV1(J:J),'(I1)') NINT(RRSV(I))
         ENDDO
         IF(SUBSET(6:8).EQ.'007')  THEN                        ! METARs
C  TYPE OF HOURLY REPORT ("METAR", "SPECI" OR "LWIS") STORED IN BYTES
C   1-5 OF HEADER RESERVE CHARACTER WORD 2 (METAR REPORTS ONLY)
            CALL UFBINT(LUNIT,UFBINT_8,1,1,NRSV,'THRPT')
            RRSV(4)=UFBINT_8
            IF(NINT(RRSV(4)).EQ.0)  THEN
               RSV2(1:5) = 'METAR'
            ELSE  IF(NINT(RRSV(4)).EQ.1)  THEN
               RSV2(1:5) = 'SPECI'
            ELSE  IF(NINT(RRSV(4)).EQ.2)  THEN
               RSV2(1:5) = 'LWIS '
            ELSE
               RSV2(1:5) = '?????'
            END IF
C  CORRECTED REPORT INDICATOR ("CORN") STORED IN BYTE 8 OF HEADER
C   RESERVE CHARACTER WORD 2 (METAR REPORTS ONLY)
C         '0' - Not corrected
C         '1' - Corrected by report originator
C         '2' - Corrected by NCEP SDM
C         '3' to '6' - Reserved
C         '7' - Missing
            CALL UFBINT(LUNIT,UFBINT_8,1,1,NRSV,'CORN');RRSV(5)=UFBINT_8
            RSV2(8:8) = '7'
            IF(RRSV(5).LT.BMISS)  WRITE(RSV2(8:8),'(I1)') NINT(RRSV(5))
         END IF
      ELSE
C---------------------------------------------------------------------
C                      MESONET REPORTS COME HERE
C---------------------------------------------------------------------

C  MESONET PROVIDER ID STORED IN HEADER RESERVE CHARACTER WORD 1
C   (Note: Only first eight characters are stored)
         CALL UFBINT(LUNIT,RRVSTG_8,1,255,IRET,'PRVSTG')
cccc     IF(IRET.NE.0.AND.(RRVSTG_8(1).LE.BMISS-5000..OR.RRVSTG_8(1)
cccc $    .GE.BMISS+5000.))  RSV1 = PRVSTG
cxxxx
cpppppppppp
cc    print'(" rrvstg_8(1),icbfms(prvstg,8): ",G0,1X,I0)',
cc   $ rrvstg_8(1),icbfms(prvstg,8)
cpppppppppp
         IF(ICBFMS(PRVSTG,8).EQ.0) RSV1 = PRVSTG
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 prvstg when mnemonic "PRVSTG" not found) - dak 2/19/13
         call readlc(lunit,prvstg,'PRVSTG')
cpppppppppp
cc       print'(" prvstg = """,A,"""")', prvstg
cpppppppppp
         rsv1 = prvstg  ! will set rsv1 back to all blanks if readlc
                        !  returns prvstg as all blanks (rsv1 may have
                        !  been set to garbage above if ICBFMS
                        !  incorrectly returned as zero when prvstg is
                        !  actually missing) -- if prvstg is filled
                        !  with a valid character string by readlc,
                        !  this will also get translated into rsv1 here
cxxxx
C  MESONET SUBPROVIDER ID STORED IN HEADER RESERVE CHARACTER WORD 2
C   (Note: Only first eight characters are stored)
         CALL UFBINT(LUNIT,RPRVSTG_8,1,255,IRET,'SPRVSTG')
cccc     IF(IRET.NE.0.AND.(RPRVSTG_8(1).LE.BMISS-5000..OR.RPRVSTG_8(1)
cccc $    .GE.BMISS+5000.))  RSV2 = SPRVSTG
cxxxx
cpppppppppp
cc    print'(" rprvstg_8(1),icbfms(sprvstg,8): ",G0,1X,I0)',
cc   $ rprvstg_8(1),icbfms(sprvstg,8)
cpppppppppp
         IF(ICBFMS(SPRVSTG,8).EQ.0) RSV2 = SPRVSTG
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 sprvstg when mnemonic "SPRVSTG" not found)-dak 2/19/13
CCC DAK 2/26/13: READLC puts out diag. print when mnemonic not located
CCC              (i.e., missing) so to avoid thousands of lines of
CCC              print, will only call readlc if IRET is > 0, i.e., if
CCC              IRET is ZERO assume it is missing (a good bet) and
CCC              don't call READLC
                        if(IRET.gt.0) then
         call readlc(lunit,sprvstg,'SPRVSTG')
                        else
                           sprvstg = '        '
                        endif
cpppppppppp
cc    print'(" sprvstg = """,A,"""")', sprvstg
cpppppppppp
         rsv2 = sprvstg ! will set rsv2 back to all blanks if readlc
                        !  returns sprvstg as all blanks -- or IRET > 0
                        !    and sprvstg forced to be all blanks --
                        !  (rsv2 may have
                        !  been set to garbage above if ICBFMS
                        !  incorrectly returned as zero when sprvstg is
                        !  actually missing) -- if sprvstg is filled
                        !  with a valid character string by readlc,
                        !  this will also get translated into rsv2 here
cxxxx
C---------------------------------------------------------------------
      END IF

C  READ THE DATA LEVEL CATEGORY 51 SURFACE DATA FROM BUFR
C  ------------------------------------------------------
 
      CALL UFBINT(LUNIT,UFBINT_8,1,1,IRET,'PMSL');PSL=UFBINT_8
      CALL UFBINT(LUNIT,UFBINT_8,1,1,IRET,'PRES');STP=UFBINT_8
      CALL UFBINT(LUNIT,UFBINT_8,1,1,IRET,'WDIR');SDR=UFBINT_8
      CALL UFBINT(LUNIT,UFBINT_8,1,1,IRET,'WSPD');SSP=UFBINT_8
      CALL UFBINT(LUNIT,UFBINT_8,1,1,IRET,'TMDB');STM=UFBINT_8
      CALL UFBINT(LUNIT,UFBINT_8,1,1,IRET,'TMDP');DPD=UFBINT_8

C  All surface types come here for possible SDMEDIT q. mark assignment
C  -------------------------------------------------------------------

      CALL UFBINT(LUNIT,UFBINT_8,1,1,IRET,'QMPR');QSL=UFBINT_8
      CALL UFBINT(LUNIT,UFBINT_8,1,1,IRET,'QMPR');QSP=UFBINT_8
      CALL UFBINT(LUNIT,UFBINT_8,1,1,IRET,'QMWN');QMW=UFBINT_8
      CALL UFBINT(LUNIT,UFBINT_8,1,1,IRET,'QMAT');QMT=UFBINT_8
      CALL UFBINT(LUNIT,UFBINT_8,1,1,IRET,'QMDD');QMD=UFBINT_8
      QPR = 2 ! precip. rate (no q. marker available, set to neutral)
      QPT = 2 ! tot. precip. (no q. marker available, set to neutral)

      IF(SUBSET.EQ.'NC000007')  THEN

C  METARs transfer the quality marker from pstn to altimeter setting if
C   pstn q.m. was either a purge or reject value (pstn is missing for
C   METARS, so most will obtain this from altimeter setting in
C   PREPDATA and assign the pstn q.m. to be same as that of the
C   altimeter setting - the logic here ensures that a purge or reject
C   flag on pressure in the sdmedit file will be honored)
C  --------------------------------------------------------------------

         QAL = BMISS
         IF(NINT(QSP).EQ.14.OR.NINT(QSP).EQ.12) then
            QAL = QSP
         END IF
      END IF

      IF(SUBSET(1:5).EQ.'NC255')  THEN

C  If no SDMEDIT quality mark assigned above, mesonets check for
C    MADIS quality marks which are then converted to standard QM values
C  --------------------------------------------------------------------

         if(qsl.gt.14) QSL = BMISS        ! msl pressure (PMSL missing)

         CALL UFBREP(LUNIT,RMSO_8,2,1,IRET,'PRES QCD')
         RQCD_8 = RMSO_8(2)
cdak     print'(" MADIS PRES  QM is ",A)', QCD
         if(qsp.gt.14) QSP = MQMUBF(QCD)  ! station pressure

         CALL UFBREP(LUNIT,RMSO_8,2,1,IRET,'ALSE QCD')
         RQCD_8 = RMSO_8(2)
cdak     print'(" MADIS ALSE  QM is ",A)', QCD
         QAL = MQMUBF(QCD)                ! altimeter

         CALL UFBREP(LUNIT,RMSO_8,2,1,IRET,'TMDB QCD')
         RQCD_8 = RMSO_8(2)
cdak     print'(" MADIS TMDB  QM is ",A)', QCD
         if(qmt.gt.14) QMT = MQMUBF(QCD)  ! temperature

         CALL UFBREP(LUNIT,RMSO_8,2,1,IRET,'TMDP QCD')
         RQCD_8 = RMSO_8(2)
cdak     print'(" MADIS TMDP  QM is ",A)', QCD
         if(qmd.gt.14) QMD = MQMUBF(QCD)  ! dewpoint temperature

         CALL UFBREP(LUNIT,RMSO_8,2,1,IRET,'WDIR QCD')
         RQCD_8 = RMSO_8(2)
cdak     print'(" MADIS WDIR  QM is ",A)', QCD
         QWD = MQMUBF(QCD)  ! wind direction
         CALL UFBREP(LUNIT,RMSO_8,2,1,IRET,'WSPD QCD')
         RQCD_8 = RMSO_8(2)
cdak     print'(" MADIS WSPD  QM is ",A)', QCD
         QWS = MQMUBF(QCD)  ! wind speed
         if(qmw.gt.14) QMW = MAX(QWD,QWS) ! wind (overall)

         CALL UFBREP(LUNIT,RMSO_8,2,1,IRET,'REQV QCD')
         RQCD_8 = RMSO_8(2)
cdak     print'(" MADIS REQV  QM is ",A)', QCD
         QPR = MQMUBF(QCD)  ! precipitation rate

         CALL UFBINT(LUNIT,TOPC_8,1,255,IRETU,'TOPC')
         IRET = 0
         IF(IRETU.GT.0)CALL UFBSEQ(LUNIT,TOPC_8,5,IRETU,IRET,'MNTOPCSQ')
         QPT1  = BMISS
         QPT24 = BMISS
         IF(IRET.GT.0)  THEN
            DO I = 1,IRET
               IF(NINT(TOPC_8(1,I)).EQ.1)  THEN
                  RQCD_8 = TOPC_8(3,I)
cdak              print'(" MADIS 1-hr total precip. QM is ",A)', QCD
                  QPT1 = MQMUBF(QCD)   ! total precip. over 1-hr
               ELSE  IF(NINT(TOPC_8(1,I)).EQ.24)  THEN
                  RQCD_8 = TOPC_8(3,I)
cdak              print'(" MADIS 24-hr total precip. QM is ",A)', QCD
                  QPT24 = MQMUBF(QCD)  ! total precip. over 24-hr
               END IF
            ENDDO
         END IF

      END IF
 
C  PAOBS always have a missing elev, but we know they are at sea level
      IF(SUBSET.EQ.'NC001006')  ELV = 0
 
C  CALL FUNCTIONS TO TRANSFORM TO SPECIFIED UNPACKED FORMAT
C  --------------------------------------------------------

      PSQ = EQSUBF(QSL)
      SPQ = EQSUBF(QSP)
      SWQ = EQSUBF(QMW)
      STQ = EQSUBF(QMT)
      DDQ = EQSUBF(QMD)
 
      IF(PSL.LT.BMISS)  THEN
         PSL = NINT(PSL*.1)
      ELSE
         IF(PSQ.NE.14.AND.PSQ.NE.12) PSQ = 2
      END IF

C  The following line needed because old QUIPC program always
C   corrected STP to be PSL value if PSL was corrected, even if
C   STP was orig. missing or at some elevation above sea-lvl
C   (this is now fixed in quipc but is left here for old runs)
C  ------------------------------------------------------------

      IF(SUBSET(1:5).EQ.'NC001'.AND.NINT(QSL).EQ.4)  STP = BMISS
      IF(STP.LT.BMISS)  THEN
         STP = NINT(STP*.1)
      ELSE
         IF(SPQ.NE.14.AND.SPQ.NE.12) SPQ = 2
      END IF
      SSP = MIN(SSP*10.,BMISS)
      IF(NINT(SDR).EQ.0)   SDR = 360
      IF(SDR.GE.BMISS.AND.NINT(SSP).EQ.0)   SDR = 360
      IF(MIN(SDR,SSP).GE.BMISS)  SWQ = 2
      IF(MAX(DPD,STM).LT.BMISS)  THEN
         DPD = (STM-DPD)*10.
      ELSE
         DPD = BMISS
C - note this was not set before  & could make a bufr chg in checking
         DDQ = 2
      END IF
      IF(STM.LT.BMISS)  THEN
         ISTM = NINT(STM*100.)
         STM = NINT((ISTM-27315)*0.1)
      ELSE
         STQ = 2
      END IF

C  MAKE THE UNPACKED REPORT INTO OBS
C  ---------------------------------
 
      RSTP = IMISS
      CALL S01UBF(SID,XOB,YOB,RHR,RCTIM,RSV1,RSV2,ELV,QMELV,ITP,RTP,
     $ RSTP,IDS)
      CALL S02UBF(51,1,*9999)

C  ------------------------------------------------------------------
C  MISC DATA GOES INTO DATA LEVEL CATEGORY 08
C  ------------------------------------------------------------------
C  CODE FIGURE 003 - DIFFUSE SOLAR RADIATION IN 100.*JOULE/M**2
C                    INDICATOR 2 CONTAINS TIME PERIOD OVER WHICH
C                     RADIATION WAS INTEGRATED (MINUTES)
C  CODE FIGURE 004 - DIRECT SOLAR RADIATION IN 100.*JOULE/M**2
C                    INDICATOR 2 CONTAINS TIME PERIOD OVER WHICH
C                     RADIATION WAS INTEGRATED (MINUTES)
C  CODE FIGURE 005 - QUALITY MARKER FOR TOTAL PRECIP. OVER  1-HR
C  CODE FIGURE 006 - QUALITY MARKER FOR TOTAL PRECIP. OVER 24-HR
C  CODE FIGURE 020 - QUALITY MARKER FOR ALTIMETER SETTING
C  CODE FIGURE 198 - RAINFALL RATE (MM/SEC, TO 10**6 PRECISION FOR
C                     SSM/I AND TO 10**4 PRECISION FOR ALL OTHER DATA
C                     TYPES)
C                    INDICATOR 2 CONTAINS RAINFALL RATE QUALITY MARKER
C  ------------------------------------------------------------------

      IF(SUBSET(1:5).EQ.'NC255'.OR.SUBSET.EQ.'NC000007')  THEN
         IF(QAL.LT.BMISS)  THEN
            OB8(1) = QAL
            CF8(1) = 20 
            Q81(1) = IMISS
            Q82(1) = IMISS
            CALL S02UBF(8,1,*9999)
         END IF
      END IF
      IF(SUBSET(1:5).EQ.'NC255')  THEN
         CALL UFBINT(LUNIT,UFBINT_8,1,1,IRET,'REQV');REQV=UFBINT_8
         IF(REQV.LT.BMISS) THEN
            OB8(1) =  REQV
            CF8(1) = 198
            Q81(1) = IMISS
            Q82(1) = QPR
            CALL S02UBF(8,1,*9999)
         END IF
         CALL UFBINT(LUNIT,SOLR_8,3,255,IRET,'DFSORD DRSORD TPMI')
         SOLR=SOLR_8
         IF(SOLR(1,1).LT.BMISS)  THEN
            OB8(1) = NINT(SOLR(1,1)*0.01)
            CF8(1) = 3
            Q81(1) = IMISS
            Q82(1) = IMISS
            IF(SOLR(3,1).LT.BMISS)  Q82(1) = SOLR(3,1)
            CALL S02UBF(8,1,*9999)
         END IF
         IF(SOLR(2,1).LT.BMISS)  THEN
            OB8(1) = NINT(SOLR(2,1)*0.01)
            CF8(1) = 4
            Q81(1) = IMISS
            Q82(1) = IMISS
            IF(SOLR(3,1).LT.BMISS)  Q82(1) = SOLR(3,1)
            CALL S02UBF(8,1,*9999)
         END IF
         IF(QPT1.LT.BMISS)  THEN
            OB8(1) = QPT1
            CF8(1) = 5
            Q81(1) = IMISS
            Q82(1) = IMISS
            CALL S02UBF(8,1,*9999)
         END IF
         IF(QPT24.LT.BMISS)  THEN
            OB8(1) = QPT24
            CF8(1) = 6
            Q81(1) = IMISS
            Q82(1) = IMISS
            CALL S02UBF(8,1,*9999)
         END IF
         GO TO 75
      END IF
 
  75  CONTINUE

      CALL S03UBF(OBS,SUBSET,*9999,*9998,*9997)
 
      RETURN

 9999 CONTINUE
      R04UBF = 999
      RETURN

 9998 CONTINUE
      print'(" IW3UNPBF/R04UBF: RPT with ID= ",A," TOSSED - ZERO ",
     $ "CAT.1-6,51 LVLS")', SID
 9997 CONTINUE
      R04UBF = -9999
      KSKSFC =KSKSFC + 1
      RETURN

      END
C***********************************************************************
C***********************************************************************
C***********************************************************************
      FUNCTION R05UBF(LUNIT,OBS,OBS2,OBS3,NOBS3,obs8_8)
C     ---> PROCESSES AIRCRAFT DATA (004/001-004, 004/006-011, 004/103)

      COMMON/IUBFAA/BMISS
      COMMON/IUBFBB/KNDX,KSKACF(8),KSKUPA,KSKSFC,KSKSAT,KFLSAT(12),
     $ KSKSMI
      COMMON/IUBFCC/SUBSET
      COMMON/IUBFEE/POB(255),QOB(255),TOB(255),ZOB(255),DOB(255),
     $              SOB(255),VSG(255),OB8(255),CF8(255)
      COMMON/IUBFFF/PQM(255),QQM(255),TQM(255),ZQM(255),WQM(255)
      COMMON/IUBFLL/Q81(255),Q82(255)
      COMMON/IUBFRR/IDATEB
      COMMON/IUBFSS/CBULLX
 
      CHARACTER*80 HDSTR,LVSTR,QMSTR,RCSTR,CRAWR
      CHARACTER*500 CRAWRX
      CHARACTER*11  CBULLX
      CHARACTER*8  SUBSET,SID,RSV1,RSV2,CRAW(255),ACID,QCD,CBUHD,
     $ CBORG,actp,obsvr
      REAL(8) RID_8,UFBINT_8,RNS_8,OBS2_8(43),OBS3_8(5,255,7),
     $ RACID_8,RTAM_8(2),RTAM_WDIR_8,RQCD_8,BULL_8(2),RTAMB_8(7),
     $ ractp_8,robsvr_8,obs8_8(2)
      REAL(8) HDR_8(20),RCT_8(5,255),ARR_8(10,255),RAW_8(255),TRBX_8(5),
     $ ROLF_8,BMISS,AMINIMUM_8,AMAXIMUM_8,rialr_8
      DIMENSION    OBS(*),OBS2(43),OBS3(5,255,7),NOBS3(7),HDR(20),
     $ RCT(5,255),ARR(10,255),TRBX(5)
      EQUIVALENCE  (RID_8,SID),(RAW_8,CRAW),(RACID_8,ACID),
     $ (RQCD_8,QCD),(BULL_8(1),CBORG),(BULL_8(2),CBUHD),(ractp_8,actp),
     $ (robsvr_8,obsvr)

      SAVE
 
      DATA HDSTR/'RPID CLON CLAT HOUR MINU SECO               '/
      DATA LVSTR/'PRLC MIXR TMDB WDIR WSPD REHU               '/
      DATA QMSTR/'QMPR QMAT QMDD QMGP QMWN                    '/
      DATA RCSTR/'RCHR RCMI RCTS                              '/
 
      DATA IMISS/99999/,XMISS/99999./

C FCNS HGTF_HI, HGTF_LO CALC. Z FROM P < 226.3MB AND P > 226.3MB; RESP
C  (U.S. STANDARD ATMOSPHERE)

      HGTF_HI(P) = 11000 - ALOG(P/226.3)/1.576106E-4
      HGTF_LO(P) = (1.-(P/1013.25)**(1./5.256))*(288.15/.0065)

C  FCNS BELOW CONVERT SAT./SPEC. HUM.(KG/KG) & PRESS(MB) INTO TEMP/TD(K)
C  ---------------------------------------------------------------------

      AS(Q,P) = ALOG((Q * P)/(6.1078 * ((0.378 * Q) + 0.622)))
      TFRMQP(Q,P) = ((237.3 * AS(Q,P))/(17.269 - AS(Q,P)) + 273.16)

C  FCNS BELOW CONVERT TEMP/TD(K) & PRESS(MB) INTO SAT./SPEC. HUM.(KG/KG)
C  ---------------------------------------------------------------------

      ES(T) = 6.1078 * EXP((17.269 * (T - 273.16))/((T - 273.16)+237.3))
      QFRMTP(T,P) = (0.622 * ES(T))/(P - (0.378 * ES(T)))

C  Fcns below estimate pressure (mb) using indicated altitude (m) via
C  U.S. Std. Atmos. Est. for Z <= 11,000 and Z > 11,000 respectively
C  ------------------------------------------------------------------

      PR(Z) = 1013.25 * (((288.15 - (.0065 * Z))/288.15)**5.256)
      PRS(Z) = 226.3 * EXP(1.576106E-4 * (11000. - Z))

      R05UBF = 0

C  STORE SINGLE LEVEL REPORT DATA DIRECTLY INTO OBS2 ARRAY,
C   MULTIPLE LEVEL REPORT DATA DIRECTLY INTO OBS3 ARRAY AND
C   DOUBLE-PRECISION SINGLE LEVEL REPORT DATA DIRECTLY INTO OBS8_8 ARRAY
C  ---------------------------------------------------------------------

      OBS2_8 = BMISS
      OBS3_8 = BMISS
      NOBS3  = 0
      obs8_8 = bmiss
      CALL UFBINT(LUNIT,OBS2_8,2,1,IRET,'RSRD EXPRSRD')
                                                         ! All AIRCRAFT
      CALL UFBINT(LUNIT,OBS3_8(1,1,7),5,255,IRET,'DGOT HBOT HTOT')
      IF(IRET.EQ.1) THEN ! reset iret from 1 to 0 if all obs missing
                         !  (iret can be 1 even if all obs missing)
         AMINIMUM_8 = MIN(OBS3_8(1,1,7),OBS3_8(2,1,7),OBS3_8(3,1,7))
         IF(IBFMS(AMINIMUM_8).NE.0) IRET = 0
      END IF
      NOBS3(7) = IRET
      IF(SUBSET.EQ.'NC004002')  THEN                           ! PIREPs
         CALL UFBINT(LUNIT,OBS3_8(1,1,2),5,255,IRET,'PRWE')
         IF(IRET.EQ.1) THEN ! reset iret from 1 to 0 if all obs missing
                            !  (iret can be 1 even if all obs missing)
            IF(IBFMS(OBS3_8(1,1,2)).NE.0)  IRET = 0
         END IF
         NOBS3(2) = IRET
         CALL UFBINT(LUNIT,OBS3_8(1,1,3),5,255,IRET,
     $                                        'NUL CLAM CLTP HOCB HOCT')
         IF(IRET.EQ.1) THEN ! reset iret from 1 to 0 if all obs missing
                            !  (iret can be 1 even if all obs missing)
            AMINIMUM_8 = MIN(OBS3_8(2,1,3),OBS3_8(3,1,3),OBS3_8(4,1,3),
     $       OBS3_8(5,1,3))
            IF(IBFMS(AMINIMUM_8).NE.0) IRET = 0
         END IF
         NOBS3(3) = IRET
      ELSE IF(SUBSET.EQ.'NC004004')  THEN                !  MDCRS ACARS
         CALL UFBINT(LUNIT,OBS2_8(42),1,1,IRET,'MSTQ')
      END IF
      IF(SUBSET.EQ.'NC004002'.OR.SUBSET.EQ.'NC004006'.OR.
     $   SUBSET.EQ.'NC004009'.OR.SUBSET.EQ.'NC004010')  THEN
                        ! PIREPs, E-AMDAR, Canadian AMDAR, TAMDARB
         CALL UFBINT(LUNIT,OBS3_8(1,1,6),5,255,IRET,'AFIC HBOI HTOI')
                                     ! For TAMDAR only AFIC is present
                                     ! and only in older AirDAT
         IF(IRET.EQ.1) THEN ! reset iret from 1 to 0 if all obs missing
                            !  (iret can be 1 even if all obs missing)
            AMINIMUM_8 = MIN(OBS3_8(1,1,6),OBS3_8(2,1,6),OBS3_8(3,1,6))
            IF(IBFMS(AMINIMUM_8).NE.0) IRET = 0
         END IF
         NOBS3(6) = IRET
      END IF
      OBS2 = OBS2_8
      OBS3 = OBS3_8

      CALL S05UBF
 
C  PUT THE HEADER INFORMATION INTO UNPACKED FORMAT
C  -----------------------------------------------
 
      CALL UFBINT(LUNIT,HDR_8,20,  1,IRET,HDSTR);HDR(2:)=HDR_8(2:)

C  If low res lat/lon missing, report likely contains hi res lat/lon
C  -----------------------------------------------------------------

      IF(HDR_8(2).GE.BMISS)  THEN
         CALL UFBINT(LUNIT,UFBINT_8,1,1,IRET,'CLONH')
         HDR_8(2)=UFBINT_8
      END IF
      IF(HDR_8(3).GE.BMISS)  THEN
         CALL UFBINT(LUNIT,UFBINT_8,1,1,IRET,'CLATH')
         HDR_8(3)=UFBINT_8
      END IF
      obs8_8(1) = hdr_8(3)
      obs8_8(2) = hdr_8(2)

      IF(IRET.EQ.0)  SID = '        '
      CALL UFBINT(LUNIT,RCT_8, 5,255,NRCT,RCSTR);RCT=RCT_8
      IF(HDR(5).GE.BMISS) HDR(5) = 0
      IF(HDR(6).GE.BMISS) HDR(6) = 0
      RCTIM = NINT(RCT(1,1))+NINT(RCT(2,1))/60.
      RID_8 = HDR_8(1)
      XOB   = HDR_8(2)
      YOB   = HDR_8(3)
      RHR   = BMISS
      IF(HDR(4).LT.BMISS) RHR = (NINT(HDR(4)) + ((NINT(HDR(5)) * 60.) +
cvvvvvdak port
cdak $  NINT(HDR(6)))/3600.) + 0.0000000001  ! orig
cdak $  NINT(HDR(6)))/3600.) + 0.0001        ! then changed to this
caaaaadak port
     $  NINT(HDR(6)))/3600.)   ! don't make this adjustment now that we
                               ! store obs time to 10**5 in PREPBUFR
 
C  TRY TO FIND THE FLIGHT LEVEL HEIGHT
C  -----------------------------------

      CALL UFBINT(LUNIT,HDR_8,20,1,IRET,
     $ 'PSAL FLVL IALT PRLC HEIT HMSL FLVLST')
      HDR=HDR_8
 
C If this type reports pressure (PRLC) store it here -- PREPDATA uses
C  this for pressure (currently applies to pre-v7 BUFR MDCRS and MADIS/
C  TAMDAR only)
C   -- in this case PREPDATA uses a pressure-altitude derived from PRLC
C      via standard atmosphere function unless line
C           "IF(HDR(3).LT.BMISS)  ELEV = HDR(3)"
C      below is uncommented, in which case PREPDATA uses IALT (altitude)
C      (if reported) as pressure-altitude (IALT is the only height
C      type reported for MDCRS, both pre- and post-v7 BUFR; it is not
C      reported for MADIS/TAMDAR, in fact no height type is reported for
C      MADIS/TAMDAR)
C-----------------------------------------------------------------------
C Otherwise, if this type does not report pressure (PRLC) but does
C  report PSAL (pressure altitude), PREPDATA uses reported PSAL as
C  pressure-altitude (currently applies to AMDAR format only, both PSAL
C  and FLVL are included but in most cases FLVL is missing, PSAL is
C  never missing and where PSAL and FLVL are both non-missing they are
C  identical)
C  PREPDATA later derives pressure from PSAL via standard atmosphere
C  function
C-----------------------------------------------------------------------
C Otherwise, if this type does not report pressure (PRLC) but does
C  report FLVL (flight level), PREPDATA uses reported FLVL as pressure-
C  altitude (currently applies to AIREP/PIREP format only, both PSAL
C  and FLVL are included but only FLVL is non-missing)
C  PREPDATA later derives pressure from FLVL via standard atmosphere
C  function
C-----------------------------------------------------------------------
C Otherwise, if this type does not report pressure (PRLC) but does
C  report FLVLST (flight level), PREPDATA uses reported FLVLST as
C  pressure-altitude {currently applies to Korean AMDAR, catch-all
C  AMDAR (from BUFR feed)}
C  PREPDATA later derives pressure from FLVLST via standard atmosphere
C  function
C
C  2016-07-27  C. Hill --
C         - PAC/AirDat has confirmed HMSL is pressure-altitude for
C           the TAMDAR dataset, and should be used to derive pressure
C           values. FLVLST is GPS altitude for TAMDAR.
C         - For the previous UFBINT statement, FLVLST is reordered after
C           PRLC, HEIT, and HMSL, as HEIT and HMSL are both missing for
C           Korean AMDAR and catch-all AMDAR, and are therefore skipped.
C         - The order of precedence in defining ELEV is:
C           PRLC, IALT, PSAL, FLVL, HEIT, HMSL, and FLVLST
C-----------------------------------------------------------------------
C Otherwise, if this type does not report pressure (PRLC) but does
C  report IALT (altitude), PREPDATA uses reported IALT as pressure-
C  altitude (currently applies to post-v7 BUFR MDCRS only)
C  PREPDATA later derives pressure from IALT via standard atmosphere
C  function
C-----------------------------------------------------------------------
C Otherwise, if this type does not report pressure (PRLC) but does
C  report HEIT (height), PREPDATA uses reported HEIT as pressure-
C  altitude (currently applies to no reports, HEIT is included in
C  E-AMDAR and Canadian AMDAR but is always missing)
C  PREPDATA later derives pressure from HEIT via standard atmosphere
C  function
C-----------------------------------------------------------------------
C Otherwise, if this type does not report pressure (PRLC) but does
C  report HMSL (altitude), PREPDATA uses reported HMSL as pressure-
C  altitude (currently applies to E-AMDAR and Canadian AMDAR, both HEIT
C  and HMSL are included but only HMSL is non-missing; HMSL is
C  non-missing for AirDAT/TAMDAR)
C  PREPDATA later derives pressure from HMSL via standard atmosphere
C  function
C-----------------------------------------------------------------------

      IF(HDR(4).LT.BMISS)  THEN
! pressure is non-missing - initially get elev from pressure
!  pre-v7 BUFR MDCRS and MADIS/TAMDAR
         IF(HDR(4).LT.22630) THEN
            ELEV = HGTF_HI(HDR(4)*.01)
         ELSE
            ELEV = HGTF_LO(HDR(4)*.01)
         END IF
      ELSE IF (HDR(3).LT.BMISS) THEN
         ELEV = HDR(3)        ! IALT (post-v7 BUFR MDCRS)
      ELSE
         ELEV = BMISS
      ENDIF

CCCC  ELSE
CCCC    ELEV = BMISS
        IF(HDR(1).LT.BMISS) THEN
                              ! PSAL (AMDAR format)
           ELEV = HDR(1) + SIGN(0.0000001,HDR(1))
        ELSE  IF(HDR(2).LT.BMISS)  THEN
                              ! FLVL (AIREP/PIREP format)
           ELEV = HDR(2) + SIGN(0.0000001,HDR(2))
  !! uncomment next 2 lines to obtain elev from IALT when PRLC
  !!  non-missing (applies to pre-v7 BUFR MDCRS)
CCCC    ELSE  IF(HDR(3).LT.BMISS.AND.HDR(4).LT.BMISS)  THEN
CCCC       ELEV = HDR(3)
        ELSE  IF(HDR(5).LT.BMISS)  THEN
                              ! HEIT (none right now)
           ELEV = HDR(5) + SIGN(0.0000001,HDR(5))
        ELSE  IF(HDR(6).LT.BMISS)  THEN
                              ! HMSL (E-AMDAR, Canadian AMDAR & TAMDARB)
           ELEV = HDR(6) + SIGN(0.0000001,HDR(6))
        ELSE  IF(HDR(7).LT.BMISS)  THEN
                              ! FLVLST (Catch-all & Korean BUFR AMDAR)
           ELEV = HDR(7) + SIGN(0.0000001,HDR(7))
        END IF
CCCC  END IF

      ELV = ELEV
      QMELV = XMISS

C  ACFT NAVIGATION SYSTEM STORED IN INSTR. TYPE LOCATION (AS WITH ON29)
C  --------------------------------------------------------------------

      ITP = IMISS
      CALL UFBINT(LUNIT,RNS_8,1,1,IRET,'ACNS');RNS=RNS_8
      IF(RNS.LT.BMISS)  THEN
         IF(NINT(RNS).EQ.0)  THEN
            ITP = 97  ! Inertial Navigation System
         ELSE  IF(NINT(RNS).EQ.1)  THEN
            ITP = 98  ! OMEGA
         END IF
      END IF

      RTP = 041
      READ(SUBSET(6:8),'(I3.3)')ISTP
      RSTP=ISTP

      IDS = IMISS

      RSV1 = '        '
      RSV2 = '        '

C  BULLETIN HEADER AND ORIGINATOR STORED IN CBULLX
C  -----------------------------------------------

      CALL UFBINT(LUNIT,BULL_8,2,1,IRET,'BORG BUHD')

cccc  IF(IRET.NE.0.AND.(BULL_8(1).LE.BMISS-5000..OR.
cccc $ BULL_8(1).GE.BMISS+5000.)) THEN
cxxxx
cpppppppppp
cc    print'(" bull_8(1),icbfms(CBORG,8): ",G0,1X,I0)', bull_8(1),
cc   $ icbfms(CBORG,8)
cpppppppppp
ccccc IF(ICBFMS(CBORG,8).EQ.0) THEN
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 CBORG when mnemonic "BORG" not found) - dak 2/19/13
C   {Note: For Panasonic (AirDAT) TAMDAR, BORG and BUHD are always
C          missing, so set CBORG to all blanks and don't call READLC
C          because it will print out warning messages.}
         if(subset.eq.'NC004010')  then
            CBORG = '        '
         else
            call readlc(lunit,CBORG,'BORG')
         end if
cpppppppppp
cc    print'(" CBORG = """,A,"""")', CBORG
cpppppppppp
         if(CBORG.ne.'        ')  then
cxxxx
         CBULLX = CBUHD(1:6)//' '//CBORG(1:4)
      ELSE
         CALL UFBINT(LUNIT,BULL_8,2,1,IRET,'ICLI')  ! Prior to  5/2002
cccc     IF(IRET.NE.0.AND.(BULL_8(1).LE.BMISS-5000..OR.
cccc $    BULL_8(1).GE.BMISS+5000.))  CBULLX = '       '//CBORG(1:4)
cxxxx
cpppppppppp
cc    print'(" bull_8(1),icbfms(CBORG,8): ",G0,1X,I0)', bull_8(1),
cc   $ icbfms(CBORG,8)
cpppppppppp
         IF(ICBFMS(CBORG,8).EQ.0) CBULLX = '       '//CBORG(1:4)
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 CBORG when mnemonic "ICLI" not found) - dak 2/19/13
C   {Note: For Panasonic (AirDAT) TAMDAR, ICLI is always missing, so set
C          CBORG to all blanks and don't call READLC because it will
C          print out warning messages.}
         if(subset.eq.'NC004010')  then
            CBORG = '        '
         else
            call readlc(lunit,CBORG,'ICLI')
         end if
cpppppppppp
cc    print'(" CBORG = """,A,"""")', CBORG
cpppppppppp
         CBULLX = '       '//CBORG(1:4)
                              ! will set CBULLX back to all blanks
                              !  if readlc returns CBORG as all blanks
                              !  {CBULLX may have been set to
                              !  garbage above if ICBFMS incorrectly
                              !  returned as zero when CBORG is
                              !  actually missing) -- if CBORG is
                              !  filled with a valid character string
                              !  by readlc, this will also get
                              !  translated into CBULLX here
                              ! will also set CBULLX to all blanks if
                              !  if Panasonic (AirDAT) TAMDAR
cxxxx
      END IF

      PCT   = BMISS
      POF   = BMISS
      TRBX  = BMISS
      ROLF  = BMISS
      RIALR = BMISS
      QTRBX = IMISS

      IF(SUBSET.EQ.'NC004003')  THEN
 
C  --------------------------------------
C  AMDAR FORMAT AIRCRAFT TYPE COME HERE
C  --------------------------------------

C  AFWA (NEVER HAPPENS) INDICATOR STORED IN BYTE 1 OF HEADER RESERVE
C   CHARACTER WORD 2
C   (NOTE: NAS9000 ONLY ASSIGNED BULLETIN ORIGINATOR "KAWN" AS AFWA,
C          ALTHOUGH BULLETIN ORIGINATORS "PHWR" AND "EGWR" ARE
C          APPARENTLY ALSO AFWA)
C  -----------------------------------------------------------------

         IF(CBULLX(8:11).EQ.'KAWN')  RSV2(1:1) = 'C'

      ELSE IF(SUBSET.EQ.'NC004004') THEN
 
C  -------------------------------------
C  MDCRS ACARS AIRCRAFT TYPE COME HERE
C  -------------------------------------
 
         CALL UFBINT(LUNIT,RID_8,1,1,IRET,'ACRN')
cccc     IF(IRET.EQ.0.OR.(RID_8.GT.BMISS-5000..AND.RID_8.LT.BMISS+
cccc $    5000.))  SID = 'ACARS   '
cxxxx
cpppppppppp
cc    print'(" rid_8,icbfms(sid,8): ",G0,1X,I0)', rid_8,icbfms(sid,8)
cpppppppppp
ccccc    IF(ICBFMS(SID,8).NE.0) SID = 'ACARS   '
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 "ACRN" not found) - dak 2/19/13
         call readlc(lunit,sid,'ACRN')
cpppppppppp
cc    print'(" sid = """,A,"""")', sid
cpppppppppp
         if(sid.eq.'        ')  sid = 'ACARS   '
cxxxx

C  FLIGHT NUMBER STORED IN HEADER RESERVE CHARACTER WORD 2 (C*8)
C  -------------------------------------------------------------

         CALL UFBINT(LUNIT,RACID_8,1,1,IRET,'ACID')
cccc     IF(IRET.EQ.0.OR.(RACID_8.GT.BMISS-5000..AND.RACID_8.LT.BMISS+
cccc $    5000.))  ACID = '        '
cxxxx
cpppppppppp
cc    print'(" racid_8,icbfms(acid,8): ",G0,1X,I0)',
cc   $ racid_8,icbfms(acid,8)
cpppppppppp
ccccc    IF(ICBFMS(ACID,8).NE.0) ACID = '        '
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 acid when mnemonic "ACID" not found) - dak 2/19/13
         call readlc(lunit,acid,'ACID')
cpppppppppp
cc    print'(" acid = """,A,"""")', acid
cpppppppppp
         if(acid.eq.'        ')  acid = '        ' ! kind of obvious!
cxxxx
         RSV2 = ACID
         KNDX = KNDX + 1

C  GET TURBULENCE INDEX FOR LATER STORAGE INTO DATA LEVEL CATEGORY 8
C  -----------------------------------------------------------------

         CALL UFBINT(LUNIT,TRBX_8,4,1,IRET,
     $    'TRBX10 TRBX21 TRBX32 TRBX43');TRBX(1:4)=TRBX_8(1:4)

      ELSE IF(SUBSET.EQ.'NC004006'.OR.SUBSET.EQ.'NC004009'.OR.
     $        SUBSET.EQ.'NC004010') THEN
 
C  ------------------------------------------------------------
C  E-AMDAR, CANADIAN AMDAR, and TAMDARB AIRCRAFT TYPE COME HERE
C  ------------------------------------------------------------
 
         CALL UFBINT(LUNIT,RID_8,1,1,IRET,'ACRN')
cccc     IF(IRET.EQ.0.OR.(RID_8.GT.BMISS-5000..AND.RID_8.LT.BMISS+
cccc $    5000.))  THEN
cxxxx
cpppppppppp
cc    print'(" rid_8,icbfms(sid,8): ",G0,1X,I0)', rid_8,icbfms(sid,8)
cpppppppppp
ccccc    IF(ICBFMS(SID,8).NE.0) THEN
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 "ACRN" not found) - dak 2/19/13
         call readlc(lunit,sid,'ACRN')
cpppppppppp
cc    print'(" sid = """,A,"""")', sid
cpppppppppp
         if(sid.eq.'        ')  then
cxxxx
            IF(SUBSET.EQ.'NC004006')  THEN
               SID = 'E-AMDAR '
            ELSE IF(SUBSET.EQ.'NC004009') THEN
               SID = 'CA-AMDAR'
            ELSE
               SID = 'TAMDARB '
            END IF
         END IF

         IF(SUBSET.EQ.'NC004010') THEN

C     .................................................
C     PANASONIC (AirDAT) TAMDAR AIRCRAFT TYPE COME HERE
C     .................................................

C  GET INSTANTANEOUS ALTITUDE RATE FOR LATER STORAGE INTO DATA LEVEL
C   CATEGORY 8
C  -----------------------------------------------------------------

            CALL UFBINT(LUNIT,RIALR_8,1,1,IRET,'IALR');RIALR=RIALR_8

C  TYPE OF COMMERCIAL AIRCRAFT STORED IN HEADER RESERVE CHARACTER
C   WORD 2 (C*8)
C  --------------------------------------------------------------

            CALL UFBINT(LUNIT,RACTP_8,1,1,IRET,'ACTP')
            if(ibfms(RACTP_8).ne.0) ACTP = '        '
            RSV2 = ACTP

C  OBSERVER IDENTIFICATION STORED IN BYTES 1-4 OF HEADER RESERVE
C   CHARACTER WORD 1
C  -------------------------------------------------------------

            CALL UFBINT(LUNIT,ROBSVR_8,1,1,IRET,'OBSVR')
            if(ibfms(ROBSVR_8).ne.0) OBSVR(1:4) = '    '
            RSV1(1:4) = OBSVR(1:4)

         END IF

      else if(subset.eq.'NC004011'.or.subset.eq.'NC004103') then

C  --------------------------------------------------------
C  KOREAN AMDAR AND CATCH-ALL AMDAR AIRCRAFT TYPE COME HERE
C  --------------------------------------------------------

         CALL UFBINT(LUNIT,RID_8,1,1,IRET,'ACRN')
         CALL UFBINT(LUNIT,RACID_8,1,1,IRET,'ACID')

         if(ibfms(rid_8).eq.1) then ! ACRN missing; use ACID
            rid_8 = racid_8
            if(ibfms(rid_8).eq.1) then ! ACRN and ACID both missing
               IF(SUBSET.EQ.'NC004011')  THEN
                  SID = 'K-AMDAR '
               ELSE
                  SID = 'AMDAR-BF'
               END IF
            end if
         end if

         if(ibfms(racid_8).eq.1) then
            ACID = '        '
         end if

C  FLIGHT NUMBER STORED IN HEADER RESERVE CHARACTER WORD 2 (C*8)
C  -------------------------------------------------------------
         if(subset.eq.'NC004103') RSV2 = ACID

      ELSE IF(SUBSET.EQ.'NC004008'.OR.SUBSET.EQ.'NC004012'.OR.
     $        SUBSET.EQ.'NC004013') THEN
 
C  ------------------------------------
C  MADIS/TAMDAR AIRCRAFT TYPE COME HERE
C  ------------------------------------
 
         CALL UFBINT(LUNIT,RID_8,1,1,IRET,'ACID')
cccc     IF(IRET.EQ.0.OR.(RID_8.GT.BMISS-5000..AND.RID_8.LT.BMISS+
cccc $    5000.))  SID = 'TAMDAR-M'
cxxxx
cpppppppppp
cc    print'(" rid_8,icbfms(sid,8): ",G0,1X,I0)', rid_8,icbfms(sid,8)
cpppppppppp
ccccc    IF(ICBFMS(SID,8).NE.0)  SID = 'TAMDAR-M'
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 "ACID" not found) - dak 2/19/13
         call readlc(lunit,sid,'ACID')
cpppppppppp
cc    print'(" sid = """,A,"""")', sid
cpppppppppp
         if(sid.eq.'        ')  sid = 'TAMDAR-M'
cxxxx

C  GET TURBULENCE INDEX FOR LATER STORAGE INTO DATA LEVEL CATEGORY 8
C  -----------------------------------------------------------------

         CALL UFBINT(LUNIT,TRBX_8(5),1,1,IRET,'TRBX');TRBX(5)=TRBX_8(5)

C  GET ROLL ANGLE FLAG FOR LATER STORAGE INTO DATA LEVEL CATEGORY 8
C  ----------------------------------------------------------------

         CALL UFBINT(LUNIT,ROLF_8,1,1,IRET,'ROLF');ROLF=ROLF_8

      ELSE IF(SUBSET.EQ.'NC004001'.OR.SUBSET.EQ.'NC004002') THEN
 
C  -----------------------------------------------
C  AIREP OR PIREP FORMAT AIRCRAFT TYPES COME HERE
C  -----------------------------------------------

C  MAY POSSIBLY NEED TO MODIFY THE RPID HERE
C  (for later tests in prepacqc program)
C  -----------------------------------------

cdak no more!IF(SID(6:6).EQ.'Z')  SID(6:6) = 'X'
         IF(SID.EQ.'A       '.OR.SID.EQ.'        '.OR.SID(1:3).EQ.'ARP'
     $    .OR.SID(1:3).EQ.'ARS')  SID = 'AIRCFT  '

cvvvvv temporary?
C  Determined that Hickum AFB reports are much like AFWA - they have
C   problems!  They also are usually duplicates of either AFWA or
C   non-AFWA reports.  Apparently the old front-end processing filtered
C   them out (according to B. Ballish).  So, to make things match, we
C   will do the same here.
C   ACTUALLY, JEFF ATOR HAS REMOVED THESE FROM THE DECODER, SO WE
C    SHOULD NEVER EVEN SEE THEM IN THE DATABASE, but it won't hurt
C    anything to keep this in here.
C   (NOTE: These all have bulletin originator "PHWR".)

         if(CBULLX(8:11).eq.'PHWR')  then
cpppppppppp
cc    print'(" IW3UNPBF/R05UBF: TOSS ""PHWR"" AIREP FORMAT with ID = ",
cc   $ A,"; CBORG = ",A)', SID,CBULLX(8:11)
cpppppppppp
            R05UBF = -9999
            kskacf(8) = kskacf(8) + 1
            return
         end if
caaaaa temporary?

cvvvvv temporary?
C        1) AFWA converts ASDAR/ACARS reports originally in AMDAR
C      format into AIREP format.  Nearly all of them are duplicated as
C      ASDAR/ACARS in true AMDAR format.  The earlier version of the
C      aircraft dup-checker could not remove such duplicates; the new
C      verison now in operations can remove these. SO, WE HAVE
C      COMMENTED THIS OUT.
C
C      These disguised reports can be identified by the string
C      " Sxyz" in the raw report (beyond byte 40), where y is 0,1, or 2.
C      (NOTE: Apparently AFWA here applies to more bulletin originators
C             than just "KAWN", so report header is not even checked.)

C        2) AFWA also converts MDCRS ACARS reports into AIREP format.
C      These MAY duplicate true reports in the MDCRS ACARS subtype.
C      The NAS9000 decoder always excluded this type (no dup-checking
C      was done).  All of these will be removed here. These disguised
C      reports can be identified by the string " Sxyz" in the raw
C      report (beyond byte 40), where y is 3 or greater.
C      (NOTE: Apparently AFWA here applies to more bulletin originators
C             than just "KAWN", so report header is not even checked.)

         crawrx = ' '
         crawr = ' '
         call ufbint(lunit,raw_8,1,255,nlev,'RRSTG')
cppppp
cc       print *, 'this report''s RRSTG has nlev = ',nlev
cc       ni = -7
cc       do mm = 1,nlev
cc          ni = ni + 8
cc          crawrx(ni:ni+7) = craw(mm)
cc          if(ni+8.gt.500.and.mm.lt.nlev)  print *, 'ni+8.gt.500'
cc          if(ni+8.gt.500)  exit
cc       enddo
cc       print *, 'BULLETIN:      "',crawrx(1:ni+7),'"'
cppppp
         if(nlev.gt.5)  then
            ni = -7
            do mm = 6,nlev
               ni = ni + 8
               crawr(ni:ni+7) = craw(mm)
cppppp
cc             if(ni+8.gt.80.and.mm.lt.nlev)  print *, 'ni+8.gt.80'
cppppp
               if(ni+8.gt.80)  exit
            enddo
cppppp
cc          print *, 'BULLETIN(41-): "                              ',
cc   $       '          ',crawr(1:ni+7),'"'
cppppp
            do mm = 1,ni+7
               if(crawr(mm:mm+1).eq.' S')  then
                  if((crawr(mm+2:mm+2).ge.'0'.and.crawr(mm+2:mm+2).le.
     $             '9').or.crawr(mm+2:mm+2).eq.'/')  then
                     if((crawr(mm+3:mm+3).ge.'0'.and.crawr(mm+3:mm+3)
     $                .le.'9').or.crawr(mm+3:mm+3).eq.'/')  then
                        if((crawr(mm+4:mm+4).ge.'0'.and.
     $                   crawr(mm+4:mm+4).le.'9').or.crawr(mm+4:mm+4)
     $                   .eq.'/')  then
cpppppppppp
cc    print'(" IW3UNPBF/R05UBF: For ",A,", raw_8(",I0,") = ",G0)',
cc   $ SID,ni+7,crawr(1:ni+7)
cpppppppppp
                           if(crawr(mm+3:mm+3).lt.'3')  then

C  THIS IS AN AMDAR FORMAT ASDAR/ACARS REPORT DISGUISED AS AN AIREP
C   FORMAT REPORT BY AFWA --> THROW OUT
C   (NOT ANYMORE, DUP-CHECKER IS HANDLING THESE OKAY NOW)
C  ----------------------------------------------------------------

cpppppppppp
cc    print'(" IW3UNPBF/R05UBF: Found a AFWA AMDAR in AIREP format ",
cc   $ "for ",A,"; CBORG = ",A)', SID,CBULLX(8:11)
cpppppppppp
cdak  R05UBF = -9999
cdak  KSKACF(3) = KSKACF(3) + 1
cdak  RETURN
                           else

C  THIS IS A MDCRS ACARS REPORT DISGUISED AS AN AIREP FORMAT REPORT
C   BY AFWA --> THROW OUT
C  ----------------------------------------------------------------

cpppppppppp
cc    print'(" IW3UNPBF/R05UBF: Found a AFWA ACARS in AIREP format ",
cc   $ "for ",A,"; CBORG = ",A)', SID,CBULLX(8:11)
cpppppppppp
      R05UBF = -9999
      KSKACF(4) = KSKACF(4) + 1
      RETURN

                           end if
                        end if
                     end if
                  end if
               end if
               if(mm+5.gt.ni+7)  exit
            enddo
         END IF
caaaaa temporary?

C  AFWA INDICATOR STORED IN BYTE 1 OF HEADER RESERVE CHARACTER WORD 2
C   (NOTE: NAS9000 ONLY ASSIGNED BULLETIN ORIGINATOR "KAWN" AS AFWA,
C          ALTHOUGH BULLETIN ORIGINATORS "PHWR" AND "EGWR" ARE
C          APPARENTLY ALSO AFWA)
C  ------------------------------------------------------------------

         IF(CBULLX(8:11).EQ.'KAWN')  RSV2(1:1) = 'C'

      END IF
 
      IF(SUBSET.EQ.'NC004003'.OR.SUBSET.EQ.'NC004004'.OR.SUBSET.EQ.
     $ 'NC004006'.OR.SUBSET.EQ.'NC004009'.OR.SUBSET.EQ.'NC004011'.OR.
     $ SUBSET.EQ.'NC004103'.OR.SUBSET.EQ.'NC004010') THEN

C  -----------------------------------------------------------------
C  AMDAR FORMAT, MDCRS ACARS, E-AMDAR, CANADIAN AMDAR, KOREAN AMDAR,
C   CATCH-ALL AMDAR OR TAMDARB AIRCRAFT TYPES COME HERE
C  -----------------------------------------------------------------

C  GET PRECISION OF TEMPERATURE OBSERVATION FOR LATER STORAGE
C   INTO DATA LEVEL CATEGORY 8
C  ----------------------------------------------------------

         CALL UFBINT(LUNIT,UFBINT_8,1,1,IRET,'PCAT');PCT=UFBINT_8

C  GET PHASE OF FLIGHT FOR LATER STORAGE INTO DATA LEVEL CAT. 8
C  ------------------------------------------------------------

         CALL UFBINT(LUNIT,UFBINT_8,1,1,IRET,'DPOF')
         if(ibfms(ufbint_8).eq.0) then
C  Translate DPOF values into POAF values
           if(int(ufbint_8).ge.7.and.int(ufbint_8).le.10) then
             ufbint_8 = 5.
           else if(int(ufbint_8).ge.11.and.int(ufbint_8).le.14) then
             ufbint_8 = 6.
           end if
           pof=ufbint_8
         else
           CALL UFBINT(LUNIT,UFBINT_8,1,1,IRET,'POAF');POF=UFBINT_8
         endif

      END IF

C  ------------------------------
C  ALL AIRCRAFT TYPES COME HERE
C  ------------------------------

C  PUT THE LEVEL DATA INTO SPECIFIED UNPACKED FORMAT
C  -------------------------------------------------
 
      CALL UFBINT(LUNIT,ARR_8,10,255,NLEV,LVSTR);ARR=ARR_8

      if(nlev.gt.0) then
      DO L=1,NLEV

         POB(L) = BMISS
         IF(ARR(1,L).LT.BMISS)  POB(L) =  NINT(ARR(1,L)*.1)

         TOB(L) = BMISS
         QOB(L) = BMISS
         IF(SUBSET.EQ.'NC004010') THEN
          IF(ARR(3,L).GE.BMISS)  THEN
          CALL UFBINT(LUNIT,UFBINT_8,1,1,IRET,'TMDBST')
          ARR(3,L)=UFBINT_8
          END IF
          IF(ARR(2,L).GE.BMISS.AND.ARR(6,L).GE.BMISS) THEN
          CALL UFBINT(LUNIT,UFBINT_8,1,1,IRET,'RAWHU')
          ARR(6,L)=UFBINT_8
          END IF
         ENDIF
         IF(ARR(3,L).LT.BMISS)  THEN
            ITMP = NINT(ARR(3,L)*100.)
            TOB(L) = NINT((ITMP-27315)*0.1)
            IF(OBS2(42).EQ.0.OR.(SUBSET.EQ.'NC004008'.OR.
     $                           SUBSET.EQ.'NC004012'.OR.
     $                           SUBSET.EQ.'NC004013'.OR.
     $                           SUBSET.EQ.'NC004006'.OR.
     $                           SUBSET.EQ.'NC004103'.OR.
     $                           SUBSET.EQ.'NC004010')) THEN

C  Process moisture (if present) if MADIS/TAMDAR (all types),
C   Panasonic(AirDAT)/TAMDAR, E-AMDAR, Catch-all AMDAR or MDCRS (but
C   for MDCRS only if MTSQ is zero)
C dak-- is this still the case, is MTSQ=0 for all MDCRS with valid
C       moisture even in v7 BUFR??!!)
C  ----------------------------------------------------------------

C  All data level category 6 rpts store specific humidity (g/kg) as
C   moisture variable
C  ----------------------------------------------------------------

C  If pressure is not reported, calculate it here via U.S. Std. Atmos.
C   Est. solely for the purpose for calculating Td to gross check the
C   moisture if it is reported (this pressure will not be considered
C   as a reported pressure - the reported pressure will remain missing)
C  --------------------------------------------------------------------

               if(pob(l).ge.bmiss) then
                 if(nint(elev).le.11000) then
                   p = pr(elev)
                 else
                   p = prs(elev)
                 end if
               else
                   p = pob(l)*0.1
               end if
               QQ = -99999.
               mtyp_q = 1
               IF(SUBSET.EQ.'NC004004')  THEN

C  From 10/1/2006 through 10/31/2006, inclusive, and on 10/2/2007,
C   MDCRS ACARS MIXR may or may not have been scaled incorrectly by
C   ARINC - set to missing
C  ----------------------------------------------------------------

                  IF((IDATEB.GE.2006100100.AND.IDATEB.LE.2006103123)
     $         .OR.  (IDATEB.GE.2007100200.AND.IDATEB.LE.2007100223))
     $             ARR(2,L) = BMISS
               END IF
               IF(ARR(2,L).LT.BMISS)  THEN
                  IF(SUBSET.EQ.'NC004004')  THEN

C  From 11/1/2006 through 10/1/2007, inclusive, MDCRS ACARS MIXR was
C   scaled incorrectly by ARINC (10 times too large), compensate for
C   this error by dividing reported MIXR by 10
C  -----------------------------------------------------------------

                     IF(IDATEB.GE.2006110100.AND.
     $                  IDATEB.LE.2007100123) ARR(2,L) = ARR(2,L)*0.1
                  END IF
                  QQ = ARR(2,L)/(1.0 + ARR(2,L))
               ELSE  IF(ARR(6,L).LT.BMISS)  THEN
                  QQSAT = QFRMTP(ARR(3,L),P)
                  QQ = (ARR(6,L) * 0.01) * QQSAT
                  mtyp_q = 0
               END IF
               IF(QQ.GT.0.0)  THEN
                  TD = TFRMQP(QQ,P)
                  IF(NINT(TD*10.).LE.NINT(ARR(3,L)*10.))  THEN
                     QOB(L) = QQ * 1000.
                     if(mtyp_q.eq.1)  then
                       if(subset.ne.'NC004004'.and.
     $                    subset.ne.'NC004006')
     $ print'(" ^^^^^ valid aircraft mixing ratio ",G0," kg/kg stored ",
     $ "as spec. humidity ",G0," g/kg - id ",A)', arr(2,L),qob(L),sid
                     else
                        if(subset.ne.'NC004010')
     $ print'(" ^^^^^ valid aircraft relative humidity ",G0," % stored",
     $ " as spec. humidity ",G0," g/kg - id ",A)', arr(6,L),qob(L),sid
                     end if
                  else
                     if(mtyp_q.eq.1)  then
      print'(" ^^^^^ INVALID aircraft mixing ratio ",G0," kg/kg - ",
     $ "spec. humidity set to missing - id ",A)', arr(2,L),sid
                     else
      print'(" ^^^^^ INVALID aircraft relative humidity ",G0," % - ",
     $ "spec. humidity set to missing - id ",A)', arr(6,L),sid
                     end if
                  END IF
               END IF
            END IF
         END IF

         ZOB(L) = ELEV
         DOB(L) = ARR(4,L)
         SOB(L) = MIN(ARR(5,L)*10.,BMISS)
      ENDDO
      end if

      CALL UFBINT(LUNIT,ARR_8,10,255,NLEV,QMSTR);ARR=ARR_8

C  -----------------------------------------------------------------
C  ALL AIRCRAFT TYPES COME HERE FOR QUALITY MARK ASSIGNMENT
C  -----------------------------------------------------------------
 
      if(nlev.gt.0) then
      DO L=1,NLEV
         PQM(L) = EQMUBF(ARR(1,L))
         TQM(L) = EQMUBF(ARR(2,L))
         QQM(L) = EQMUBF(ARR(3,L))
         ZQM(L) = EQMUBF(ARR(4,L))
         WQM(L) = EQMUBF(ARR(5,L))
      ENDDO
      end if

      IF(SUBSET.EQ.'NC004008'.OR.SUBSET.EQ.'NC004012'.OR.
     $   SUBSET.EQ.'NC004013') THEN

C  MADIS qual. markers for MADIS/TAMDAR (HONOR ALL BUT QM=2 FROM ABOVE)
C  --------------------------------------------------------------------

         CALL UFBREP(LUNIT,RTAM_8,2,1,IRET,'PRLC QCD')
         RQCD_8 = RTAM_8(2)
cdak     print'(" MADIS PRLC  QM is ",A)', QCD
         IF(PQM(1).EQ.2.AND.IBFMS(RTAM_8(1)).EQ.0)  PQM(1) = MQMUBF(QCD)
         CALL UFBREP(LUNIT,RTAM_8,2,1,IRET,'TMDB QCD')
         RQCD_8 = RTAM_8(2)
cdak     print'(" MADIS TMDB  QM is ",A)', QCD
         IF(TQM(1).EQ.2.AND.IBFMS(RTAM_8(1)).EQ.0)  TQM(1) = MQMUBF(QCD)
         CALL UFBREP(LUNIT,RTAM_8,2,1,IRET,'REHU QCD')
         RQCD_8 = RTAM_8(2)
cdak     print'(" MADIS REHU  QM is ",A)', QCD
         IF(QQM(1).EQ.2.AND.IBFMS(RTAM_8(1)).EQ.0)  QQM(1) = MQMUBF(QCD)
         CALL UFBREP(LUNIT,RTAM_8,2,1,IRET,'WDIR QCD')
         RQCD_8 = RTAM_8(2)
cdak     print'(" MADIS WDIR  QM is ",A)', QCD
         QWD = MQMUBF(QCD)  ! wind direction
         RTAM_WDIR_8=RTAM_8(1)
         CALL UFBREP(LUNIT,RTAM_8,2,1,IRET,'WSPD QCD')
         RQCD_8 = RTAM_8(2)
cdak     print'(" MADIS WSPD  QM is ",A)', QCD
         QWS = MQMUBF(QCD)  ! wind speed
         AMAXIMUM_8 = MAX(RTAM_WDIR_8,RTAM_8(1))
         IF(WQM(1).EQ.2.AND.IBFMS(AMAXIMUM_8).EQ.0) WQM(1) =MAX(QWD,QWS)
         CALL UFBREP(LUNIT,RTAM_8,2,1,IRET,'TRBX QCD')
         RQCD_8 = RTAM_8(2)
cdak     print'(" MADIS TRBX  QM is ",A)', QCD
         QTRBX = MQMUBF(QCD)  ! turbulence index

      else if(subset.eq.'NC004010') then

C  Quality markers for BUFR TAMDAR (2015 onward; assign QMs based on
C  the information from QMRKH/PCCF fields) (honor all but QM=2 from
C   just above)
C    transformation of TAMDAR QMRKH into PREPBUFR QM:
C              QMRKH           0   1   2   3    > 3 up to missing
C              --------------------------------------------------
C             (T/W)QM          2   3   3  13           13
C  -----------------------------------------------------------------

         CALL UFBREP(LUNIT,RTAMB_8,1,7,IRET,'QMRKH')
CCC    print'(" RTAMB_8: ",4(1X,F7.2))',
CCC  & RTAMB_8(1), RTAMB_8(2), RTAMB_8(3), RTAMB_8(4)
!      Order of QMRKH array representation:
!  N = 1     2       3     4     5       6       7
!      SMMO, TMDBST, WDIR, WSPD, TRBXST, TOPEDR, AFIC
Cfuture call ufbint(lunit,ufbint_8,1,1,iret,'SMMO')
Cfuture if(ibfms(ufbint_8).eq.0) then
Cfuture   print'(" SMMO   (not stored) is ",g0)', ufbint_8
Cfuture   print'(" SMMO   QMRKH is ",g0)', rtamb_8(1)
Cfuture end if
         DO N = 2,4
          RQCD_8 = 0.0
          IF(RTAMB_8(N).GE.3.0) THEN
           RQCD_8 = 13.0
          ELSE
           IF (RTAMB_8(N).GE.1.0) RQCD_8 = 3.0
           IF (RTAMB_8(N).EQ.0.0) RQCD_8 = 2.0
          ENDIF
          IF((N.EQ.2).AND.(TOB(1).LT.BMISS).AND.(TQM(1).EQ.2))
     &     TQM(1)=RQCD_8 ! T quality information
          IF((DOB(1).LT.BMISS).AND.(SOB(1).LT.BMISS).AND.(WQM(1).EQ.2))
     &    THEN
           IF(N.EQ.3) RTAM_WDIR_8=RQCD_8 ! WD quality
           IF(N.EQ.4) WQM(1)=MAX(RTAM_WDIR_8,RQCD_8) ! Total wind quality
          ENDIF
         ENDDO
CCC      print'(" TQM WQM ",2(1X,F7.2))', TQM(1), WQM(1)
         call UFBINT(LUNIT,RQCD_8,1,1,IRET,'PCCF')
!        PCCF = percent confidence of RH quality
         IF((QOB(1).LT.BMISS).AND.(QQM(1).EQ.2)) THEN
! Always set QQM to 13 if TQM was set to 13 above (regardless of PCCF)
         IF((RQCD_8.LT.80.0).OR.(RQCD_8.GT.100.0)
     &      .OR.(TQM(1).EQ.13.0)) THEN
          QQM(1) = 13.0
         ELSE
          QQM(1) = 2.0
         ENDIF
         ENDIF
CCC      print'(" REHU  PCCF, QM ",2(1X,F5.1))', RQCD_8, QQM(1)

      END IF

      IF(SUBSET.NE.'NC004004' .and. SUBSET.NE.'NC004010') THEN

C  -------------------------------------------------------------------
C  ALL AIRCRAFT TYPES EXCEPT MDCRS ACARS AND PANASONIC (AirDAT) TAMDAR
C   ALSO HAVE SPECIAL CASE:
C     IF PURGE FLAG ON WIND (14), TEMP Q.M. ALSO GETS PURGE FLAG (14)
C      (this is needed by PREPOBS_PREPACQC program)
C      (note: This should be moved to prepdata)
C  -------------------------------------------------------------------
 
         if(nlev.gt.0) then
         DO L=1,NLEV
            IF(WQM(L).EQ.14)  TQM(L) = 14
         ENDDO
         end if

      END IF
 
C  PUT THE UNPACKED REPORT INTO OBS
C  --------------------------------
 
      CALL S01UBF(SID,XOB,YOB,RHR,RCTIM,RSV1,RSV2,ELV,QMELV,ITP,RTP,
     $ RSTP,IDS)
      CALL S02UBF(6,1,*9999)
 
C  ------------------------------------------------------------------
C  MISC DATA GOES INTO DATA LEVEL CATEGORY 08
C  ------------------------------------------------------------------
C  CODE FIGURE 021 - REPORT SEQUENCE NUMBER
C                     (CURRENTLY ONLY FOR MDCRS ACARS)
C  CODE FIGURE 914 - PHASE OF FLIGHT
C                     (CURRENTLY ONLY FOR AMDAR FORMAT, MDCRS ACARS,
C                      E-AMDAR OR CANADIAN AMDAR) (BUFR C. TBL 0-08-004)
C  CODE FIGURE 915 - PRECISION OF TEMPERATURE OBSERVATION IN
C                      0.01*DEG. K
C                     (CURRENTLY ONLY FOR AMDAR FORMAT, MDCRS ACARS,
C                      E-AMDAR OR CANADIAN AMDAR) (BUFR C. TBL 0-02-005)
C  CODE FIGURE 926 - MDCRS ACARS TURBULENCE INDEX FOR PERIOD T-1 MINUTE
C                     TO T-0 MINUTES (BUFR CODE TABLE 0-11-236)
C  CODE FIGURE 927 - MDCRS ACARS TURBULENCE INDEX FOR PERIOD T-2 MINUTE
C                     TO T-1 MINUTES (BUFR CODE TABLE 0-11-237)
C  CODE FIGURE 928 - MDCRS ACARS TURBULENCE INDEX FOR PERIOD T-3 MINUTE
C                     TO T-2 MINUTES (BUFR CODE TABLE 0-11-238)
C  CODE FIGURE 929 - MDCRS ACARS TURBULENCE INDEX FOR PERIOD T-4 MINUTE
C                     TO T-3 MINUTES (BUFR CODE TABLE 0-11-239)
C  CODE FIGURE 930 - TAMDAR TURBULENCE INDEX (BUFR CODE TABLE 0-11-239)
C                     INDICATOR 2 CONTAINS TURBULENCE INDEX QUALITY
C                     MARKER (0-15)
C  CODE FIGURE 931 - TAMDAR ROLL ANGLE FLAG (BUFR CODE TABLE 0-02-199)
C  CODE FIGURE 932 - INSTANTANEOUS ALTITUDE RATE IN .001*METERS/SECOND
C  ------------------------------------------------------------------

      IF(SUBSET.EQ.'NC004004') THEN
         OB8(1) = KNDX
         CF8(1) = 21
         Q81(1) = IMISS
         Q82(1) = IMISS
         CALL S02UBF(8,1,*9999)
      END IF
      IF(PCT.LT.BMISS) THEN
         OB8(1) = NINT(PCT*100.)
         CF8(1) = 915
         Q81(1) = IMISS
         Q82(1) = IMISS
         CALL S02UBF(8,1,*9999)
      END IF
      IF(POF.LT.BMISS) THEN
         OB8(1) = NINT(POF)
         CF8(1) = 914
         Q81(1) = IMISS
         Q82(1) = IMISS
         CALL S02UBF(8,1,*9999)
      END IF
      DO I = 1,5
         IF(TRBX(I).LT.BMISS) THEN
            OB8(1) = NINT(TRBX(I))
            CF8(1) = 925 + I
            Q81(1) = IMISS
            Q82(1) = IMISS
            IF(I.EQ.5)  Q82(1) = QTRBX
            CALL S02UBF(8,1,*9999)
         END IF
      ENDDO
      IF(ROLF.LT.BMISS) THEN
         OB8(1) = NINT(ROLF)
         CF8(1) = 931
         Q81(1) = IMISS
         Q82(1) = IMISS
         CALL S02UBF(8,1,*9999)
      END IF
      IF(RIALR.LT.BMISS) THEN
         OB8(1) = NINT(RIALR*1000)
         CF8(1) = 932
         Q81(1) = IMISS
         Q82(1) = IMISS
         CALL S02UBF(8,1,*9999)
      END IF

      CALL S03UBF(OBS,SUBSET,*9999,*9998,*9997)
 
      RETURN

 9999 CONTINUE
      R05UBF = 999
      RETURN

 9998 CONTINUE
      print'(" IW3UNPBF/R05UBF: RPT with ID= ",A," TOSSED - ZERO ",
     $ "CAT.1-6,51 LVLS")', SID
 9997 CONTINUE
      R05UBF = -9999
      KSKACF(1) = KSKACF(1) + 1
      RETURN

      END
C***********************************************************************
C***********************************************************************
C***********************************************************************
      FUNCTION R06UBF(LUNIT,OBS,OBS2,OBS3,NOBS3,obs8_8)
C     ---> PROCESSES SATWIND DATA (005/*)
 
      COMMON/IUBFAA/BMISS
      COMMON/IUBFBB/KNDX,KSKACF(8),KSKUPA,KSKSFC,KSKSAT,KFLSAT(12),
     $ KSKSMI
      COMMON/IUBFCC/SUBSET
      COMMON/IUBFEE/POB(255),QOB(255),TOB(255),ZOB(255),DOB(255),
     $              SOB(255),VSG(255),OB8(255),CF8(255)
      COMMON/IUBFFF/PQM(255),QQM(255),TQM(255),ZQM(255),WQM(255)
      COMMON/IUBFKK/KOUNT(499,18,2),KNTSAT(250:260),KNTMODIS(783:785),
     $ KNTavhrr(3:224),KNTviirs(224:225),IFLSAT,knts16(270:274)
      COMMON/IUBFLL/Q81(255),Q82(255)
 
      CHARACTER*80 HDSTR,HDSTR2,LVSTR,QMSTR,RCSTR
      CHARACTER*8  SUBSET,SID,RSV1,RSV2
      CHARACTER*1  CSAT(499),CPROD(0:4),CPRDF(0:2),CPRDFN(51),C8(10)
      INTEGER      IPRDF(0:2),ISWCM(5,9:10,2),ITP_C8(10),ISWDL(7)
      REAL(8) RID_8,UFBINT_8,PCCF_8(2,12),GNAP_8(12),HDR_8(20),RCT_8(5),
     $ ARR_8(10),OBS2_8(43),OBS3_8(5,255,7),WIND_8(2,5),PRLC_8(11),
     $ QFGU_8(8),BMISS,obs8_8(2)
      DIMENSION    OBS(*),OBS2(43),OBS3(5,255,7),NOBS3(7),HDR(20),
     $ RCT(5),ARR(10),PCCF(2,12),GNAP(12),WIND(2,5),PRLC(11),QFGU(8)
      EQUIVALENCE  (RID_8,SID)

      SAVE

      DATA HDSTR/'RPID CLON CLAT HOUR MINU SAID               '/
      DATA HDSTR2/'RPID CLONH CLATH HOUR MINU SAID            '/
      DATA LVSTR/'TMDP TMDB CCST                              '/
      DATA RCSTR/'RCHR RCMI RCTS                              '/
      DATA IMISS/99999/,XMISS/99999./

C=======================================================================
C Note: CSAT, CPROD, CPRDF, CPRDFN, IPRDF and ISWCM below are valid
C       only for input data dump files prior to Dec 2000 where report
C       id has not yet been constructed (these no longer need to be
C       updated for new satellites, etc. - after Dec 2000 this is
C       handled in BUFR_DUPSAT)
C       (Note 1: GOES-16 & up do not construct a report id - it is
C                hardwired to "--------")
C=======================================================================

      DATA CSAT
C                           **  vestage from old days **
C ---------------  1    2    3    4
     $           /'A', 'B', 'C', 'D',

C --------------- spares (5-49)
     $            45*'?',
C                           **  Meteosat  **
C ---------------  50   51   52   53   54   55   56   57   58   59
     $            'Z', 'W', 'X', 'Y', 'Z', 'W', 'X', 'Y', 'Z', 'W',
C ---------------  spares (60-98)    99   spares (100-149)
     $            39*  '?',         'X', 50*  '?',
C                              **  GMS **
C --------------- 150  151  152  153  154  155  156  157  158  159
     $            'R', 'O', 'P', 'Q', 'R', 'O', 'P', 'Q', 'R', 'O',
C                             **  MTSAT **
C ---------------  spares (160-170)   171   spares (172-198)   199
     $            11*  '?',           'Q', 27*  '?',           'Q',
C --------------- spares (200-249)
     $            50*'?',
C                              **  GOES **
C --------------- 250 251 252 253 254 255 256 257 258
     $            'D','A','B','C','D','A','B','C','D',

C --------------- spares (259-439)
     $            181*'?',
C                             **  Kalpana **
C --------------- 440
     $            'K',

C --------------- spares (441-469)
     $            29*'?',
C                             **  Insat **
C --------------- 470   spares (471-498) 499
     $            'V', 28*  '?',         'V'/

      DATA CPROD /'C','D','?','?','E'/
      DATA CPRDF /'V','C','B'/
      DATA CPRDFN/'C','C','V','C','I','W','?','Z','P','I','W','Z','P',
     $ 'T','I','W','V','T',31*'?','C','V'/
      DATA IPRDF / 4 , 1 , 6 /
C                   **  High-Density Imager (+ low-dens. p. triplet)  **
      DATA ISWCM / 16, 17, 18,  3, 18,
C                   **  High-Density Sounder  **
     $             99, 99, 14, 99, 14,
C                   **  Low-Density Imager  **
     $              1,  6,  4, 99,  4,
C                   **  Low-Density Sounder  **
     $             99, 99, 99, 99, 99/

C=======================================================================
C Note: C8 and ITP_C8 below are valid only for input data dump files
C       after Dec 2000 where report id has already beeen contructed by
C       BUFR_DUPSAT
C=======================================================================

C  C8 is eighth character in report id, it determines instrument/
C  product type (ITP_C8 later stored into ITP) for all producers and is
C  defined a bit further below

      DATA      C8/'C','P','V','B','T','L','I','Z','W','S'/
      DATA  ITP_C8/ 1 , 3 , 4 , 6 ,14 ,15, 16, 17, 18, 19/

C=======================================================================
C Note: ISWDL below is valid for all input data dump files regardless
C       of their date (Note: it is not used for GOES-16 & up)
C=======================================================================

      DATA ISWDL / ! cloud top/deep-layer indicator for winds generated
                   ! by NESDIS or NASA (meaning defined a bit further
                   ! below)

C -> Wind type:
C         IR(LW,SW)  VISIBLE   WV-CLTOP  PTRIPLET  WV-DPLYR  N/A
C         ---------  --------  --------  --------  --------  ---
     $          2 ,       2 ,       2 ,    99999,       1 ,  2* 99999 /


C=======================================================================
C Note: IPRD16 below is valid only for GOES-16 & up satellite wind
C       reports
C=======================================================================
      integer iprd16(30:39)
      data iprd16 /16,18,17,99999,18,4*99999,19/


C=======================================================================

      HGTF(P) = (1.-(P/1013.25)**(1./5.256))*(288.15/.0065)

C  FCNS BELOW CONVERT TEMP/TD(K) & PRESS(MB) INTO SAT./SPEC. HUM.(KG/KG)
C  ---------------------------------------------------------------------

      ES(T) = 6.1078 * EXP((17.269 * (T - 273.16))/((T - 273.16)+237.3))
      QFRMTP(T,P) = (0.622 * ES(T))/(P - (0.378 * ES(T)))

      R06UBF = 0

C  STORE SINGLE LEVEL REPORT DATA DIRECTLY INTO OBS2 ARRAY AND
C   DOUBLE-PRECISION SINGLE LEVEL REPORT DATA DIRECTLY INTO OBS8_8 ARRAY
C  ---------------------------------------------------------------------

      OBS2_8 = BMISS
      obs8_8 = bmiss
      CALL UFBINT(LUNIT,OBS2_8,2,1,IRET,'RSRD EXPRSRD')
      CALL UFBINT(LUNIT,OBS2_8(43),1,1,IRET,'SAZA')
      OBS2 = OBS2_8

      IFLSAT = 1
 
      CALL S05UBF
 
C  PUT THE HEADER INFORMATION INTO UNPACKED FORMAT
C  -----------------------------------------------
 
      if(subset(6:7).eq.'03')  then

C  GOES-16 & up (in subsets NC00503x) do not construct a report id and
C   they have high-res lat/lon
C  -------------------------------------------------------------------
         call ufbint(lunit,hdr_8,20,1,iret,
     $              'NUL CLONH CLATH HOUR MINU SAID');hdr(2:)=hdr_8(2:)
      else if(subset(7:8).eq.'67'.or.subset(7:8).eq.'68'.or.
     $        subset(7:8).eq.'69') then
         CALL UFBINT(LUNIT,HDR_8,20,1,IRET,HDSTR2);HDR(2:)=HDR_8(2:)
      else
         CALL UFBINT(LUNIT,HDR_8,20,1,IRET,HDSTR);HDR(2:)=HDR_8(2:)
      end if

      CALL UFBINT(LUNIT,RCT_8, 5,1,NRCT,RCSTR);RCT=RCT_8
      obs8_8(1) = hdr_8(3)
      obs8_8(2) = hdr_8(2)
      IF(HDR(5).GE.BMISS) HDR(5) = 0
      RCTIM = NINT(RCT(1))+NINT(RCT(2))/60.
      RID_8 = HDR_8(1)
      XOB   = HDR(2)
      YOB   = HDR(3)
      RHR   = BMISS
      IF(HDR(4).LT.BMISS)  RHR = NINT(HDR(4))+NINT(HDR(5))/60.
      RSV1  = '        '
      RSV2  = '        '
      IDS   = IMISS
      IF(HDR(6).LT.BMISS)  IDS = NINT(HDR(6))

C  SATWIND PRODUCER INDICATOR STORED IN BYTE 1 OF HEADER RESERVE
C   CHARACTER WORD 1
C  -------------------------------------------------------------
C   = 1 - USA/NOAA/NESDIS
C   = 4 - USA/NOAA.NWS
C   = 5 - USA/UNIVERSITY
C   = 6 - USA/COMMERCIAL
C   = 7 - USA/DOD/NAVY
C   = 8 - USA/DOD/USAF
C   = 9 - USA/NASA
C   =12 - ESA/METEOSAT
C   =13 - GMS/MSC
C   =14 - INDIA/INSAT


C  CLOUD TOP/DEEP LAYER INDICATOR STORED IN BYTE 3 OF HEADER RESERVE
C   CHARACTER WORD 1
C  ------------------------------------------------------------------
C   = 1 - DEEP LAYER
C   = 2 - CLOUD TOP (NORMAL CLOUD DRIFT)
C   = 9 - INDICATOR MISSING (REVERTS TO DEFAULT CLOUD TOP)

C  THE INSTRUMENT TYPE INDICATES THE PRODUCT TYPE
C  ----------------------------------------------
C   = 1 - IR (LONG-WAVE) AUTOMATED WINDS (LOW DENSITY)
C   = 2 - IR (LONG-WAVE) MANUAL WINDS
C   = 3 - PICTURE TRIPLET (LOW DENSITY)
C   = 4 - WATER VAPOR AUTOMATED (LOW DENSITY)
C   = 5 - VISIBLE MANUAL
C   = 6 - VISIBLE AUTOMATED (LOW DENSITY)
C   = 7 - GRADIENT WINDS
C   = 8 - PICTURE PAIR;
C   =10 - AMSU/SSMI MICROWAVE WINDS
C   =11 - SCATTEROMETER
C   =12 - ALTIMETER
C   =13 - LAWS
C   =14 - HIGH-DENSITY WATER VAPOR SOUNDER, CHN. 10
C   =15 - HIGH-DENSITY WATER VAPOR SOUNDER, CHN. 11
C   =16 - HIGH-DENSITY IR (LONG-WAVE) IMAGER AUTOMATED WINDS
C   =17 - HIGH-DENSITY VISIBLE IMAGER AUTOMATED WINDS
C   =18 - HIGH-DENSITY WATER VAPOR IMAGER
C   =19 - HIGH-DENSITY IR (SHORT-WAVE) IMAGER AUTOMATED WINDS


      ITP = IMISS

      if(subset(6:7).eq.'03')  then

C***********************************************************************
C  GOES-16 & up (in subsets NC00503x) (which do not construct a report
C   id) store instrument (product) type as well as cloud top/deep layer
C   indicator based on last 2 digits of subset; satwind producer
C   indicator is hardwired as "1" (USA/NOAA/NESDIS);  report id is
C   hardwired as "--------" since it does not exist
C***********************************************************************

         rsv1(1:1) = "1"
         rsv1(3:3) = "2"
         sid = "--------"
         read(subset(7:8),'(I2)') isubset78
         itp = iprd16(isubset78)
         if(subset(7:8).eq.'31') rsv1(3:3) = "1"

      ELSE IF(SID(8:8).LT.'A'.OR.SID(8:8).GT.'Z')  THEN

C***********************************************************************
C  IF THE EIGHTH CHARACTER OF THE INPUT STN. ID IS NOT "A" - "Z", THEN
C              THIS SUBROUTINE MUST CREATE THE STN. ID.
C       (INDICATES AN INPUT DATA DUMP FILE PRIOR TO DEC. 2000)
C***********************************************************************

C    REPROCESSED CHAR 1 -----> GOES:     SAT. NO. 247,251,255   GET 'A'
C                                        SAT. NO. 248,252,256   GET 'B'
C                                        SAT. NO. 249,253,257   GET 'C'
C                                        SAT. NO. 250,254,258   GET 'D'
C                                        (Note: Sat. No. 253 gets 'P'
C                                               if producer is JMA)
C                       -----> METEOSAT: SAT. NO.  52, 56       GET 'X'
C                                        SAT. NO.  53, 57       GET 'Y'
C                                        SAT. NO.  50, 54, 58   GET 'Z'
C                                        SAT. NO.  51, 55, 59   GET 'W'
C                                        SAT. NO.  99 (UNKNOWN) GET 'X'
C                       -----> GMS(JA):  SAT. NO. 152,156,253   GET 'P'
C                                        SAT. NO. 153,157       GET 'Q'
C                                        SAT. NO. 150,154,158   GET 'R'
C                                        SAT. NO. 151,155,159   GET 'O'
C                                        (Note: Sat. No. 253 gets 'C'
C                                               if producer is NESDIS)
C                       -----> MTSAT:    SAT. NO. 171           GET 'Q'
C                                        SAT. NO. 199 (UNKNOWN) GET 'Q'
C                       -----> KALPANA:  SAT. NO. 440           GET 'K'
C                       -----> INSAT:    SAT. NO. 470           GET 'V'
C                                        SAT. NO. 499 (UNKNOWN) GET 'V'
C    REPROCESSED CHAR 2 -----> WINDS PRODUCED BY NESDIS:
C                               RETURNED VALUE IN BUFR FOR 'SWPR'
C                               (PRODUCER), IF NON-MISSING; OTHERWISE
C                               HARDWIRED TO '1'
C                       -----> WINDS PRODUCED BY FOREIGN PRODUCERS:
C                                SAT. PRODUCER -- ESA           GET 'C'
C                                              -- GMS/MTSAT     GET 'D'
C                                              -- INSAT/KALPANA GET 'E'
C    REPROCESSED CHAR 3-7 ---> SEQUENTIAL SERIAL INDEX (00001 - 99999)
C                              (UNIQUE FOR EACH NCEP BUFR CHAR 1/2/6
C                               COMB.)
C    REPROCESSED CHAR 8 -----> WINDS PRODUCED BY NESDIS:
C                               OLD FORMAT, (GOES -LOW-DENSITY-OBSOLETE)
C                                     -- IR(LW)  CLOUD DRIFT     GET 'C'
C                                     -- VISIBLE CLOUD DRIFT     GET 'C'
C                                     -- PICTURE TRIPLET         GET 'C'
C                                     -- WATER VAPOR             GET 'V'
C                               NEW FORMAT (GOES - HIGH-DENSITY)
C                                     -- IR(LW) IMAGER CLD DRIFT GET 'I'
C                                     -- VIS IMAGER CLOUD DRIFT  GET 'Z'
C                                     -- WATER VAPOR IMAGER      GET 'W'
C                                     -- WATER VAPR SNDR, CHN 10 GET 'T'
C                                     -- WATER VAPR SNDR, CHN 11 GET 'L'
C                               NEW FORMAT (GMS  - LOW-DENSITY)
C                                     -- IR(LW) CLOUD DRIFT      GET 'C'
C                                     -- WATER VAPOR             GET 'V'
C                       -----> WINDS PRODUCED BY FOREIGN PRODUCERS:
C                                     -- IR(LW)  CLOUD DRIFT     GET 'C'
C                                     -- VISIBLE CLOUD DRIFT     GET 'B'
C                                     -- WATER VAPOR             GET 'V'

         SID = '????????'
         IPRODUCER = 99
         IDENSITY  = 99
         IF(IDS.LT.500)  THEN
            SID(1:1) = CSAT(IDS)
C     .... GOES-9 winds with BUFR message subtype 41-46 always get "P"
C          in 1st char. of stn. id (JMA began producing winds from
C          GOES-9 in place of failing GMS-5 on 23 May 2003, this lasted
C          until 15 July 2005 when MTSAT-1R replaced GOES-9)
C          (Note: When NESDIS produces winds from GOES-9, the first
C                 char. in the stn. id is "C", but that would cause
C                 problems in PREPOBS_PREPDATA in this case)
            IF(IDS.EQ.253.AND.SUBSET(7:7).EQ.'4')  SID(1:1) = 'P'
            IF((SID(1:1).GE.'A'.AND.SID(1:1).LE.'D') .OR.
     $         (SUBSET(7:8).EQ.'50'.OR.SUBSET(7:8).EQ.'51')) THEN
               IF(SUBSET(7:8).EQ.'50'.OR.SUBSET(7:8).EQ.'51')  THEN
                  IDENSITY = 2
               ELSE
                  IDENSITY = 1
               END IF
C  .. Satellite producer for winds generated by NESDIS
               CALL UFBINT(LUNIT,UFBINT_8,1,1,IRET,'SWPR');SWPR=UFBINT_8
               IF(SWPR.LT.BMISS) THEN
                                   ! From NESDIS Binary Fmt (local)
                                   !  (both lo- and hi- density)
                  IF(NINT(SWPR).GT.0.AND.NINT(SWPR).LT.10)
     $             WRITE(RSV1(1:1),'(I1)') NINT(SWPR)
                  SID(2:2) = RSV1(1:1)
               ELSE
                  CALL UFBINT(LUNIT,UFBINT_8,1,1,IRET,'GCLONG')
                  GCLONG=UFBINT_8
                                   ! From NESDIS BUFR Fmt (WMO)
                                   !  Should come in as 160 (NESDIS),
                                   !  but irregardless hardwire here as
                                   !  1
                  RSV1(1:1) = '1'
                  SID(2:2) = RSV1(1:1)
               END IF
               IPRODUCER=1
C  .. Product type for winds generated by NESDIS
               CALL UFBINT(LUNIT,UFBINT_8,1,1,IRET,'SWTP');SWTP=UFBINT_8
               CALL UFBINT(LUNIT,UFBINT_8,1,1,IRET,'CMCM');CMCM=UFBINT_8
               IF(SWTP.LT.BMISS) THEN
                  ITP = NINT(SWTP) ! From NESDIS Binary Fmt (local)
                                   !  (hi- density)
               ELSE  IF(CMCM.LT.BMISS)  THEN
                                   ! From NESDIS Binary Fmt (local)
                                   !  (lo- density)
                                   ! (Note: CMCM is non-missing in this
                                   !        case but may not be correct!
                  IF(SUBSET(7:8).EQ.'01')  THEN
                     ITP = 1
                  ELSE  IF(SUBSET(7:8).EQ.'02')  THEN
                     ITP = 6
                  ELSE  IF(SUBSET(7:8).EQ.'03')  THEN
                     ITP = 4
                  ELSE  IF(SUBSET(7:8).EQ.'04')  THEN
                     ITP = 3
                  END IF
               ELSE
                  CALL UFBINT(LUNIT,UFBINT_8,1,1,IRET,'SWCM')
                  SWCM=UFBINT_8
                  CALL UFBINT(LUNIT,UFBINT_8,1,1,IRET,'SIDP')
                  SIDP=UFBINT_8

C  Effective 3/10/2005 NESDIS fixed an error which had stored SIDP as
C   a code table value rather than correctly as a flag table value - in
C   response must redirect SIDP value back to original code table value
C   (will still work ok for historical runs prior to NESDIS fix)
C  --------------------------------------------------------------------

                  IF(NINT(SIDP).EQ.4194304) THEN
                     SIDP =  9
                  ELSE  IF(NINT(SIDP).EQ.2097152) THEN
                     SIDP = 10
                  ENDIF
                  IF((NINT(SWCM).GT. 0.AND.NINT(SWCM).LT. 6).AND.
     $               (NINT(SIDP).EQ. 9.OR. NINT(SIDP).EQ.10))
                                   !From NESDIS BUFR Fmt (WMO)
     $             ITP = ISWCM(NINT(SWCM),NINT(SIDP),IDENSITY)
                  IF(ITP.EQ.14)  THEN
                     CALL UFBINT(LUNIT,UFBINT_8,1,1,IRET,'SCCF')
                     SCCF = UFBINT_8
                     SCCF = SCCF*1E-11
                     IF(INT(SCCF).EQ.405)  ITP = 15
                  END IF
               END IF
               READ(SUBSET(7:8),'(I2)') INUM2
               IF(INUM2.LT.52)  SID(8:8) = CPRDFN(INUM2)
               IF(SID(8:8).EQ.'T')  THEN
                  IF(ITP.EQ.15)  SID(8:8) = 'L'
               END IF
C  .. Cloud top/deep-layer indicator for winds generated by NESDIS
               CALL UFBINT(LUNIT,UFBINT_8,1,1,IRET,'SWDL');SWDL=UFBINT_8
            IF(SWDL.GE.BMISS) THEN ! NESDIS GTS (& eventually V10 server
                                   !  too) & MODIS winds come here

                  IF(NINT(SWCM).GT.0.AND.NINT(SWCM).LT.8) THEN
                     IF(ISWDL(NINT(SWCM)).LT.3) SWDL = ISWDL(NINT(SWCM))
                  END IF
               END IF
               IF(NINT(SWDL).GT.-1.AND.NINT(SWDL).LT.10)
     $          WRITE(RSV1(3:3),'(I1)') NINT(SWDL)
            ELSE
C  .. Satellite producer for winds generated from foreign producers
               SID(2:2) = CPROD(IDS/100)
C     .... GOES-9 winds with BUFR message subtype 41-46 are assumed to
C          be produced by JMA (JMA began producing winds from GOES-9
C          in place of failing GMS-5 on 23 May 2003, this lasted until
C          15 July 2005 when MTSAT-1R replaced GOES-9)
               IF(IDS.EQ.253.AND.SUBSET(7:7).EQ.'4') SID(2:2)='D'
               IPRODUCER=2
               RSV1(1:1) = SID(2:2)
               READ(SUBSET(8:8),'(I1)') INUM1
C  .. Product type for  winds generated from foreign producers
               SID(8:8) = CPRDF(MOD(INUM1,3))
               ITP = IPRDF(MOD(INUM1,3))
C  .. Cloud top/deep-layer indicator for winds generated from foreign
C      producers
               CALL UFBINT(LUNIT,UFBINT_8,1,1,IRET,'SWCM')
               SWCM=UFBINT_8
               IF(NINT(SWCM).GT.0.AND.NINT(SWCM).LT.8) THEN
                  IF(ISWDL(NINT(SWCM)).LT.3) SWDL = ISWDL(NINT(SWCM))
               END IF
               IF(NINT(SWDL).GT.-1.AND.NINT(SWDL).LT.10)
     $          WRITE(RSV1(3:3),'(I1)') NINT(SWDL)
            END IF
         END IF
         IF(IDS.LT.500.AND.ITP.LT.19.AND.IPRODUCER.LT.3)  THEN
            KOUNT(IDS,ITP,IPRODUCER) =
     $       MIN(KOUNT(IDS,ITP,IPRODUCER)+1,99999)
            WRITE(SID(3:7),'(I5.5)')  KOUNT(IDS,ITP,IPRODUCER)
         END IF
      ELSE

C***********************************************************************
C  IF THE EIGHTH CHARACTER OF THE INPUT STN. ID IS "A" - "Z", THEN
C   THE DUMP PROGRAM BUFR_DUPSAT HAS ALREADY CREATED THE STN. ID.
C         (INDICATES AN INPUT DATA DUMP FILE AFTER DEC. 2000)
C***********************************************************************

         RSV1(1:1) = SID(2:2)

         IF((SID(1:1).GE.'A'.AND.SID(1:1).LE.'D') .OR.
     $    (SUBSET(7:8).EQ.'50'.OR.SUBSET(7:8).EQ.'51') .OR.
     $    (SUBSET(7:8).EQ.'70'.OR.SUBSET(7:8).EQ.'71') .OR.
     $    (SUBSET(7:8).EQ.'80') .OR.
     $    (SUBSET(7:8).EQ.'90')) THEN

C  .. Product type for winds generated by NESDIS/NASA
            CALL UFBINT(LUNIT,UFBINT_8,1,1,IRET,'SWTP');SWTP=UFBINT_8
            CALL UFBINT(LUNIT,UFBINT_8,1,1,IRET,'CMCM');CMCM=UFBINT_8
            IF(SWTP.LT.BMISS) THEN
               ITP = NINT(SWTP) ! From NESDIS Binary Fmt (local)
                                !  (hi- density)
            ELSE  IF(CMCM.LT.BMISS)  THEN
                                ! From NESDIS Binary Fmt (local)
                                !  (lo- density)
                                ! (Note: CMCM is non-missing in this
                                !        case but may not be correct!
               IF(SUBSET(7:8).EQ.'01')  THEN
                  ITP = 1
               ELSE  IF(SUBSET(7:8).EQ.'02')  THEN
                  ITP = 6
               ELSE  IF(SUBSET(7:8).EQ.'03')  THEN
                  ITP = 4
               ELSE  IF(SUBSET(7:8).EQ.'04')  THEN
                  ITP = 3
               END IF
            ELSE
                                   !From NESDIS BUFR Fmt (WMO)
               DO  K=1,10
                  IF(SID(8:8).EQ.C8(K))  THEN
                     ITP = ITP_C8(K)
                     EXIT
                  END IF
               ENDDO
            END IF
C  .. Cloud top/deep-layer indicator for winds generated by NESDIS or
C     NASA
            CALL UFBINT(LUNIT,UFBINT_8,1,1,IRET,'SWDL');SWDL=UFBINT_8
            IF(SWDL.GE.BMISS) THEN ! NESDIS GTS & MODIS/AVHRR/VIIRS
                                   ! winds come here
               CALL UFBINT(LUNIT,UFBINT_8,1,1,IRET,'SWCM')
               SWCM=UFBINT_8
               IF(NINT(SWCM).GT.0.AND.NINT(SWCM).LT.8) THEN
                  IF(ISWDL(NINT(SWCM)).LT.3) SWDL = ISWDL(NINT(SWCM))
               END IF
            END IF
            IF(NINT(SWDL).GT.-1.AND.NINT(SWDL).LT.10)
     $       WRITE(RSV1(3:3),'(I1)') NINT(SWDL)
         ELSE
C  .. Product type for  winds generated from foreign producers
            DO  K=1,4
               IF(SID(8:8).EQ.C8(K))  THEN
                  ITP = ITP_C8(K)
                  EXIT
               END IF
            ENDDO
C  .. Cloud top/deep-layer indicator for winds generated from foreign
C      producers
            CALL UFBINT(LUNIT,UFBINT_8,1,1,IRET,'SWCM')
            SWCM=UFBINT_8
            IF(NINT(SWCM).GT.0.AND.NINT(SWCM).LT.8) THEN
               IF(ISWDL(NINT(SWCM)).LT.3) SWDL = ISWDL(NINT(SWCM))
            END IF
            IF(NINT(SWDL).GT.-1.AND.NINT(SWDL).LT.10)
     $       WRITE(RSV1(3:3),'(I1)') NINT(SWDL)

C  From approximately 11 August through 30 September 2010, BUFR_DUPSAT
C   incorrectly placed a "?" in character 1 of the generated report id
C   for JMA MTSAT-2 wind reports -- change this to the correct value of
C   "R" for historical reruns, etc.
C  --------------------------------------------------------------------

            IF(IDS.EQ.172.AND.SID(1:1).EQ.'?')  SID(1:1) = 'R'

         END IF

C***********************************************************************

      END IF

      RTP = 63
 
C  PUT THE SINGLE-LEVEL DATA INTO SPECIFIED UNPACKED FORMAT
C  --------------------------------------------------------
 
      POB(1) = BMISS
      CALL UFBREP(LUNIT,PRLC_8,1,11,IRET,'PRLC');PRLC=PRLC_8
cpppppppppp
cc        print *,'IRET = ',iret
cc    do i=1,iret
cc       print'(" For I = ",I0,"; PRLC IS: ",G0)', I,PRLC(I)
cc    enddo
cpppppppppp

C  Which pressure do you want:
C        JTP = 1 -- Final (observed)
C            = 2 -- Window channel height assignment
C            = 3 -- Histogram height assignment
C            = 4 -- H2O intercept height assignment
C            = 5 -- CO2 slicing height assignment
C            = 6 -- Original (primary height assignment)
C   Note: JTP = 1 always for GOES-16 & up, or non-GOES, or non-NESDIS
C                 GTS, or non-MODIS/AVHRR/VIIRS wind types

      IF(IRET.EQ.1 .or. subset(6:7).eq.'03')  THEN
         JTP = 1
      ELSE
         JTP = 1  ! Here hardwired to be final for GOES, and NESDIS
                  !  GTS, and MODIS/AVHRR/VIIRS wind types
      ENDIF

      IF(PRLC(JTP).LT.BMISS)  POB(1) =  NINT(PRLC(JTP)*.1)

C  GROSS CHECK ON PRESSURE
C  -----------------------

      IF(NINT(POB(1)).EQ.0)  THEN
         print'(" ~~IW3UNPBF/R06UBF: RPT with ID= ",A," TOSSED - PRES.",
     $    " IS ZERO MB")', SID
         R06UBF = -9999
         KSKSAT = KSKSAT + 1
         RETURN
      END IF

C  TRY TO FIND FIND THE HEIGHT ASSIGNMENT
C  --------------------------------------
 
      CALL UFBINT(LUNIT,UFBINT_8,1,1,IRET,'HGHT');HGHT=UFBINT_8
      IF(HGHT.LT.BMISS)  THEN
         ELV = HGHT
      ELSE  IF(POB(1).LT.BMISS)  THEN
         ELV = HGTF(POB(1)*.1)
      ELSE
         ELV = BMISS
      END IF
      QMELV = XMISS

      if(subset(6:7).eq.'03')  THEN

C  GOES-16 & up (in subsets NC00503x) store TMDBST rather than TMDB
C  ----------------------------------------------------------------
         call ufbint(lunit,arr_8,10,1,iret,'TMDP TMDBST CCST');arr=arr_8
      else
         CALL UFBINT(LUNIT,ARR_8,10,1,IRET,LVSTR);ARR=ARR_8
      end if

      QOB(1) = BMISS
      IF(MAX(ARR(1),ARR(2),POB(1)).LT.BMISS)  THEN

C  All data level category 6 rpts store specific humidity (g/kg) as
C   moisture variable
C  ----------------------------------------------------------------

         QQ = QFRMTP(ARR(1),POB(1)*0.1)
         IF(QQ.GT.0.0.AND.NINT(ARR(1)*10.).LE.NINT(ARR(2)*10.))
     $    QOB(1) = QQ * 1000.
      END IF

      TOB(1) = BMISS
      IF(ARR(2).LT.BMISS)  THEN
         ITMP = NINT(ARR(2)*100.)        ! From NESDIS binary FMT &
         TOB(1) = NINT((ITMP-27315)*0.1) !  foreign pre-V10 BUFR,
                                         !  temp in "TMDB";
                                         ! From NESDIS BUFR Fmt
                                         !  GOES-16 & up,
                                         !  temp in "TMDBST"

      ELSE  IF(ARR(3).LT.BMISS)  THEN
         ITMP = NINT(ARR(3)*100.)        ! From NESDIS BUFR Fmt &
         TOB(1) = NINT((ITMP-27315)*0.1) !  foreign V10 BUFR, temp
                                         !  in "CCST"
      END IF

      ZOB(1) = ELV

      CALL UFBREP(LUNIT,WIND_8,2,5,IRET,'WDIR WSPD');WIND=WIND_8
cpppppppppp
cc    do i=1,iret
cc       print'(" For I = ",I0,"; WIND IS: ",2(G0,1X))',I,WIND(1,I),
cc   $    WIND(2,I)
cc    enddo
cpppppppppp

C  Which wind speed and direction do you want:
C        KTP = 1 -- Final (observed)
C            = 2 -- First guess
C            = 3 -- Original
C            = 4 -- Image 1 to 2
C            = 5 -- Image 2 to 3
C   Note: KTP = 1 always for GOES-16 & up, or non-GOES, or non-NESDIS
C                 GTS, or non-MODIS/AVHRR/VIIRS wind types

      IF(IRET.EQ.1 .or. subset(6:7).eq.'03')  THEN
         KTP = 1
      ELSE
         KTP = 1  ! Here hardwired to be final for GOES, and NESDIS
                  !  GTS, and MODIS/AVHRR/VIIRS wind types
      ENDIF

      DOB(1) = WIND(1,KTP)
      SOB(1) = MIN(WIND(2,KTP)*10.,BMISS)

      CALL UFBINT(LUNIT,UFBINT_8,1,1,IRET,'SWQM');SWQM=UFBINT_8

      IF(IRET.EQ.1)  THEN
         WQM(1) = EQMUBF(SWQM)
         PQM(1) = 2
         TQM(1) = 2
         QQM(1) = 2
         ZQM(1) = 2
      END IF

CVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVV
CVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVV
      QI_with       = BMISS
      QC_QI_with    = BMISS
      QI_without    = BMISS
      QC_QI_without = BMISS
      RFF           = BMISS
      QC_RFF        = BMISS
      EE            = BMISS
      QC_EE         = BMISS
      QI_without_common = bmiss

      IF((SUBSET(7:8).GE.'10'.AND.SUBSET(7:8).LE.'12') .OR.
     $   SUBSET(7:8).EQ.'14'                           .OR.
     $   (SUBSET(7:8).GE.'15'.AND.SUBSET(7:8).LE.'19') .OR.
     $   (SUBSET(7:8).GE.'44'.AND.SUBSET(7:8).LE.'46') .OR.
     $   (SUBSET(7:8).GE.'64'.AND.SUBSET(7:8).LE.'69') .OR.
     $   (SUBSET(7:8).GE.'70'.AND.SUBSET(7:8).LE.'71') .OR.
     $   (SUBSET(7:8).EQ.'80') .OR.
     $   (SUBSET(7:8).EQ.'90')) THEN

         IF(SUBSET(7:8).GE.'64'.AND.SUBSET(7:8).LE.'69') THEN !EUMETSAT
            INDX  =   1
            IOFF  =   0
            IVARS =   4 ! number of variables w/ quality info
            IQI   =   1 ! value of GNAP for QI w/  forecast
            IQIwo =   2 ! value of GNAP for QI w/o forecast
            IRFF  =   3 ! value of GNAP for RFF (present after ?-?-2006)
ccccccccc   LIMqi =  80 ! if QI less than or equal to this - flag
            LIMqi =   0 ! if QI less than or equal to this - flag
ccccccccc   LIMqc =   3 ! if Manual/automatic q.c. indicator greater
ccccccccc               !  than or equal to this - flag
            LIMqc = 999 ! if Manual/automatic q.c. indicator greater
                        !  than or equal to this - flag
         ELSE IF(SUBSET(7:8).GE.'44'.AND.SUBSET(7:8).LE.'46') THEN !JMA
            INDX  =   3
            IOFF  =   0
            IVARS =   4 ! number of variables w/ quality info
            IQI   = 101 ! value of GNAP for QI w/  forecast
            IQIwo = 102 ! value of GNAP for QI w/o forecast
            IRFF  = 103 ! value of GNAP for RFF
            LIMqi =  80 ! if QI less than or equal to this - flag
            LIMqc =   3 ! if Manual/automatic q.c. indicator greater
                        !  than or equal to this - flag
         ELSE IF(SUBSET(7:8).GE.'15'.AND.SUBSET(7:8).LE.'18') THEN
                                                             ! GOES-15 &
                                                             ! down-GTS
            INDX  =   5
            IVARS =   2 ! number of variables w/ quality info
            IOFF  =   1
            IQI   =   3 ! value of GNAP for QI w/ forecast
            IQIwo =   1 ! value of GNAP for QI w/o forecast
            IRFF  =   2 ! value of GNAP for RFF
            LIMqi =  49 ! if QI less than or equal to this - flag
            LIMqc =   3 ! if Manual/automatic q.c. indicator greater
                        !  than or equal to this - flag
         ELSE IF((SUBSET(7:8).GE.'10'.AND.SUBSET(7:8).LE.'12')  .OR.
     $           (SUBSET(7:8).EQ.'14') .OR. (SUBSET(7:8).EQ.'19')) THEN
                                                             ! GOES-15 &
                                                             ! down-V10
                                                             ! (server)
            INDX  =   5
            IVARS =   2 ! number of variables w/ quality info
            IOFF  =   1
            IQI   =   3 ! value of GNAP for QI w/ forecast
            IQIwo =   1 ! value of GNAP for QI w/o forecast
            IRFF  =   2 ! value of GNAP for RFF
            IEE   =   4 ! value of GNAP for NESDIS Expected Error
            LIMqi =  49 ! if QI less than or equal to this - flag
            LIMqc =   3 ! if Manual/automatic q.c. indicator greater
                        !  than or equal to this - flag
         ELSE IF(SUBSET(7:8).GE.'70'.AND.SUBSET(7:8).LE.'71') THEN
                                                             !MODIS POES
            INDX  =   7
            IVARS =   2 ! number of variables w/ quality info
            IOFF  =   1
            IQI   =   3 ! value of GNAP for QI w/ forecast
            IQIwo =   1 ! value of GNAP for QI w/o forecast
            IRFF  =   2 ! value of GNAP for RFF
            IEE   =   4 ! value of GNAP for NESDIS Expected Error
            LIMqi =  49 ! if QI less than or equal to this - flag
            LIMqc =   3 ! if Manual/automatic q.c. indicator greater
                        !  than or equal to this - flag
         ELSE IF(SUBSET(7:8).EQ.'80') THEN !AVHRR POES
            INDX  =   9
            IVARS =   2 ! number of variables w/ quality info
            IOFF  =   1
            IQI   =   3 ! value of GNAP for QI w/ forecast
            IQIwo =   1 ! value of GNAP for QI w/o forecast
            IRFF  =   2 ! value of GNAP for RFF
            IEE   =   4 ! value of GNAP for NESDIS Expected Error
ccccccccc   LIMqi =  49 ! if QI less than or equal to this - flag
            LIMqi =   0 ! if QI less than or equal to this - flag
ccccccccc   LIMqc =   3 ! if Manual/automatic q.c. indicator greater
ccccccccc               !  than or equal to this - flag
            LIMqc = 999 ! if Manual/automatic q.c. indicator greater
                        !  than or equal to this - flag
         ELSE IF(SUBSET(7:8).EQ.'90') THEN !VIIRS POES
            INDX  =  11
            IVARS =   2 ! number of variables w/ quality info
            IOFF  =   1
            IQI   =   3 ! value of GNAP for QI w/ forecast
            IQIwo =   1 ! value of GNAP for QI w/o forecast
            IRFF  =   2 ! value of GNAP for RFF
            IEE   =   4 ! value of GNAP for NESDIS Expected Error
ccccccccc   LIMqi =  49 ! if QI less than or equal to this - flag
            LIMqi =   0 ! if QI less than or equal to this - flag
ccccccccc   LIMqc =   3 ! if Manual/automatic q.c. indicator greater
ccccccccc               !  than or equal to this - flag
            LIMqc = 999 ! if Manual/automatic q.c. indicator greater
                        !  than or equal to this - flag
         END IF

         CALL UFBREP(LUNIT,GNAP_8, 1,12,IRET_GNAP,'GNAP');GNAP=GNAP_8
         CALL UFBREP(LUNIT,PCCF_8, 2,12,IRET_PCCF,'PCCF MAQC')
         PCCF=PCCF_8
         CALL UFBREP(LUNIT,QFGU_8, 1, 8,IRET_QFGU,'QFGU');QFGU=QFGU_8

         IF(IRET_PCCF.GT.0 .AND. IRET_PCCF.LT.13)  THEN

C  For EUMETSAT (BUFR), if only four replications of PCCF/MAQC are
C   found in a report, it is prior to 6-4-2001 when only one EUMETSAT
C   Quality Index was calculated {using a forecast (first guess)
C   consistency test} {Note: JMA (BUFR) did not exist at this time}
C
C  For EUMETSAT (BUFR) or JMA (BUFR), if eight (EUMETSAT prior to
C   ?-?-2006) or twelve (JMA all dates or EUMETSAT after ?/?/2006)
C   replications of PCCF/MAQC are found in a report, it is after
C   6-4-2001 when EUMETSAT Quality Index with forecast (first guess)
C   consistency test, EUMETSAT Quality Index without forecast (first
C   guess) consistency test, and (for JMA all dates and EUMETSAT after
C   ?-?-2006 only) NESDIS Recursive Filter Function were calculated
C  -------------------------------------------------------------------

            IF(IRET_QFGU.GT.0)  THEN

C  For EUMETSAT (BUFR), during the period from 6-4-2001 through
C   3-14-2005, QFGU and not GNAP was used to define whether or not the
C   EUMETSAT Quality Index was calculated with or without the forecast
C   (first guess) consistency test - take this into account
C   {Note: JMA (BUFR) did not exist at this time}
C  -------------------------------------------------------------------

               IF(QFGU(1).LT.BMISS)   THEN
                  DO I=1,2  !  assume QFGU(1),(3),(5),(7) are the same
                            !  and    QFGU(2),(4),(6),(8) are the same
                     IF(NINT(QFGU(I)).EQ.0)  THEN
                        GNAP(I) = 1.
                     ELSE IF(NINT(QFGU(I)).EQ.1)  THEN
                        GNAP(I) = 2.
                     ELSE
                        GNAP(I) = BMISS
                     END IF
                  ENDDO
               END IF
            END IF
               
            IEND = IRET_PCCF/IVARS

C  Assumption: If IVARS = 4:
C                If IEND = 2:     GNAP(1),(3),(5),(7) are the same
C                             and GNAP(2),(4),(6),(8) are the same
C                If IEND = 3:     GNAP(1),(4),(7),(10) are the same
C                                 GNAP(2),(5),(8),(11) are the same
C                             and GNAP(3),(6),(9),(12) are the same
C              If IVARS = 2:
C                If IEND = 3:     GNAP(1),(4) are the same
C                                 GNAP(2),(5) are the same
C                             and GNAP(3),(6) are the same
C                If IEND = 4:     GNAP(1),(4) are the same
C                                 GNAP(2),(5) are the same
C                                 GNAP(3),(6) are the same
C                             and GNAP(4),(8) are the same

            DO J = 1,IEND
               IF(NINT(GNAP(J)).EQ.IQI .OR. IEND.EQ.1) THEN
                  IF(MAX(PCCF(1,(IEND+J)-(IOFF*IEND)),
     $                   PCCF(1,(2*IEND+J)-(IOFF*IEND))).LT.BMISS)
     $             QI_with   = MIN(PCCF(1,(IEND+J)-(IOFF*IEND)),
     $                             PCCF(1,(2*IEND+J)-(IOFF*IEND)))
                  QC_QI_with = MAX(PCCF(2,(IEND+J)-(IOFF*IEND)),
     $                             PCCF(2,(2*IEND+J)-(IOFF*IEND)))
               ELSE IF(NINT(GNAP(J)).EQ.IQIwo) THEN
                  IF(MAX(PCCF(1,(IEND+J)-(IOFF*IEND)),
     $                   PCCF(1,(2*IEND+J)-(IOFF*IEND))).LT.BMISS)
     $             QI_without   = MIN(PCCF(1,(IEND+J)-(IOFF*IEND)),
     $                                PCCF(1,(2*IEND+J)-(IOFF*IEND)))
                  QC_QI_without = MAX(PCCF(2,(IEND+J)-(IOFF*IEND)),
     $                                PCCF(2,(2*IEND+J)-(IOFF*IEND)))
               ELSE IF(NINT(GNAP(J)).EQ.IRFF) THEN
                  IF(MAX(PCCF(1,(IEND+J)-(IOFF*IEND)),
     $                   PCCF(1,(2*IEND+J)-(IOFF*IEND))).LT.BMISS)
     $             RFF   = MIN(PCCF(1,(IEND+J)-(IOFF*IEND)),
     $                         PCCF(1,(2*IEND+J)-(IOFF*IEND)))
                  QC_RFF = MAX(PCCF(2,(IEND+J)-(IOFF*IEND)),
     $                         PCCF(2,(2*IEND+J)-(IOFF*IEND)))
               ELSE IF(NINT(GNAP(J)).EQ.IEE) THEN
                  IF(MAX(PCCF(1,(IEND+J)-(IOFF*IEND)),
     $                   PCCF(1,(2*IEND+J)-(IOFF*IEND))).LT.BMISS)
     $             EE    = MIN(PCCF(1,(IEND+J)-(IOFF*IEND)),
     $                         PCCF(1,(2*IEND+J)-(IOFF*IEND)))
                  QC_EE  = MAX(PCCF(2,(IEND+J)-(IOFF*IEND)),
     $                         PCCF(2,(2*IEND+J)-(IOFF*IEND)))
               END IF
            ENDDO

C  EUMETSAT QI with forecast must be > LIMqi % for EUMETSAT/JMA/GOES/
C   POES (MODIS, AVHRR or VIIRS), else flag (note: This should be moved
C   to prepdata)  ==> MAY NO LONGER BE NEEDED FOR NETs WHOSE GSI READS
C   SATWND DUMP DIRECTLY, RATHER THAN GETTING SATWND REPORTS OUT OF
C   PREPBUFR FILE
C  --------------------------------------------------------------------

            IF(WQM(1).EQ.2.AND.QI_with.LT.BMISS)  THEN
               IF(NINT(QI_with).LE.LIMqi)  THEN
                  WQM(1) = 13
                  PQM(1) = 13
                  ZQM(1) = 13
                  TQM(1) = 13
                  QQM(1) = 13
                  KFLSAT(INDX) = KFLSAT(INDX) + 1
               END IF
            END IF

C  Manual/automatic q.c. indicator must be < LIMqc, else flag
C  (note: This should be moved to prepdata)  ==> MAY NO LONGER BE
C  NEEDED FOR NETs WHOSE GSI READS SATWND DUMP DIRECTLY, RATHER THAN
C  GETTING SATWND REPORTS OUT OF PREPBUFR FILE
C  -----------------------------------------------------------------

            IF(WQM(1).EQ.2.AND.QC_QI_with.LT.BMISS)  THEN
               IF(NINT(QC_QI_with).GE.LIMqc)  THEN
                  WQM(1) = 13
                  PQM(1) = 13
                  ZQM(1) = 13
                  TQM(1) = 13
                  QQM(1) = 13
                  KFLSAT(INDX+1) = KFLSAT(INDX+1) + 1
               END IF
            END IF

         END IF

cpppppppppp
cc       if(wqm(1).lt.13)print'(" SID, QI_with, QC_QI_with = "A,
cc   $    2(1X,I0))', sid,nint(QI_with),nint(QC_QI_with)
cpppppppppp

      else if(subset(6:7).GE.'03') then

C  GOES-16 & up (in subsets NC00503x) store GNAP & PCCF in a standard 4
C   replication sequence, not associated with any particular variable
C  --------------------------------------------------------------------

C  ... first make sure originating/generating center is NESDIS (160)
C      -------------------------------------------------------------
         call ufbint(lunit,ufbint_8,1,1,iret,'OGCE');ogce=ufbint_8

         if(ogce.eq.160) then
            call ufbrep(lunit,pccf_8, 2,12,iret_pccf,'GNAP PCCF')
            pccf = pccf_8
            if(iret_pccf.gt.0) then
               do iii = 1, iret_pccf
                  if(pccf(1,iii).eq.5) then
! Note: Need new Cat. 8 code figure to store this, missing as of 3/28/18
                     QI_without_common = pccf(2,iii)
                  else if(pccf(1,iii).eq.1) then
                     QI_without = pccf(2,iii)
                  else if(pccf(1,iii).eq.3) then
                     QI_with = pccf(2,iii)
                  else if(pccf(1,iii).eq.4) then
                     EE = pccf(2,iii)
                  else if(pccf(1,iii).eq.2) then
                     RFF = pccf(2,iii) ! not available as of 3/28/18
                  end if
               end do
            end if
         end if
      END IF
CAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
CAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA

C  PUT THE UNPACKED REPORT INTO OBS
C  --------------------------------
 
      RSTP = IMISS
      CALL S01UBF(SID,XOB,YOB,RHR,RCTIM,RSV1,RSV2,ELV,QMELV,ITP,RTP,
     $ RSTP,IDS)
      CALL S02UBF(6,1,*9999)
 
C  ------------------------------------------------------------------
C  MISC DATA GOES INTO DATA LEVEL CATEGORY 08
C  ------------------------------------------------------------------

C  CODE FIGURE 355 - PERCENT CONFIDENCE BASED ON NESDIS RECURSIVE
C   FILTER FUNCTION
C  --------------------------------------------------------------

      CALL UFBINT(LUNIT,UFBINT_8,1,1,IRET,'RFFL');RFFL=UFBINT_8
      IF(RFFL.GE.BMISS) RFFL = RFF  ! RFFL missing for all types except
                                    ! pre-V10 BUFR NESDIS GOES-15 & down
                                    ! winds from server
      IF(RFFL.LT.BMISS) THEN
         OB8(1) = NINT(RFFL)
         CF8(1) = 355
         Q81(1) = IMISS
         Q82(1) = IMISS
         CALL S02UBF(8,1,*9999)
      END IF

C  CODE FIGURE 356 - PERCENT CONFIDENCE BASED ON EUMETSAT QUALITY
C   INDEX WITH FCST CONSISTENCY TEST
C  --------------------------------------------------------------

      CALL UFBINT(LUNIT,UFBINT_8,1,1,IRET,'QIFY');QIFY=UFBINT_8
      IF(QIFY.GE.BMISS) QIFY = QI_with ! QIFY missing for all types
                                       ! except pre-V10 BUFR NESDIS
                                       ! GOES-15 & down winds from
                                       ! server and possibly MODIS winds
                                       ! from server
      IF(QIFY.LT.BMISS) THEN
         OB8(1) = NINT(QIFY)
         CF8(1) = 356
         Q81(1) = IMISS
         Q82(1) = IMISS
         CALL S02UBF(8,1,*9999)
      END IF

C  CODE FIGURE 357 - PERCENT CONFIDENCE BASED ON EUMETSAT QUALITY
C   INDEX W/O FCST CONSISTENCY TEST
C  --------------------------------------------------------------

      CALL UFBINT(LUNIT,UFBINT_8,1,1,IRET,'QIFN');QIFN=UFBINT_8
      IF(QIFN.GE.BMISS) QIFN = QI_without ! QIFN missing for all types
                                          ! except pre-V10 BUFR NESDIS
                                          ! GOES-15 & down winds from
                                          ! server and possibly MODIS
                                          ! winds from server
      IF(QIFN.LT.BMISS) THEN
         OB8(1) = NINT(QIFN)
         CF8(1) = 357
         Q81(1) = IMISS
         Q82(1) = IMISS
         CALL S02UBF(8,1,*9999)
      END IF

C  CODE FIGURE 358 - PERCENT CONFIDENCE BASED ON NESDIS EXPECTED ERROR
C  -------------------------------------------------------------------

      CALL UFBINT(LUNIT,UFBINT_8,1,1,IRET,'EEQF');EEQF=UFBINT_8
      IF(EEQF.GE.BMISS) EEQF = EE ! EEQF missing for all types except
                                  ! pre-V10 BUFR NESDIS GOES-15 & down
                                  ! winds from server and ossibly MODIS
                                  ! winds from server
      IF(EEQF.LT.BMISS) THEN
         OB8(1) = NINT(EEQF)
         CF8(1) = 358
         Q81(1) = IMISS
         Q82(1) = IMISS
         CALL S02UBF(8,1,*9999)
      END IF

      CALL S03UBF(OBS,SUBSET,*9999,*9998,*9997)

      IF(SUBSET(7:8).LT.'21') THEN

C  KEEP TRACK OF NESDIS GOES-15 & DOWN SATELLITE WIND COUNTS BY SAT. ID
C  --------------------------------------------------------------------

         IF(IDS.LT.IMISS)  THEN
            IF(IDS.GT.249.AND.IDS.LT.260)  THEN
               KNTSAT(IDS) = KNTSAT(IDS) + 1
            ELSE
               KNTSAT(260) = KNTSAT(260) + 1
            END IF
         END IF
      END IF

      if(subset(6:7).eq.'03') then

C  KEEP TRACK OF NESDIS GOES-16 & UP SATELLITE WIND COUNTS BY SAT. ID
C  ------------------------------------------------------------------

         if(ids.lt.imiss)  then
            if(ids.gt.269.and.ids.lt.274)  then
               knts16(ids) = knts16(ids) + 1
            else
               knts16(274) = knts16(274) + 1
            end if
         end if
      end if

      IF(SUBSET(7:8).EQ.'70'.OR.SUBSET(7:8).EQ.'71') THEN

C  KEEP TRACK OF NASA/MODIS POES SATELLITE WIND COUNTS BY SATELLITE ID
C  -------------------------------------------------------------------

         IF(IDS.LT.IMISS)  THEN
            IF(IDS.GT.782.AND.IDS.LT.785)  THEN
               KNTMODIS(IDS) = KNTMODIS(IDS) + 1
            ELSE
               KNTMODIS(785) = KNTMODIS(785) + 1
            END IF
         END IF
      END IF
 
      IF(SUBSET(7:8).EQ.'80') THEN

C  KEEP TRACK OF NESDIS/AVHRR POES SATELLITE WIND COUNTS BY SATELLITE ID
C  ---------------------------------------------------------------------

         IF(IDS.LT.IMISS)  THEN
            IF((IDS.GT.  2.AND.IDS.LT.  6) .OR.
     $         (IDS.GT.199.AND.IDS.LT.210) .OR.
     $         (IDS.EQ.223)) THEN
               KNTavhrr(IDS) = KNTavhrr(IDS) + 1
            ELSE
               KNTavhrr(224) = KNTavhrr(224) + 1
            END IF
         END IF
      END IF
 
      IF(SUBSET(7:8).EQ.'90') THEN

C  KEEP TRACK OF NASA/VIIRS POES SATELLITE WIND COUNTS BY SATELLITE ID
C  -------------------------------------------------------------------

         IF(IDS.LT.IMISS)  THEN
            IF(IDS.EQ.224)  THEN
               KNTviirs(IDS) = KNTviirs(IDS) + 1
            ELSE
               KNTviirs(225) = KNTviirs(225) + 1
            END IF
         END IF
      END IF
 
      RETURN

 9999 CONTINUE
      R06UBF = 999
      RETURN

 9998 CONTINUE
      print'(" IW3UNPBF/R06UBF: RPT with ID= ",A," TOSSED - ZERO ",
     $ "CAT.1-6,51 LVLS")', SID
 9997 CONTINUE
      R06UBF = -9999
      KSKSAT =KSKSAT + 1
      RETURN

      END
C***********************************************************************
C***********************************************************************
C***********************************************************************
      FUNCTION R07UBF(LUNIT,OBS,OBS2,OBS3,NOBS3,obs8_8)
C     ---> PROCESSES REPROCESSED SSM/I (SPSSMI) DATA (012/*)

      COMMON/IUBFAA/BMISS
      COMMON/IUBFBB/KNDX,KSKACF(8),KSKUPA,KSKSFC,KSKSAT,KFLSAT(12),
     $ KSKSMI
      COMMON/IUBFCC/SUBSET
      COMMON/IUBFEE/POB(255),QOB(255),TOB(255),ZOB(255),DOB(255),
     $              SOB(255),VSG(255),OB8(255),CF8(255)
      COMMON/IUBFLL/Q81(255),Q82(255)

      CHARACTER*80 HDSTR
      CHARACTER*8  SUBSET,SID,RSV1,RSV2
      REAL(8) RID_8,UFBINT_8,OBS2_8(43),OBS3_8(5,255,7),HDR_8(20),
     $ PROD_8(2,2),ADDP_8(5),TMBRS_8(2,14),TMBR_8(7),BMISS,AMINIMUM_8,
     $ obs8_8(2)
      DIMENSION    OBS(*),OBS2(43),OBS3(5,255,7),NOBS3(7),HDR(20),
     $ PROD(2,2),ADDP(5),TMBRS(2,14),TMBR(7)
      EQUIVALENCE  (RID_8,SID)

      SAVE

      DATA HDSTR/'RPID CLON CLAT HOUR MINU SECO NMCT SAID ACAV'/

      DATA IMISS/99999/,XMISS/99999./

      R07UBF = 0

C  STORE SINGLE LEVEL REPORT DATA DIRECTLY INTO OBS2 ARRAY AND
C   DOUBLE-PRECISION SINGLE LEVEL REPORT DATA DIRECTLY INTO OBS8_8 ARRAY
C  ---------------------------------------------------------------------

      OBS2_8 = BMISS
      obs8_8 = bmiss
      CALL UFBINT(LUNIT,OBS2_8,2,1,IRET,'RSRD EXPRSRD');OBS2=OBS2_8

      CALL S05UBF

C  PUT THE HEADER INFORMATION INTO UNPACKED FORMAT
C  -----------------------------------------------

      CALL UFBINT(LUNIT,HDR_8,20,  1,IRET,HDSTR);HDR(2:)=HDR_8(2:)
      IF(HDR(5).GE.BMISS) HDR(5) = 0
      IF(HDR(6).GE.BMISS) HDR(6) = 0
      obs8_8(1) = hdr_8(3)
      obs8_8(2) = hdr_8(2)
      RID_8 = HDR_8(1)
      XOB   = HDR(2)
      YOB   = HDR(3)
      RHR   = BMISS
      IF(HDR(4).LT.BMISS) RHR = (NINT(HDR(4)) + ((NINT(HDR(5)) * 60.) +
cvvvvvdak port
cdak $  NINT(HDR(6)))/3600.) + 0.0000000001  ! orig
cdak $  NINT(HDR(6)))/3600.) + 0.0001        ! then changed to this
caaaaadak port
     $  NINT(HDR(6)))/3600.)   ! don't make this adjustment now that we
                               ! store obs time to 10**5 in PREPBUFR
      RSV1  = '        '
      RSV2  = '        '

C  FOR SUPEROBS, THE NUMBER OF ORIGINAL RETRIEVALS THAT WENT INTO
C   MAKING THE SUPEROB IS STORED IN BYTES 1-3 OF HEADER RESERVE
C   CHARACTER WORD 1 (FOR NONSUPEROBS THE VALUE HERE IS ALWAYS 1)
C  --------------------------------------------------------------

      IF(HDR(9).LT.BMISS)  WRITE(RSV1(1:3),'(I3.3)')  NINT(HDR(9))

      ITP = IMISS
      RTP = HDR(7)

C  CHECK ON VALUE FOR SATELLITE ID TO DETERMINE IF THIS IS A SUPEROB
C   (SATELLITE ID IS MISSING FOR SUPEROBS)
C  -----------------------------------------------------------------

      ISUPOB = 1
      IDS = IMISS
      IF(HDR(8).LT.BMISS)  THEN
         IDS = NINT(HDR(8))
         ISUPOB = 0
      END IF

      RCTIM = BMISS
      ELV   = BMISS
      QMELV = XMISS
      IF(RTP.EQ.571.OR.RTP.EQ.65..OR.RTP.EQ.66.OR.RTP.EQ.69)  ELV = 0
      RSTP  = IMISS
      CALL S01UBF(SID,XOB,YOB,RHR,RCTIM,RSV1,RSV2,ELV,QMELV,ITP,RTP,
     $ RSTP,IDS)

C  PUT THE SSM/I DATA INTO SPECIFIED UNPACKED DATA LEVEL CATEGORY 8 FMT
C    - INDICATOR 1 HOLDS STANDARD DEV. OF VALUE (FOR SUPEROBS)
C    - INDICATOR 2 HOLDS QUALITY MARKER OF VALUE (RAIN FLAG) (WSDP,TPW)
C  --------------------------------------------------------------------

      IF(RTP.EQ.571)  THEN
C  ---------------------------------------------------------------------
C        ** OCEAN SURFACE WIND SPEED PRODUCT -- DUMP REPORT TYPE 571 **
C  ---------------------------------------------------------------------
C  CODE FIGURE 196 - OCEANIC WIND SPEED (M/SEC TO 10**1 PRECISION)
C  ---------------------------------------------------------------------
         CF8(1) = 196
         IF(ISUPOB.EQ.1)  THEN
            CALL UFBREP(LUNIT,PROD_8,2,2,IRET,'FOST WSPD')
            AMINIMUM_8 = MIN(PROD_8(2,1),PROD_8(2,2))
            IF(IBFMS(AMINIMUM_8).NE.0)
     $       CALL UFBREP(LUNIT,PROD_8,2,2,IRET,'FOST WSOS')
            PROD=PROD_8
C For SUPEROBs, replication is such that first WSPD/WSOS is always mean
C  value (FOST=4) and second WSPD/WSOS is always standard deviation
C  (FOST=10)
            OB8(1) = PROD(2,1)
            Q81(1) = PROD(2,2)
         ELSE
            CALL UFBINT(LUNIT,UFBINT_8,1,1,IRET,'WSPD')
            IF(IBFMS(UFBINT_8).NE.0)
     $       CALL UFBINT(LUNIT,UFBINT_8,1,1,IRET,'WSOS')
            PRODN=UFBINT_8
            OB8(1) = PRODN
            CALL UFBINT(LUNIT,UFBINT_8,1,1,IRET,'RFLG');RFLG=UFBINT_8
            Q82(1) = MIN(NINT(RFLG),IMISS)
         END IF
         CALL S02UBF(8,1,*9999)
      ELSE  IF(RTP.EQ.65)  THEN
C  ---------------------------------------------------------------------
C   ** OCEAN TOTAL PRECIPITABLE WATER PRODUCT -- DUMP REPORT TYPE 65 **
C  ---------------------------------------------------------------------
C  CODE FIGURE 197 - TOTAL PRECIPITABLE WATER (MM TO 10**1 PRECISION)
C  ---------------------------------------------------------------------
         CF8(1) = 197
         IF(ISUPOB.EQ.1)  THEN
            CALL UFBREP(LUNIT,PROD_8,2,2,IRET,'FOST TPWT')
            AMINIMUM_8 = MIN(PROD_8(2,1),PROD_8(2,2))
            IF(IBFMS(AMINIMUM_8).NE.0)
     $       CALL UFBREP(LUNIT,PROD_8,2,2,IRET,'FOST PH2O')
            PROD=PROD_8
C For SUPEROBs, replication is such that first TPWT/PH2O is always mean
C  value (FOST=4) and second TPWT/PH2O is always standard deviation
C  (FOST=10)
            OB8(1) = PROD(2,1)
            Q81(1) = PROD(2,2)
         ELSE
            CALL UFBINT(LUNIT,UFBINT_8,1,1,IRET,'TPWT')
            IF(IBFMS(UFBINT_8).NE.0)
     $       CALL UFBINT(LUNIT,UFBINT_8,1,1,IRET,'PH2O')
            PRODN = UFBINT_8
            OB8(1) = PRODN
            CALL UFBINT(LUNIT,UFBINT_8,1,1,IRET,'RFLG');RFLG=UFBINT_8
            Q82(1) = MIN(NINT(RFLG),IMISS)
         END IF
         CALL S02UBF(8,1,*9999)
      ELSE  IF(RTP.EQ.68)  THEN
C  ---------------------------------------------------------------------
C       ** 7-CHANNEL BRIGHTNESS TEMPERATURES -- DUMP REPORT TYPE 68 **
C  ---------------------------------------------------------------------
C  CODE FIGURE 189 - 19 GHZ V BRIGHTNESS TEMP (DEG K TO 10**2 PRECISION)
C  CODE FIGURE 190 - 19 GHZ H BRIGHTNESS TEMP (DEG K TO 10**2 PRECISION)
C  CODE FIGURE 191 - 22 GHZ V BRIGHTNESS TEMP (DEG K TO 10**2 PRECISION)
C  CODE FIGURE 192 - 37 GHZ V BRIGHTNESS TEMP (DEG K TO 10**2 PRECISION)
C  CODE FIGURE 193 - 37 GHZ H BRIGHTNESS TEMP (DEG K TO 10**2 PRECISION)
C  CODE FIGURE 194 - 85 GHZ V BRIGHTNESS TEMP (DEG K TO 10**2 PRECISION)
C  CODE FIGURE 195 - 85 GHZ H BRIGHTNESS TEMP (DEG K TO 10**2 PRECISION)
C  ---------------------------------------------------------------------
         IF(ISUPOB.EQ.1)  THEN
          CALL UFBREP(LUNIT,TMBRS_8,2,14,IRET,'FOST TMBR');TMBRS=TMBRS_8
C For SUPEROBs, replication is such that first TMBR is always mean
C  value (FOST=4) and second TMBR is always standard deviation (FOST=10)
            DO  NCHN = 1,7
               MINDX = (NCHN * 2) - 1
               OB8(1) = TMBRS(2,MINDX  )
               CF8(1) = 188 + NCHN
               Q81(1) = TMBRS(2,MINDX+1)
               CALL S02UBF(8,1,*9999)
            ENDDO
         ELSE
            CALL UFBINT(LUNIT,TMBR_8,1,7,NLEV,'TMBR');TMBR=TMBR_8
            DO  NCHN = 1,7
               OB8(1) = NINT(TMBR(NCHN)*100.)
               CF8(1) = 188 + NCHN
               CALL S02UBF(8,1,*9999)
            ENDDO
         END IF
      ELSE  IF(RTP.EQ.575)  THEN
C  ---------------------------------------------------------------------
C          ** ADDITIONAL PRODUCTS -- DUMP REPORT TYPE 575 **
C  ---------------------------------------------------------------------
C  CODE FIGURE 210 - SURFACE TAG (RANGE: 0,1,3-6)
C  CODE FIGURE 211 - ICE CONCENTRATION (PERCENT)
C  CODE FIGURE 212 - ICE AGE (RANGE: 0,1)
C  CODE FIGURE 213 - ICE EDGE (RANGE: 0,1)
C  CODE FIGURE 214 - CALCULATED SURFACE TYPE (RANGE: 1-20)
C  ---------------------------------------------------------------------
         CALL UFBINT(LUNIT,ADDP_8,5,1,IRET,'SFTG ICON ICAG ICED SFTP')
         ADDP = ADDP_8
         DO NADD = 1,5
            IF(ADDP(NADD).LT.BMISS) THEN
               OB8(1) = NINT(ADDP(NADD))
               CF8(1) = 209 + NADD
               CALL S02UBF(8,1,*9999)
            END IF
         ENDDO
      ELSE  IF(RTP.EQ.66)  THEN
C  ---------------------------------------------------------------------
C      ** LAND/OCEAN RAINFALL RATE -- REPORT TYPE 66 **
C  ---------------------------------------------------------------------
C  CODE FIGURE 198 - RAINFALL RATE (MM/SEC TO 10**6 PRECISION)
C    Note: Prior to mid-2001, this was stored using standard descr.
C          mnemonic REQV (at the standard precision).  Then from mid-
C          2001 until ~9/2004 it was stored using local descr. mnemonic
C          REQ6 (at a higher precision).  After ~9/2004 it will again
C          be stored using standard descr. mnemonic REQV, but operator
C          descriptors in the BUFR table will allow it to be stored
C          with the same high precision as before.  The logic below
C          allows for all transitions from REQV to REQ6 and then back
C          again.
C  ---------------------------------------------------------------------
         CF8(1) = 198
         IF(ISUPOB.EQ.1)  THEN
            CALL UFBREP(LUNIT,PROD_8,2,2,IRET,'FOST REQV')
            AMINIMUM_8 = MIN(PROD_8(2,1),PROD_8(2,2))
            IF(IBFMS(AMINIMUM_8).NE.0)
     $       CALL UFBREP(LUNIT,PROD_8,2,2,IRET,'FOST REQ6')
            PROD=PROD_8
C For SUPEROBs, replication is such that first REQV/REQ6 is always mean
C  value (FOST=4) and second REQV/REQ6 is always standard deviation
C  (FOST=10)
            OB8(1) = PROD(2,1)
            Q81(1) = PROD(2,2)
         ELSE
            CALL UFBINT(LUNIT,UFBINT_8,1,1,IRET,'REQV')
            IF(IBFMS(UFBINT_8).NE.0)
     $       CALL UFBINT(LUNIT,UFBINT_8,1,1,IRET,'REQ6')
            PRODN=UFBINT_8
            OB8(1) = PRODN
         END IF
         CALL S02UBF(8,1,*9999)
      ELSE  IF(RTP.EQ.576)  THEN
C  ---------------------------------------------------------------------
C      ** SURFACE TEMPERATURE -- DUMP REPORT TYPE 576 **
C  ---------------------------------------------------------------------
C  CODE FIGURE 199 - SURFACE TEMP. (DEG. KELVIN TO 10**2 PRECISION)
C  ---------------------------------------------------------------------
         CF8(1) = 199
         IF(ISUPOB.EQ.1)  THEN
            CALL UFBREP(LUNIT,PROD_8,2,2,IRET,'FOST TMSK');PROD=PROD_8
C For SUPEROBs, replication is such that first TMSK is always mean
C  value (FOST=4) and second TMSK is always standard deviation (FOST=10)
            OB8(1) = PROD(2,1)
            Q81(1) = PROD(2,2)
         ELSE
            CALL UFBINT(LUNIT,UFBINT_8,1,1,IRET,'TMSK');PRODN=UFBINT_8
            OB8(1) = PRODN
         END IF
         CALL S02UBF(8,1,*9999)
      ELSE  IF(RTP.EQ.69)  THEN
C  ---------------------------------------------------------------------
C      ** OCEAN CLOUD WATER -- DUMP REPORT TYPE 69 **
C  ---------------------------------------------------------------------
C  CODE FIGURE 200 - CLOUD WATER (MM * 100)
C  ---------------------------------------------------------------------
         CF8(1) = 200
         IF(ISUPOB.EQ.1)  THEN
            CALL UFBREP(LUNIT,PROD_8,2,2,IRET,'FOST CH2O');PROD=PROD_8
C For SUPEROBs, replication is such that first CH2O is always mean
C  value (FOST=4) and second CH2O is always standard deviation (FOST=10)
            OB8(1) = NINT(PROD(2,1)*100.)
            Q81(1) = NINT(PROD(2,2)*100.)
         ELSE
            CALL UFBINT(LUNIT,UFBINT_8,1,1,IRET,'CH2O');PRODN=UFBINT_8
            OB8(1) = NINT(PRODN*100.)
         END IF
         CALL S02UBF(8,1,*9999)
      ELSE  IF(RTP.EQ.573)  THEN
C  ---------------------------------------------------------------------
C      ** SOIL MOISTURE -- DUMP REPORT TYPE 573 **
C  ---------------------------------------------------------------------
C  CODE FIGURE 201 - SOIL MOISTURE (MM)
C  ---------------------------------------------------------------------
         CF8(1) = 201
         IF(ISUPOB.EQ.1)  THEN
            CALL UFBREP(LUNIT,PROD_8,2,2,IRET,'FOST SMOI');PROD=PROD_8
C For SUPEROBs, replication is such that first SMOI is always mean
C  value (FOST=4) and second SMOI is always standard deviation (FOST=10)
            OB8(1) = NINT(PROD(2,1)*1000.)
            Q81(1) = NINT(PROD(2,2)*1000.)
         ELSE
            CALL UFBINT(LUNIT,UFBINT_8,1,1,IRET,'SMOI');PRODN=UFBINT_8
            OB8(1) = NINT(PRODN*1000.)
         END IF
         CALL S02UBF(8,1,*9999)
      ELSE  IF(RTP.EQ.574)  THEN
C  ---------------------------------------------------------------------
C      ** SNOW DEPTH -- DUMP REPORT TYPE 574 **
C  ---------------------------------------------------------------------
C  CODE FIGURE 202 - SNOW DEPTH (MM)
C  ---------------------------------------------------------------------
         CF8(1) = 202
         IF(ISUPOB.EQ.1)  THEN
            CALL UFBREP(LUNIT,PROD_8,2,2,IRET,'FOST TOSD')
            AMINIMUM_8 = MIN(PROD_8(2,1),PROD_8(2,2))
            IF(IBFMS(AMINIMUM_8).NE.0)
     $       CALL UFBREP(LUNIT,PROD_8,2,2,IRET,'FOST SNDP')
            PROD=PROD_8
C For SUPEROBs, replication is such that first TOSD/SNDP is always mean
C  value (FOST=4) and second TOSD/SNDP is always standard deviation
C  (FOST=10)
            OB8(1) = NINT(PROD(2,1)*1000.)
            Q81(1) = NINT(PROD(2,2)*1000.)
         ELSE
            CALL UFBINT(LUNIT,UFBINT_8,1,1,IRET,'TOSD')
            IF(IBFMS(UFBINT_8).NE.0)
     $       CALL UFBINT(LUNIT,UFBINT_8,1,1,IRET,'SNDP')
            PRODN=UFBINT_8
            OB8(1) = NINT(PRODN*1000.)
         END IF
         CALL S02UBF(8,1,*9999)
      ELSE  IF(RTP.EQ.577)  THEN
C  ---------------------------------------------------------------------
C      ** SEA-SURFACE TEMPERATURE -- DUMP REPORT TYPE 577 **
C  ---------------------------------------------------------------------
C  CODE FIGURE 203 - SEA-SURFACE TEMP. (DEG. KELVIN TO 10**2 PRECISION)
C  ---------------------------------------------------------------------
         CF8(1) = 203
         IF(ISUPOB.EQ.1)  THEN
            CALL UFBREP(LUNIT,PROD_8,2,2,IRET,'FOST SST1');PROD=PROD_8
C For SUPEROBs, replication is such that first SST1 is always mean
C  value (FOST=4) and second SST1 is always standard deviation (FOST=10)
            OB8(1) = PROD(2,1)
            Q81(1) = PROD(2,2)
         ELSE
            CALL UFBINT(LUNIT,UFBINT_8,1,1,IRET,'SST1');PRODN=UFBINT_8
            OB8(1) = PRODN
         END IF
         CALL S02UBF(8,1,*9999)
      END IF

C  PUT THE UNPACKED REPORT INTO OBS
C  --------------------------------
 
      CALL S03UBF(OBS,SUBSET,*9999,*9998,*9997)

      RETURN
 9999 CONTINUE
      R07UBF = 999
      RETURN
 9998 CONTINUE
      print'(" IW3UNPBF/R07UBF: RPT with ID= ",A," TOSSED - ZERO ",
     $ "CAT.1-6,8,51 LVLS")', SID
 9997 CONTINUE
      R07UBF = -9999
      KSKSMI = KSKSMI + 1
      RETURN
      END
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    I05UBF      FINDS LOCATION OF NEXT NUMERIC
C   PRGMMR: RAY CRAYTON      ORG: W/NMC41    DATE: 1989-07-07
C
C ABSTRACT: FINDS THE LOCATION OF THE NEXT NUMERIC CHARACTER
C           IN A STRING OF CHARACTERS.
C
C PROGRAM HISTORY LOG:
C 1989-07-07  RAY CRAYTON
C
C USAGE:    LOC=I05UBF(STRING,NUM,CHAR)
C   INPUT ARGUMENT LIST:
C     STRING   - CHARACTER ARRAY.
C     NUM      - NUMBER OF CHARACTERS TO SEARCH IN STRING.
C
C   OUTPUT ARGUMENT LIST:
C     I05UBF   - INTEGER*4 LOCATION OF ALPHANUMERIC CHARACTER.
C                = 0 IF NOT FOUND.
C     CHAR     - CHARACTER FOUND.
C
C REMARKS: NONE
C
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE:  NCEP WCOSS
C
C$$$
      FUNCTION I05UBF(STRING,NUM,CHAR)
      CHARACTER*1  STRING(1),CHAR

      SAVE

      DO I = 1,NUM
         IF(STRING(I).GE.'0'.AND.STRING(I).LE.'9')  THEN
            I05UBF = I
            CHAR = STRING(I)
            GO TO 200
         END IF
      ENDDO
      I05UBF = 0
      CHAR = '?'
 200  CONTINUE
      RETURN
      END
